[Vm-dev] VM Maker: Cog-rmacnak.297.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Nov 23 05:21:10 UTC 2015


Ryan Macnak uploaded a new version of Cog to project VM Maker:
http://source.squeak.org/VMMaker/Cog-rmacnak.297.mcz

==================== Summary ====================

Name: Cog-rmacnak.297
Author: rmacnak
Time: 22 November 2015, 9:21:00.153 pm
UUID: fd1a2113-a596-439d-9a38-7bd38dfff46d
Ancestors: Cog-rmacnak.296

MIPS simulation:

Add multiply and divide instructions. Now the only missing instructions needed for the JIT should be those for floating pointing numbers.

Fix register accessors of the processor alien api to answer the unsigned interpretation.

Fix page protection to use the correct read/write limit (Bitmap>>size is in 32-bit words not bytes).

Implement some register smashing routines. Cannot use a stronger ABI check (or really the check does not apply) because the thread of control never leaves the simulator via a return.

=============== Diff against Cog-rmacnak.296 ===============

Item was changed:
  SharedPool subclass: #MIPSConstants
  	instanceVariableNames: ''
+ 	classVariableNames: 'A0 A1 A2 A3 ADDIU ADDU AND ANDI AT BEQ BGEZ BGTZ BLEZ BLTZ BNE BREAK DIV FP GP HintLoad HintStore J JAL JALR JR K0 K1 LB LBU LH LHU LUI LW MFHI MFLO MULT OR ORI OneInstruction PREF R0 R1 R10 R11 R12 R13 R14 R15 R16 R17 R18 R19 R2 R20 R21 R22 R23 R24 R25 R26 R27 R28 R29 R3 R30 R31 R4 R5 R6 R7 R8 R9 RA REGIMM S0 S1 S2 S3 S4 S5 S6 S7 SB SH SLL SLLV SLT SLTI SLTIU SLTU SP SPECIAL SRA SRAV SRL SRLV SUBU SW T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 TwoInstructions V0 V1 XOR XORI ZR'
- 	classVariableNames: 'A0 A1 A2 A3 ADDIU ADDU AND ANDI AT BEQ BGEZ BGTZ BLEZ BLTZ BNE BREAK FP GP HintLoad HintStore J JAL JALR JR K0 K1 LB LBU LH LHU LUI LW OR ORI OneInstruction PREF R0 R1 R10 R11 R12 R13 R14 R15 R16 R17 R18 R19 R2 R20 R21 R22 R23 R24 R25 R26 R27 R28 R29 R3 R30 R31 R4 R5 R6 R7 R8 R9 RA REGIMM S0 S1 S2 S3 S4 S5 S6 S7 SB SH SLL SLLV SLT SLTI SLTIU SLTU SP SPECIAL SRA SRAV SRL SRLV SUBU SW T0 T1 T2 T3 T4 T5 T6 T7 T8 T9 TwoInstructions V0 V1 XOR XORI ZR'
  	poolDictionaries: ''
  	category: 'Cog-Processors'!
  
  !MIPSConstants commentStamp: 'rmacnak 11/11/2015 20:29:59' prior: 0!
  MIPS opcodes and register names.!

Item was changed:
  ----- Method: MIPSConstants class>>initializeSpecialFunctions (in category 'as yet unclassified') -----
  initializeSpecialFunctions
  	SLL := 0.
  	SRL := 2.
  	SRA := 3.
  	SLLV := 4.
  	SRLV := 6.
  	SRAV := 7.
  	JR := 8.
  	JALR := 9.
  	BREAK := 13.
+ 	MFHI := 16.
+ 	MFLO := 18.
+ 	MULT := 24.
+ 	DIV := 26.
  	ADDU := 33.
  	SUBU := 35.
  	AND := 36.
  	OR := 37.
  	XOR := 38.
  	SLT := 42.
  	SLTU := 43.!

Item was added:
+ ----- Method: MIPSDisassembler>>divideSigned: (in category 'instructions - arithmetic') -----
+ divideSigned: instruction
+ 	self assert: instruction rd = 0.
+ 	self assert: instruction sa = 0.
+ 	^'div ', 
+ 	(MIPSConstants nameForRegister: instruction rs), ', ',
+ 	(MIPSConstants nameForRegister: instruction rt)!

Item was added:
+ ----- Method: MIPSDisassembler>>moveFromHigh: (in category 'instructions - arithmetic') -----
+ moveFromHigh: instruction
+ 	self assert: instruction rs = 0.
+ 	self assert: instruction rt = 0.
+ 	self assert: instruction sa = 0.
+ 	^'mfhi ', (MIPSConstants nameForRegister: instruction rd)!

Item was added:
+ ----- Method: MIPSDisassembler>>moveFromLow: (in category 'instructions - arithmetic') -----
+ moveFromLow: instruction
+ 	self assert: instruction rs = 0.
+ 	self assert: instruction rt = 0.
+ 	self assert: instruction sa = 0.
+ 	^'mflo ', (MIPSConstants nameForRegister: instruction rd)!

Item was added:
+ ----- Method: MIPSDisassembler>>multiplySigned: (in category 'instructions - arithmetic') -----
+ multiplySigned: instruction
+ 	self assert: instruction rd = 0.
+ 	self assert: instruction sa = 0.
+ 	^'mult ', 
+ 	(MIPSConstants nameForRegister: instruction rs), ', ',
+ 	(MIPSConstants nameForRegister: instruction rt)!

Item was changed:
  ----- Method: MIPSELSimulator>>unsignedByte: (in category 'memory') -----
  unsignedByte: address
  	address < readableBase ifTrue: [self readFault: address].
  	address > readableLimit ifTrue: [self readFault: address].
+ 	^memory byteAt: address + 1!
- 	^memory at: address + 1!

Item was changed:
  ----- Method: MIPSELSimulator>>unsignedByte:put: (in category 'memory') -----
  unsignedByte: address put: value
  	address < writableBase ifTrue: [self writeFault: address].
  	address > writableLimit ifTrue: [self writeFault: address].
+ 	^memory byteAt: address + 1 put: value!
- 	^memory at: address + 1 put: value!

Item was changed:
  ----- Method: MIPSELSimulator>>unsignedHalfword: (in category 'memory') -----
  unsignedHalfword: address
  	address < readableBase ifTrue: [self readFault: address].
  	address > readableLimit ifTrue: [self readFault: address].
  	(address bitAnd: 1) = 0 ifFalse: [self error: 'Unaligned read'].
+ 	^memory unsignedShortAt: address + 1!
- 	^memory unsignedShortAt: address + 1 bigEndian: false!

Item was added:
+ ----- Method: MIPSELSimulatorTests>>testDiv (in category 'tests - arithmetic') -----
+ testDiv
+ 	"Strangely, objdump is unable to disassemble this sequence."	
+ 	| result |
+ 	self 
+ 		testGenerateInto: 
+ 			[:stream :compiler | 
+ 			stream nextPut: (compiler divR: A0 R: A1).
+ 			stream nextPut: (compiler mfloR: V0).
+ 			stream nextPut: (compiler jR: RA).
+ 			stream nextPut: (compiler nop). "Delay slot"]
+ 		disassembly:
+ '00000000  0085001A  div a0, a1
+ 00000004  00001012  mflo v0
+ 00000008  03E00008  jr ra
+ 0000000C  00000000  nop
+ '		run: 
+ 			[:simulator | 
+ 			result := simulator call: 0 with: 3 with: 7 with: 0 with: 0.
+ 			self assert: result equals: 0.
+ 			result := simulator call: 0 with: -3 with: 7 with: 0 with: 0.
+ 			self assert: result equals: 0.
+ 			result := simulator call: 0 with: 3 with: -7 with: 0 with: 0.
+ 			self assert: result equals: 0.
+ 			result := simulator call: 0 with: -3 with: -7 with: 0 with: 0.
+ 			self assert: result equals: 0.
+ 			result := simulator call: 0 with: 7 with: 3 with: 0 with: 0.
+ 			self assert: result equals: 2.
+ 			result := simulator call: 0 with: -7 with: 3 with: 0 with: 0.
+ 			self assert: result equals: -2.
+ 			result := simulator call: 0 with: 7 with: -3 with: 0 with: 0.
+ 			self assert: result equals: -2.
+ 			result := simulator call: 0 with: -7 with: -3 with: 0 with: 0.
+ 			self assert: result equals: 2].	
+ 	self 
+ 		testGenerateInto: 
+ 			[:stream :compiler | 
+ 			stream nextPut: (compiler divR: A0 R: A1).
+ 			stream nextPut: (compiler mfhiR: V0).
+ 			stream nextPut: (compiler jR: RA).
+ 			stream nextPut: (compiler nop). "Delay slot"]
+ 		disassembly:
+ '00000000  0085001A  div a0, a1
+ 00000004  00001010  mfhi v0
+ 00000008  03E00008  jr ra
+ 0000000C  00000000  nop
+ '		run: 
+ 			[:simulator | 
+ 			result := simulator call: 0 with: 3 with: 7 with: 0 with: 0.
+ 			self assert: result equals: 3.
+ 			result := simulator call: 0 with: -3 with: 7 with: 0 with: 0.
+ 			self assert: result equals: -3.
+ 			result := simulator call: 0 with: 3 with: -7 with: 0 with: 0.
+ 			self assert: result equals: 3.
+ 			result := simulator call: 0 with: -3 with: -7 with: 0 with: 0.
+ 			self assert: result equals: -3.
+ 			result := simulator call: 0 with: 7 with: 3 with: 0 with: 0.
+ 			self assert: result equals: 1.
+ 			result := simulator call: 0 with: -7 with: 3 with: 0 with: 0.
+ 			self assert: result equals: -1.
+ 			result := simulator call: 0 with: 7 with: -3 with: 0 with: 0.
+ 			self assert: result equals: 1.
+ 			result := simulator call: 0 with: -7 with: -3 with: 0 with: 0.
+ 			self assert: result equals: -1].!

Item was added:
+ ----- Method: MIPSELSimulatorTests>>testMult (in category 'tests - arithmetic') -----
+ testMult
+ 	"Strangely, objdump is unable to disassemble this sequence."	
+ 	| result |
+ 	self 
+ 		testGenerateInto: 
+ 			[:stream :compiler | 
+ 			stream nextPut: (compiler multR: A0 R: A1).
+ 			stream nextPut: (compiler mfloR: V0).
+ 			stream nextPut: (compiler jR: RA).
+ 			stream nextPut: (compiler nop). "Delay slot"]
+ 		disassembly:
+ '00000000  00850018  mult a0, a1
+ 00000004  00001012  mflo v0
+ 00000008  03E00008  jr ra
+ 0000000C  00000000  nop
+ '		run: 
+ 			[:simulator | 
+ 			result := simulator call: 0 with: 3 with: 5 with: 0 with: 0.
+ 			self assert: result equals: 15.
+ 			result := simulator call: 0 with: -3 with: 5 with: 0 with: 0.
+ 			self assert: result equals: -15.
+ 			result := simulator call: 0 with: 3 with: -5 with: 0 with: 0.
+ 			self assert: result equals: -15.
+ 			result := simulator call: 0 with: -3 with: -5 with: 0 with: 0.
+ 			self assert: result equals: 15.
+ 			result := simulator call: 0 with: 5 with: 3 with: 0 with: 0.
+ 			self assert: result equals: 15.
+ 			result := simulator call: 0 with: -5 with: 3 with: 0 with: 0.
+ 			self assert: result equals: -15.
+ 			result := simulator call: 0 with: 5 with: -3 with: 0 with: 0.
+ 			self assert: result equals: -15.
+ 			result := simulator call: 0 with: -5 with: -3 with: 0 with: 0.
+ 			self assert: result equals: 15.
+ 			result := simulator call: 0 with: 16r1000000 with: 16r4567 with: 0 with: 0.
+ 			self assert: result equals: 16r67000000.
+ 			result := simulator call: 0 with: 16r7FFFFFFF with: 16r7FFFFFFF with: 0 with: 0.
+ 			self assert: result equals: 1].	
+ 	self 
+ 		testGenerateInto: 
+ 			[:stream :compiler | 
+ 			stream nextPut: (compiler multR: A0 R: A1).
+ 			stream nextPut: (compiler mfhiR: V0).
+ 			stream nextPut: (compiler jR: RA).
+ 			stream nextPut: (compiler nop). "Delay slot"]
+ 		disassembly:
+ '00000000  00850018  mult a0, a1
+ 00000004  00001010  mfhi v0
+ 00000008  03E00008  jr ra
+ 0000000C  00000000  nop
+ '		run: 
+ 			[:simulator | 
+ 			result := simulator call: 0 with: 3 with: 5 with: 0 with: 0.
+ 			self assert: result equals: 0.
+ 			result := simulator call: 0 with: -3 with: 5 with: 0 with: 0.
+ 			self assert: result equals: -1.
+ 			result := simulator call: 0 with: 3 with: -5 with: 0 with: 0.
+ 			self assert: result equals: -1.
+ 			result := simulator call: 0 with: -3 with: -5 with: 0 with: 0.
+ 			self assert: result equals: 0.
+ 			result := simulator call: 0 with: 5 with: 3 with: 0 with: 0.
+ 			self assert: result equals: 0.
+ 			result := simulator call: 0 with: -5 with: 3 with: 0 with: 0.
+ 			self assert: result equals: -1.
+ 			result := simulator call: 0 with: 5 with: -3 with: 0 with: 0.
+ 			self assert: result equals: -1.
+ 			result := simulator call: 0 with: -5 with: -3 with: 0 with: 0.
+ 			self assert: result equals: 0.
+ 			result := simulator call: 0 with: 16r1000000 with: 16r4567 with: 0 with: 0.
+ 			self assert: result equals: 16r45.
+ 			result := simulator call: 0 with: 16r7FFFFFFF with: 16r7FFFFFFF with: 0 with: 0.
+ 			self assert: result equals:  16r3FFFFFFF].!

Item was changed:
  ----- Method: MIPSInstruction>>decodeSpecialFor: (in category 'as yet unclassified') -----
  decodeSpecialFor: visitor
  	| function |
  	function := self function.
  	function = SLL ifTrue: [^visitor shiftLeftLogical: self].
  	function = SRL ifTrue: [^visitor shiftRightLogical: self].
  	function = SRA ifTrue: [^visitor shiftRightArithmetic: self].
  	function = SLLV ifTrue: [^visitor shiftLeftLogicalVariable: self].
  	function = SRLV ifTrue: [^visitor shiftRightLogicalVariable: self].
  	function = SRAV ifTrue: [^visitor shiftRightArithmeticVariable: self].
  	function = JR ifTrue: [^visitor jumpRegister: self].
  	function = JALR ifTrue: [^visitor jumpAndLinkRegister: self].
  	function = BREAK ifTrue: [^visitor break: self].
+ 	function = MFHI ifTrue: [^visitor moveFromHigh: self].
+ 	function = MFLO ifTrue: [^visitor moveFromLow: self].
+ 	function = MULT ifTrue: [^visitor multiplySigned: self].
+ 	function = DIV ifTrue: [^visitor divideSigned: self].
  	function = ADDU ifTrue: [^visitor addUnsigned: self].
  	function = SUBU ifTrue: [^visitor subtractUnsigned: self].
  	function = AND ifTrue: [^visitor bitwiseAnd: self].
  	function = OR ifTrue: [^visitor bitwiseOr: self].
  	function = XOR ifTrue: [^visitor bitwiseXor: self].
  	function = SLT ifTrue: [^visitor setOnLessThan: self].
  	function = SLTU ifTrue: [^visitor setOnLessThanUnsigned: self].
  	
  	self error: 'Unknown instruction'.!

Item was changed:
  Object subclass: #MIPSSimulator
+ 	instanceVariableNames: 'memory registers pc instructionCount inDelaySlot readableBase writableBase exectuableBase readableLimit writableLimit exectuableLimit jumpingPC hi lo'
- 	instanceVariableNames: 'memory registers pc instructionCount inDelaySlot readableBase writableBase exectuableBase readableLimit writableLimit exectuableLimit jumpingPC'
  	classVariableNames: 'EndSimulationPC'
  	poolDictionaries: 'MIPSConstants'
  	category: 'Cog-Processors'!
  
  !MIPSSimulator commentStamp: 'rmacnak 11/11/2015 20:33:00' prior: 0!
  Simulator for 32-bit MIPS, without implementation of memory access.!

Item was added:
+ ----- Method: MIPSSimulator class>>defaultIntegerBaseInDebugger (in category 'as yet unclassified') -----
+ defaultIntegerBaseInDebugger
+ 	^16!

Item was changed:
  ----- Method: MIPSSimulator>>currentInstruction (in category 'as yet unclassified') -----
  currentInstruction
  	^[(MIPSDisassembler new disassemble: memory from: pc to: pc + 4)]
+ 		ifError: ['Cannot disassemble', String cr].!
- 		ifError: ['Cannot disassemble'].!

Item was added:
+ ----- Method: MIPSSimulator>>divideSigned: (in category 'instructions - arithmetic') -----
+ divideSigned: instruction
+ 	"Strangely, the MIPS reference manual does not indicate which division is used, but testing some hardware show it is truncated division (rather than floored division or Euclidean division)."	
+ 	| rsValue rtValue |
+ 	rsValue := self signedRegister: instruction rs.
+ 	rtValue := self signedRegister: instruction rt.
+ 	lo := rsValue quo: rtValue.
+ 	hi := rsValue rem: rtValue.
+ !

Item was changed:
  ----- Method: MIPSSimulator>>execute (in category 'as yet unclassified') -----
  execute
  	| instruction |
  	[pc ~= EndSimulationPC] whileTrue: 
+ 		[Transcript print: instructionCount; nextPutAll: ' X '; nextPutAll: self currentInstruction; flush.
- 		[Transcript nextPutAll: 'X '; nextPutAll: self currentInstruction; flush.
  		 10 milliSeconds asDelay wait.
  		 instruction := MIPSInstruction new value: (self fetchInstruction: pc).
  		 instruction decodeFor: self.
+ 		 pc := pc + OneInstruction.
+ 		 instructionCount := instructionCount + 1].!
- 		 pc := pc + OneInstruction].!

Item was changed:
  ----- Method: MIPSSimulator>>executeDelaySlot (in category 'as yet unclassified') -----
  executeDelaySlot
  	| instruction |
  	self assert: inDelaySlot not.
  	inDelaySlot := true.
+ 	instructionCount := instructionCount + 1.
+ 	Transcript print: instructionCount; nextPutAll: ' D '; nextPutAll: self currentInstruction; flush.
- 	Transcript nextPutAll: 'D '; nextPutAll: self currentInstruction; flush.
  	instruction := MIPSInstruction new value: (self fetchInstruction: pc).
  	instruction decodeFor: self.
  	inDelaySlot := false.!

Item was changed:
  ----- Method: MIPSSimulator>>fp (in category 'registers') -----
  fp
+ 	^self unsignedRegister: FP!
- 	^self signedRegister: FP!

Item was changed:
  ----- Method: MIPSSimulator>>fp: (in category 'registers') -----
  fp: anInteger
+ 	^self unsignedRegister: FP put: anInteger!
- 	^self signedRegister: FP put: anInteger!

Item was changed:
  ----- Method: MIPSSimulator>>initialize (in category 'as yet unclassified') -----
  initialize
  	registers := Array new: 32 withAll: 16rABABAB.
  	pc := 0.
+ 	hi := 0.
+ 	lo := 0.
  	inDelaySlot := false.
  	instructionCount := 0.!

Item was added:
+ ----- Method: MIPSSimulator>>moveFromHigh: (in category 'instructions - arithmetic') -----
+ moveFromHigh: instruction
+ 	self signedRegister: instruction rd put: hi.!

Item was added:
+ ----- Method: MIPSSimulator>>moveFromLow: (in category 'instructions - arithmetic') -----
+ moveFromLow: instruction
+ 	self signedRegister: instruction rd put: lo.!

Item was added:
+ ----- Method: MIPSSimulator>>multiplySigned: (in category 'instructions - arithmetic') -----
+ multiplySigned: instruction
+ 	| rsValue rtValue result |
+ 	rsValue := self signedRegister: instruction rs.
+ 	rtValue := self signedRegister: instruction rt.
+ 	result := rsValue * rtValue.
+ 	result := self signed64ToUnsigned64: result.
+ 	hi := self unsigned32ToSigned32: result >> 32.
+ 	lo := self unsigned32ToSigned32: (result bitAnd: 16rFFFFFFFF).!

Item was added:
+ ----- Method: MIPSSimulator>>pc (in category 'processor api') -----
+ pc
+ 	^pc!

Item was added:
+ ----- Method: MIPSSimulator>>popWordIn: (in category 'processor api') -----
+ popWordIn: aMemory 
+ 	| sp word |
+ 	word := aMemory unsignedLongAt: (sp := self sp) + 1 bigEndian: false.
+ 	self sp: sp + 4.
+ 	^word!

Item was changed:
  ----- Method: MIPSSimulator>>printOn: (in category 'as yet unclassified') -----
  printOn: stream
  	stream nextPutAll: self class name; nextPut: $:; cr.
  	0 to: 31 do:
+ 		[:reg |
- 		[:reg | | hex |
  		stream space.
  		stream nextPutAll: (MIPSConstants nameForRegister: reg).
  		stream space.
+ 		(self unsignedRegister: reg) printOn: stream base: 16 nDigits: 8.
- 		hex := (self unsignedRegister: reg) printStringBase: 16.
- 		8 - hex size timesRepeat: [stream nextPut: $0].
- 		stream nextPutAll: hex.
  		stream space.
  		(self signedRegister: reg) printOn: stream.
  		stream cr].
+ 
+ 	stream nextPutAll: ' pc '.
+ 	pc printOn: stream base: 16 nDigits: 8.
+ 	stream space.
+ 	pc printOn: stream.
+ 	stream cr.
  	
  	stream nextPutAll: self currentInstruction.!

Item was changed:
  ----- Method: MIPSSimulator>>ra (in category 'registers') -----
  ra
+ 	^self unsignedRegister: RA!
- 	^self signedRegister: RA!

Item was added:
+ ----- Method: MIPSSimulator>>ra: (in category 'registers') -----
+ ra: anInteger
+ 	^self unsignedRegister: RA put: anInteger!

Item was added:
+ ----- Method: MIPSSimulator>>retpcIn: (in category 'processor api') -----
+ retpcIn: aMemory
+ 	"The return address is on the stack, having been pushed by either
+ 	 simulateCallOf:nextpc:memory: or simulateJumpCallOf:memory:"
+ 	^aMemory unsignedLongAt: self fp + 5 bigEndian: false!

Item was changed:
  ----- Method: MIPSSimulator>>runInMemory:minimumAddress:readOnlyBelow: (in category 'processor api') -----
  runInMemory: aMemory minimumAddress: minimumAddress readOnlyBelow: minimumWritableAddress
  	"Note that minimumWritableAddress is both the minimum writeable address AND the maximum executable address"
  	memory := aMemory.
  	readableBase := minimumAddress.
  	writableBase := minimumWritableAddress.
  	exectuableBase := minimumAddress.
+ 	readableLimit := aMemory byteSize.
+ 	writableLimit := aMemory byteSize.
- 	readableLimit := aMemory size.
- 	writableLimit := aMemory size.
  	exectuableLimit := minimumWritableAddress.
  	self execute.!

Item was added:
+ ----- Method: MIPSSimulator>>s3 (in category 'registers') -----
+ s3
+ 	^self unsignedRegister: S3!

Item was added:
+ ----- Method: MIPSSimulator>>s4: (in category 'registers') -----
+ s4: anInteger
+ 	^self unsignedRegister: S4 put: anInteger!

Item was added:
+ ----- Method: MIPSSimulator>>s5 (in category 'registers') -----
+ s5
+ 	^self unsignedRegister: S5!

Item was added:
+ ----- Method: MIPSSimulator>>s5: (in category 'registers') -----
+ s5: anInteger
+ 	^self unsignedRegister: S5 put: anInteger!

Item was added:
+ ----- Method: MIPSSimulator>>signed64ToUnsigned64: (in category 'converting') -----
+ signed64ToUnsigned64: signedValue
+ 	self assert: (signedValue between: -16r8000000000000000 and: 16r7FFFFFFFFFFFFFFF).
+ 	signedValue < 0 ifTrue: [^signedValue + 16r10000000000000000].
+ 	^signedValue!

Item was changed:
  ----- Method: MIPSSimulator>>signedRegister:put: (in category 'registers') -----
  signedRegister: registerNumber put: signedValue
  	self assert: (signedValue between: -16r80000000 and: 16r7FFFFFFF).
  	registerNumber == ZR ifFalse: [^registers at: registerNumber + 1 put: signedValue].!

Item was added:
+ ----- Method: MIPSSimulator>>simulateReturnIn: (in category 'processor api') -----
+ simulateReturnIn: aMemory
+ 	"PostBuildStackDelta ~= 0 ifTrue:
+ 		[self sp: self sp + PostBuildStackDelta]."
+ 	self fp: (self popWordIn: aMemory).
+ 	"According to tpr, most C compilers implement return by simply
+ 	 popping into the pc, rather than popping through the link register."
+ 	self pc: (self popWordIn: aMemory)!

Item was added:
+ ----- Method: MIPSSimulator>>smashCallerSavedRegistersWithValuesFrom:by: (in category 'processor api') -----
+ smashCallerSavedRegistersWithValuesFrom: base by: step
+ 	"i.e., smashVolatileRegisters"
+ 	self flag: #OABI.
+ 	self unsignedRegister: AT put: 0 * step + base.
+ 	self unsignedRegister: V0 put: 0 * step + base.
+ 	self unsignedRegister: V1 put: 0 * step + base.
+ 	self unsignedRegister: A0 put: 0 * step + base.
+ 	self unsignedRegister: A1 put: 0 * step + base.
+ 	self unsignedRegister: A2 put: 0 * step + base.
+ 	self unsignedRegister: A3 put: 0 * step + base.
+ 	self unsignedRegister: T0 put: 0 * step + base.
+ 	self unsignedRegister: T1 put: 0 * step + base.
+ 	self unsignedRegister: T2 put: 0 * step + base.
+ 	self unsignedRegister: T3 put: 0 * step + base.
+ 	self unsignedRegister: T4 put: 0 * step + base.
+ 	self unsignedRegister: T5 put: 0 * step + base.
+ 	self unsignedRegister: T6 put: 0 * step + base.
+ 	self unsignedRegister: T7 put: 0 * step + base.
+ 	self unsignedRegister: T8 put: 0 * step + base.
+ 	self unsignedRegister: T9 put: 0 * step + base.
+ 	self unsignedRegister: GP put: 0 * step + base.
+ 	self unsignedRegister: RA put: 0 * step + base.!

Item was changed:
  ----- Method: MIPSSimulator>>smashRegistersWithValuesFrom:by: (in category 'processor api') -----
  smashRegistersWithValuesFrom: base by: step
+ 	2 to: 31 do: [:index | self unsignedRegister: index put: index - 1 * step + base].
+ !
- 	"Ignore this - we do a stronger check later."!

Item was changed:
  ----- Method: MIPSSimulator>>sp (in category 'registers') -----
  sp
+ 	^self unsignedRegister: SP!
- 	^self signedRegister: SP!

Item was changed:
  ----- Method: MIPSSimulator>>sp: (in category 'registers') -----
  sp: anInteger
+ 	^self unsignedRegister: SP put: anInteger!
- 	^self signedRegister: SP put: anInteger!



More information about the Vm-dev mailing list