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

commits at source.squeak.org commits at source.squeak.org
Fri Nov 27 22:04:10 UTC 2015


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

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

Name: Cog-rmacnak.298
Author: rmacnak
Time: 27 November 2015, 1:58:17.721 pm
UUID: 064ca517-a582-4db4-b874-2737a5a64e11
Ancestors: Cog-rmacnak.297

Move MIPSConstants to VMMaker.

Support single stepping the simulator.

Add more register accessors.

Match hardware behavior for divide by zero and divide with overflow.

Initialize registers with zero instead of zap to match existing test expectations.

=============== Diff against Cog-rmacnak.297 ===============

Item was removed:
- 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'
- 	poolDictionaries: ''
- 	category: 'Cog-Processors'!
- 
- !MIPSConstants commentStamp: 'rmacnak 11/11/2015 20:29:59' prior: 0!
- MIPS opcodes and register names.!

Item was removed:
- ----- Method: MIPSConstants class>>initialize (in category 'as yet unclassified') -----
- initialize
- 	super initialize.
- 	
- 	OneInstruction := 4.
- 	TwoInstructions := 8.
- 	
- 	HintLoad := 0.
- 	HintStore := 1.
- 		
- 	self initializeRegisters.
- 	self initializeOpcodes.
- 	self initializeSpecialFunctions.
- 	self initializeRegImmRts.!

Item was removed:
- ----- Method: MIPSConstants class>>initializeOpcodes (in category 'as yet unclassified') -----
- initializeOpcodes
- 	SPECIAL := 0.
- 	REGIMM := 1.
- 	J := 2.
- 	JAL := 3.
- 	BEQ := 4.
- 	BNE := 5.
- 	BLEZ := 6.
- 	BGTZ := 7.
- 	ADDIU := 9.
- 	SLTI := 10.
- 	SLTIU := 11.
- 	ANDI := 12.
- 	ORI := 13.
- 	XORI := 14.
- 	LUI := 15.
- 	LB := 32.
- 	LH := 33.
- 	LW := 35.
- 	LBU := 36.
- 	LHU := 37.
- 	SB := 40.
- 	SH := 41.
- 	SW := 43.
- 	PREF := 51.!

Item was removed:
- ----- Method: MIPSConstants class>>initializeRegImmRts (in category 'as yet unclassified') -----
- initializeRegImmRts
- 	BLTZ := 0.
- 	BGEZ := 1.!

Item was removed:
- ----- Method: MIPSConstants class>>initializeRegisters (in category 'as yet unclassified') -----
- initializeRegisters
- 	self flag: #OABI.
- 	R0 := ZR := 0. "Hardwired zero"
- 	R1 := AT := 1. "Assembler temp - used to expand psuedo instructions"
- 	R2 := V0 := 2. "ABI: result register"
- 	R3 := V1 := 3. "ABI: result register"
- 	R4 := A0 := 4. "ABI: argument register"
- 	R5 := A1 := 5. "ABI: argument register"
- 	R6 := A2 := 6. "ABI: argument register"
- 	R7 := A3 := 7. "ABI: argument register"
- 	R8 := T0 := 8. "ABI: volatile"
- 	R9 := T1 := 9. "ABI: volatile"
- 	R10 := T2 := 10. "ABI: volatile"
- 	R11 := T3 := 11. "ABI: volatile"
- 	R12 := T4 := 12. "ABI: volatile"
- 	R13 := T5 := 13. "ABI: volatile"
- 	R14 := T6 := 14. "ABI: volatile"
- 	R15 := T7 := 15. "ABI: volatile"
- 	R16 := S0 := 16. "ABI: preserved"
- 	R17 := S1 := 17. "ABI: preserved"
- 	R18 := S2 := 18. "ABI: preserved"
- 	R19 := S3 := 19. "ABI: preserved"
- 	R20 := S4 := 20. "ABI: preserved"
- 	R21 := S5 := 21. "ABI: preserved"
- 	R22 := S6 := 22. "ABI: preserved"
- 	R23 := S7 := 23. "ABI: preserved"
- 	R24 := T8 := 24. "ABI: volatile"
- 	R25 := T9 := 25. "Special use in some position-independent code"
- 	R26 := K0 := 26. "Reserved for OS"
- 	R27 := K1 := 27. "Reserved for OS"
- 	R28 := GP := 28. "Special use in some position-independent code"
- 	R29 := SP := 29. "Stack pointer"
- 	R30 := FP := 30. "Frame pointer"
- 	R31 := RA := 31. "Link register"
- 
- 	!

Item was removed:
- ----- 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 removed:
- ----- Method: MIPSConstants class>>nameForRegister: (in category 'as yet unclassified') -----
- nameForRegister: registerNumber
- 	^#(zr at v0 v1 a0 a1 a2 a3
- 		t0 t1 t2 t3 t4 t5 t6 t7
- 		s0 s1 s2 s3 s4 s5 s6 s7
- 		t8 t9 k0 k1 gp sp fp ra) at: registerNumber + 1!

Item was added:
+ ----- Method: MIPSELSimulator>>endianness (in category 'accessing') -----
+ endianness
+ 	^#little!

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

Item was changed:
  ----- 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.
+ 			result := simulator call: 0 with: 42 with: 0 with: 0 with: 0.
+ 			self assert: result equals: 0.
+ 			result := simulator call: 0 with: -16r80000000 with: -1 with: 0 with: 0.
+ 			self assert: result equals: -16r80000000].	
- 			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.
+ 			result := simulator call: 0 with: 42 with: 0 with: 0 with: 0.
+ 			self assert: result equals: 42.
+ 			result := simulator call: 0 with: -16r80000000 with: -1 with: 0 with: 0.
+ 			self assert: result equals: 0].!
- 			self assert: result equals: -1].!

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

Item was added:
+ ----- Method: MIPSSimulator>>convertInternalToInteger: (in category 'processor api') -----
+ convertInternalToInteger: unsigned
+ 	"Default conversion for 32-bit processors.  64-bit processors override."
+ 	^unsigned signedIntFromLong!

Item was added:
+ ----- Method: MIPSSimulator>>disassembleFrom:to:in:on: (in category 'processor api') -----
+ disassembleFrom: startAddress to: endAddress in: memory on: aStream
+ 	MIPSDisassembler new 
+ 		disassemble: memory
+ 		from: startAddress
+ 		to: endAddress
+ 		for: nil
+ 		labels: nil
+ 		on: aStream.!

Item was changed:
  ----- Method: MIPSSimulator>>divideSigned: (in category 'instructions - arithmetic') -----
  divideSigned: instruction
+ 	"Strangely, the MIPS reference manual does not indicate which division is used, but testing on some hardware shows it is truncated division (rather than floored division or Euclidean division)."	
- 	"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.
+ 	rtValue = 0 ifTrue: 
+ 		["No exception is signalled"
+ 		 lo := rtValue. 
+ 		 hi := rsValue.
+ 		 ^self].
+ 	(rtValue = -1 and: [rsValue = -16r80000000]) ifTrue:
+ 		["Only overflow case"
+ 		 lo := rsValue. 
+ 		 hi := 0.
+ 		 ^self].
  	lo := rsValue quo: rtValue.
  	hi := rsValue rem: rtValue.
  !

Item was removed:
- ----- Method: MIPSSimulator>>endianness (in category 'as yet unclassified') -----
- endianness
- 	^#little!

Item was changed:
  ----- Method: MIPSSimulator>>execute (in category 'as yet unclassified') -----
  execute
+ 	[pc ~= EndSimulationPC] whileTrue: [self step].!
- 	| instruction |
- 	[pc ~= EndSimulationPC] whileTrue: 
- 		[Transcript print: instructionCount; 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].!

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 print: instructionCount; nextPutAll: ' D '; nextPutAll: self currentInstruction; flush.
  	instruction := MIPSInstruction new value: (self fetchInstruction: pc).
  	instruction decodeFor: self.
  	inDelaySlot := false.!

Item was changed:
+ ----- Method: MIPSSimulator>>getterForRegister: (in category 'registers') -----
- ----- Method: MIPSSimulator>>getterForRegister: (in category 'as yet unclassified') -----
  getterForRegister: registerNumber
  	^#(zr at v0 v1 a0 a1 a2 a3
  		t0 t1 t2 t3 t4 t5 t6 t7
  		s0 s1 s2 s3 s4 s5 s6 s7
  		t8 t9 k0 k1 gp sp fp ra) at: registerNumber + 1!

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

Item was changed:
  ----- Method: MIPSSimulator>>jumpAndLinkRegister: (in category 'instructions - control') -----
  jumpAndLinkRegister: instruction
  	| nextPC |
  	self assert: inDelaySlot not.
  	self unsignedRegister: instruction rd put: pc + TwoInstructions. "Return past delay slot."
  	nextPC := self unsignedRegister: instruction rs.
  	jumpingPC := pc.
  	pc := pc + OneInstruction.
  	self executeDelaySlot.
  	pc := nextPC.
+ 	pc := pc - OneInstruction. "Account for general increment"!
- 	pc := pc - 4. "Account for general increment"!

Item was changed:
  ----- Method: MIPSSimulator>>jumpRegister: (in category 'instructions - control') -----
  jumpRegister: instruction
  	| nextPC |
  	self assert: inDelaySlot not.
  	nextPC := self unsignedRegister: instruction rs.
  	jumpingPC := pc.
  	pc := pc + OneInstruction.
  	self executeDelaySlot.
  	pc := nextPC.
+ 	pc := pc - OneInstruction. "Account for general increment"!
- 	pc := pc - 4. "Account for general increment"!

Item was changed:
  ----- Method: MIPSSimulator>>printOn: (in category 'as yet unclassified') -----
  printOn: stream
  	stream nextPutAll: self class name; nextPut: $:; cr.
+ 	self printRegistersOn: stream.
- 	0 to: 31 do:
- 		[:reg |
- 		stream space.
- 		stream nextPutAll: (MIPSConstants nameForRegister: reg).
- 		stream space.
- 		(self unsignedRegister: reg) printOn: stream base: 16 nDigits: 8.
- 		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 added:
+ ----- Method: MIPSSimulator>>printRegistersOn: (in category 'registers') -----
+ printRegistersOn: stream
+ 	0 to: 31 do:
+ 		[:reg |
+ 		stream space.
+ 		stream nextPutAll: (MIPSConstants nameForRegister: reg).
+ 		stream space.
+ 		(self unsignedRegister: reg) printOn: stream base: 16 nDigits: 8.
+ 		stream space.
+ 		(self signedRegister: reg) printOn: stream.
+ 		stream cr].
+ 
+ 	stream nextPutAll: ' hi '.
+ 	hi printOn: stream base: 16 nDigits: 8.
+ 	stream space.
+ 	hi printOn: stream.
+ 	stream cr.
+ 	
+ 	stream nextPutAll: ' lo '.
+ 	lo printOn: stream base: 16 nDigits: 8.
+ 	stream space.
+ 	lo printOn: stream.
+ 	stream cr.
+ 	
+ 	stream nextPutAll: ' pc '.
+ 	pc printOn: stream base: 16 nDigits: 8.
+ 	stream space.
+ 	pc printOn: stream.
+ 	stream cr.!

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

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

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

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

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

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

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

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

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

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

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

Item was changed:
  ----- Method: MIPSSimulator>>setFramePointer:stackPointer: (in category 'processor api') -----
  setFramePointer: fp stackPointer: sp
+ 	self unsignedRegister: SP put: sp.
+ 	self unsignedRegister: FP put: fp.!
- 	self signedRegister: SP put: sp.
- 	self signedRegister: FP put: fp.!

Item was changed:
+ ----- Method: MIPSSimulator>>setterForRegister: (in category 'registers') -----
- ----- Method: MIPSSimulator>>setterForRegister: (in category 'as yet unclassified') -----
  setterForRegister: registerNumber
  	^#(zr: at: v0: v1: a0: a1: a2: a3:
  		t0: t1: t2: t3: t4: t5: t6: t7:
  		s0: s1: s2: s3: s4: s5: s6: s7:
  		t8: t9: k0: k1: gp: sp: fp: ra:) at: registerNumber + 1!

Item was added:
+ ----- Method: MIPSSimulator>>simulateJumpCallOf:memory: (in category 'processor api') -----
+ simulateJumpCallOf: address memory: aMemory
+ 	"Simulate a frame-building jump of address.  Build a frame since
+ 	a) this is used for calls into the run-time which are unlikely to be leaf-calls"
+ 	"This method builds a stack frame as expected by the simulator, not as defined by ARM aapcs-abi.
+ 	In ARM aapcs, every method can define for itself, wether it wants to push lr (nextpc), and wether it 
+ 	uses a frame pointer. The standard never mentions a fp. It merely defines r4-r11 to be callee-saved."
+ 
+ 	self assert: self sp \\ 8 = 0. "This check ensures, that we conform with ARM abi. Before doing anything to the stack, we ensure 2-word alignment."
+ 	self pushWord: self ra in: aMemory.
+ 	self pushWord: self fp in: aMemory.
+ 	self fp: self sp.
+ 	"PostBuildStackDelta ~= 0 ifTrue:
+ 		[self sp: self sp - PostBuildStackDelta]." "In order to satisfy the CStackAlignment check by cogit, which is only valid on IA32 platforms."
+ 	self pc: address!

Item was changed:
  ----- Method: MIPSSimulator>>simulateLeafCallOf:nextpc:memory: (in category 'processor api') -----
  simulateLeafCallOf: address nextpc: nextpc memory: aMemory
+ 	self unsignedRegister: RA put: nextpc.
- 	self signedRegister: RA put: nextpc.
  	pc := address.!

Item was added:
+ ----- Method: MIPSSimulator>>singleStepIn: (in category 'as yet unclassified') -----
+ singleStepIn: aByteArray
+ 	self initializeWithMemory: aByteArray.
+ 	self step.!

Item was added:
+ ----- Method: MIPSSimulator>>step (in category 'as yet unclassified') -----
+ step
+ 	"If the next instruction is a branch, its delay slot will also be executed."	
+ 	| instruction |
+ 	"Transcript print: instructionCount; nextPutAll: ' X '; nextPutAll: self currentInstruction; flush"
+ 	instruction := MIPSInstruction new value: (self fetchInstruction: pc).
+ 	instruction decodeFor: self.
+ 	pc := pc + OneInstruction.
+ 	instructionCount := instructionCount + 1.!



More information about the Vm-dev mailing list