[Vm-dev] VM Maker: VMMaker.oscog-lw.192.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Jul 31 15:26:10 UTC 2012


Lars Wassermann uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-lw.192.mcz

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

Name: VMMaker.oscog-lw.192
Author: lw
Time: 31 July 2012, 5:24:08.957 pm
UUID: 78ce4bd7-8218-dc4e-9469-0c6ac53a8ced
Ancestors: VMMaker.oscog-lw.191

Implemented all the methods used when initializing the Simulator for any of the Stack organizations. Now the debugging begins.

=============== Diff against VMMaker.oscog-lw.191 ===============

Item was added:
+ ----- Method: CogARMCompiler>>callerSavedRegisterMask (in category 'accessing') -----
+ callerSavedRegisterMask
+ 	"registers r0-r3, the lowest four"
+ 		^16rF!

Item was changed:
  ----- Method: CogARMCompiler>>computeMaximumSize (in category 'generate machine code') -----
  computeMaximumSize
  	"Because we don't use Thumb, each instruction has a multiple of 4 bytes. Most have exactly 4, but some abstract opcodes need more than one instruction."
  	
+ 	({CmpCqR. AddCqR. SubCqR. AndCqR. OrCqR. XorCqR} 
+ 		anySatisfy: [ :each | each = opcode])
+ 			ifTrue: [^self rotateable8bitImmediate: (operands at: 0)
- 	(opcode = CmpCqR) | (opcode = AddCqR) | (opcode = SubCqR) | (opcode = AndCqR) | (opcode = OrCqR) | (opcode = XorCqR) ifTrue: [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 20]].
+ 	({CmpCwR. AddCwR. SubCwR. AndCwR. OrCwR. XorCwR} 
+ 		anySatisfy: [ :each | each = opcode])
+ 			ifTrue: [^maxSize := 20].
+ 	
+ 	({Jump. JumpR. JumpZero. JumpNonZero. JumpNegative. JumpNonNegative. JumpOverflow.
+ 	JumpOverflow. JumpNoOverflow. JumpCarry. JumpNoCarry. JumpLess. JumpGreaterOrEqual. JumpGreater. JumpLessOrEqual. JumpBelow. JumpAboveOrEqual} 
+ 		anySatisfy: [ :each | each = opcode])
+ 			ifTrue: [^maxSize := 20].
+ 	
- 	(opcode = CmpCwR) | (opcode = AddCwR) | (opcode = SubCwR) | (opcode = AndCwR) | (opcode = OrCwR) | (opcode = XorCwR) ifTrue: [^maxSize := 20].	
- 
  	opcode
  		caseOf: {
  			[Label]					-> [^maxSize := 0].
  			[AlignmentNops]		-> [^maxSize := (operands at: 0) - 1].
  			[MoveAwR]				-> [^maxSize := 16].
  			[MoveCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 16]].
  			[MoveCwR]				-> [^maxSize := 16].
  			[MoveRAw]				-> [^maxSize := 16].
+ 			[MoveMwrR]			-> [self is12BitValue: (operands at: 0)
+ 											ifTrue: [ :u :i | ^maxSize := 4]
+ 											ifFalse: [ ^maxSize := 20 ]].
  			[RetN]					-> [^(operands at: 0) = 0 
+ 											ifTrue: [maxSize := 4]
+ 											ifFalse: [maxSize := 8]].
+ 			[JumpR]					-> [^maxSize := 8].
- 										ifTrue: [maxSize := 4]
- 										ifFalse: [maxSize := 8]].
  			[JumpFPEqual]			-> [^maxSize := 8].
  			[JumpFPNotEqual]		-> [^maxSize := 8].
  			[JumpFPLess]			-> [^maxSize := 8].
  			[JumpFPGreaterOrEqual]	-> [^maxSize := 8].
  			[JumpFPGreater]		-> [^maxSize := 8].
  			[JumpFPLessOrEqual]	-> [^maxSize := 8].
  			[JumpFPOrdered]		-> [^maxSize := 8].
  			[JumpFPUnordered]		-> [^maxSize := 8].
+ 			[JumpLong]				-> [^maxSize := 20].
+ 			[JumpLongZero]		-> [^maxSize := 20].
+ 			[JumpLongNonZero]	-> [^maxSize := 20].
  		}
  		otherwise: [^maxSize := 4].
  	^4 "to keep C compiler quiet"
  !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeArithmeticShiftRightCqR (in category 'generate machine code - concretize') -----
  concretizeArithmeticShiftRightCqR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| distance reg |
  	distance := (operands at: 0) min: 31.
  	reg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 dest dist -100 srcR"
+ 	self machineCodeAt: 0 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: reg 
+ 									shifterOperand: (distance << 7 bitOr: (64 bitOr: reg))).
- 	self machineCodeAt: 0 put: ((self t: 0 o: 16rD s: 0 rn: 0 rd: reg) 
- 									bitOr: (distance << 7 bitOr: (64 bitOr: reg))).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeArithmeticShiftRightRR (in category 'generate machine code - concretize') -----
  concretizeArithmeticShiftRightRR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| destReg distReg |
  	distReg := self concreteRegister: (operands at: 0).
  	destReg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 dest dist 0101 srcR"
+ 	self machineCodeAt: 0 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: destReg 
+ 									shifterOperand: (distReg << 8 bitOr: (80 bitOr: destReg))).
- 	self machineCodeAt: 0 put: ((self t: 0 o: 16rD s: 0 rn: 0 rd: destReg) 
- 									bitOr: (distReg << 8 bitOr: (80 bitOr: destReg))).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeConditionalJumpLong: (in category 'generate machine code - concretize') -----
  concretizeConditionalJumpLong: conditionCode
  	"Will get inlined into concretizeAt: switch."
  	"Sizing/generating jumps.
  		Jump targets can be to absolute addresses or other abstract instructions.
  		Generating initial trampolines instructions may have no maxSize and be to absolute addresses.
  		Otherwise instructions must have a machineCodeSize which must be kept to."
  	<inline: true>
+ 	| jumpTarget |
+ 	<var: #jumpTarget type: #'AbstractInstruction *'>
+ 	jumpTarget := self jumpTargetAddress.
+ 	self at: 0 moveCw: jumpTarget intoR: RISCTempReg.
+ 	"mov lr, pc"
+ 	"Because the pc always points to the actual address + 8, the value at pc is the address of the instruction after the branch (add pc, r3, #<byte0>"
+ 	self machineCodeAt: 12 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: LR shifterOperand: PC).
+ 	"add pc, r3, #<byte 0>"
+ 	self machineCodeAt: 16 put: (self t: 1 o: 4 s: 0 rn: RISCTempReg rd: PC shifterOperand: (jumpTarget bitAnd: 16rFF)).
+ 	^machineCodeSize := 20!
- 	| offset |
- 	offset := self computeJumpTargetOffsetPlus: 24 "16+8".
- 	!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeDataOperationRR: (in category 'generate machine code - concretize') -----
  concretizeDataOperationRR: opcode
  	"Will get inlined into concretizeAt: switch."
  	"Load the word into the RISCTempReg, then cmp R, RISCTempReg"
  	<inline: true>
  	| destReg srcReg |
  	srcReg := self concreteRegister: (operands at: 0).
  	destReg := (self concreteRegister: (operands at: 1)).
  	self machineCodeAt: 0 
+ 		put: (self t: 0 o: opcode s: 1 rn: destReg rd: destReg shifterOperand: srcReg).
- 		put: ((self t: 0 o: opcode s: 1 rn: destReg rd: destReg) bitOr: srcReg).
  	^machineCodeSize := 4.!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeJumpR (in category 'generate machine code - concretize') -----
+ concretizeJumpR
+ 	"Will get inlined into concretizeAt: switch."
+ 	"Sizing/generating jumps.
+ 		Jump targets can be to absolute addresses or other abstract instructions.
+ 		Generating initial trampolines instructions may have no maxSize and be to absolute addresses.
+ 		Otherwise instructions must have a machineCodeSize which must be kept to."
+ 	<inline: true>
+ 	| reg |
+ 	reg := self concreteRegister: (operands at: 0).
+ 	"mov lr, pc"
+ 	"Because the pc always points to the actual address + 8, the value at pc is the address of the instruction after the branch (add pc, r3, #<byte0>"
+ 	self machineCodeAt: 0 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: LR shifterOperand: PC).
+ 	"mov pc, r?, #0"
+ 	self machineCodeAt: 4 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: PC shifterOperand: reg).
+ 	^machineCodeSize := 8!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeLogicalShiftLeftCqR (in category 'generate machine code - concretize') -----
  concretizeLogicalShiftLeftCqR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| distance reg |
  	distance := (operands at: 0) min: 31.
  	reg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 dest dista 000 srcR"
+ 	self machineCodeAt: 0 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: reg shifterOperand: (distance << 7 bitOr: reg)).
- 	self machineCodeAt: 0 put: ((self t: 0 o: 16rD s: 0 rn: 0 rd: reg) 
- 									bitOr: (distance << 7 bitOr: reg)).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeLogicalShiftLeftRR (in category 'generate machine code - concretize') -----
  concretizeLogicalShiftLeftRR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| destReg distReg |
  	distReg := self concreteRegister: (operands at: 0).
  	destReg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 dest dist 0001 srcR"
+ 	self machineCodeAt: 0 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: destReg 
+ 									shifterOperand: (distReg << 8 bitOr: (16 bitOr: destReg))).
- 	self machineCodeAt: 0 put: ((self t: 0 o: 16rD s: 0 rn: 0 rd: destReg) 
- 									bitOr: (distReg << 8 bitOr: (16 bitOr: destReg))).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeLogicalShiftRightCqR (in category 'generate machine code - concretize') -----
  concretizeLogicalShiftRightCqR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| distance reg |
  	distance := (operands at: 0) min: 31.
  	reg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 dest dist -010 srcR"
+ 	self machineCodeAt: 0 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: reg 
+ 									shifterOperand: (distance << 7 bitOr: (32 bitOr: reg))).
- 	self machineCodeAt: 0 put: ((self t: 0 o: 16rD s: 0 rn: 0 rd: reg) 
- 									bitOr: (distance << 7 bitOr: (32 bitOr: reg))).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeLogicalShiftRightRR (in category 'generate machine code - concretize') -----
  concretizeLogicalShiftRightRR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| destReg distReg |
  	distReg := self concreteRegister: (operands at: 0).
  	destReg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 dest dist 0011 srcR"
+ 	self machineCodeAt: 0 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: destReg 
+ 									shifterOperand: (distReg << 8 bitOr: (48 bitOr: destReg))).
- 	self machineCodeAt: 0 put: ((self t: 0 o: 16rD s: 0 rn: 0 rd: destReg) 
- 									bitOr: (distReg << 8 bitOr: (48 bitOr: destReg))).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveMwrR (in category 'generate machine code - concretize') -----
  concretizeMoveMwrR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	offset := operands at: 0.
  	srcReg := self concreteRegister: (operands at: 1).
  	destReg := self concreteRegister: (operands at: 2).
  	self is12BitValue: offset
  		ifTrue: [ :u :immediate | 
  			self machineCodeAt: 0 
+ 				put: (self t: 2 o: (8 bitOr: u <<2) s: 1 rn: srcReg rd: destReg shifterOperand: immediate).
- 				put: ((self t: 2 o: (8 bitOr: u <<2) s: 1 rn: srcReg rd: destReg) bitOr: immediate).
  			^machineCodeSize := 4]
+ 		ifFalse: [ 
+ 			self at: 0 moveCw: offset intoR: RISCTempReg.
+ 			self machineCodeAt: 16 put: (self t: 0 o: 4 s: 0 rn: srcReg rd: destReg shifterOperand: RISCTempReg).
+ 			^machineCodeSize := 20 ]!
- 		ifFalse: [ self halt. ]!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeMoveRMwr (in category 'generate machine code - concretize') -----
+ concretizeMoveRMwr
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| srcReg offset destReg |
+ 	srcReg := self concreteRegister: (operands at: 0).
+ 	offset := operands at: 1.
+ 	destReg := self concreteRegister: (operands at: 2).
+ 	self is12BitValue: offset
+ 		ifTrue: [ :u :immediate | 
+ 			"LDR"
+ 			"STR:     (self t: 2 o: (8 bitOr: u <<2) s: 1 rn: srcReg rd: destReg shifterOperand: immediate)."
+ 			self machineCodeAt: 0 
+ 				put: (self t: 2 o: (8 bitOr: u<<2) s: 0 rn: destReg rd: srcReg shifterOperand: immediate).
+ 			^machineCodeSize := 4]
+ 		ifFalse: [ 
+ 			self halt.
+ 			
+ 			^machineCodeSize := 20 ]!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveRR (in category 'generate machine code - concretize') -----
  concretizeMoveRR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg destReg |
  	srcReg := self concreteRegister: (operands at: 0).
  	destReg := self concreteRegister: (operands at: 1).
  	"cond 000 1101 0 0000 dest 0000 0000 srcR"
+ 	self machineCodeAt: 0 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: destReg shifterOperand: srcReg).
- 	self machineCodeAt: 0 put: ((self t: 0 o: 16rD s: 0 rn: 0 rd: destReg) bitOr: srcReg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeNegateR (in category 'generate machine code - concretize') -----
  concretizeNegateR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| reg |
  	reg := self concreteRegister: (operands at: 0).
+ 	"rsb r?, r?, #0"
- 	"rsb r0, r0, #0"
  	self machineCodeAt: 0 put: (self t: 1 o: 3 s: 0 rn: reg rd: reg).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizePopR (in category 'generate machine code - concretize') -----
  concretizePopR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| destReg |
  	destReg := self concreteRegister: (operands at: 0).
  	"cond | 010 | 0100 | 1 | -Rn- | -Rd- | 0000 0000 0100 " "LDR destReg, [SP], #4"
+ 	self machineCodeAt: 0 put: (self t: 2 o: 4 s: 1 rn: SP rd: destReg shifterOperand: 4).
- 	self machineCodeAt: 0 put: ((self t: 2 o: 4 s: 1 rn: SP rd: destReg) bitOr: 4).
  	^machineCodeSize := 4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizePushR (in category 'generate machine code - concretize') -----
  concretizePushR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg |
  	srcReg := self concreteRegister: (operands at: 0).
  	"cond | 010 | 1001 | 1 | -Rn- | -Rd- | 0000 0000 0100" "STR srcReg, [sp, #-4]"
+ 	self machineCodeAt: 0 put: (self t: 2 o: 9 s: 1 rn: SP rd: srcReg shifterOperand: 4).
- 	self machineCodeAt: 0 put: ((self t: 2 o: 9 s: 1 rn: SP rd: srcReg) bitOr: 4).
  	^machineCodeSize := 4!

Item was added:
+ ----- Method: CogARMCompiler>>t:o:s:rn:rd:shifterOperand: (in category 'encoding') -----
+ t: type o: flagsOrOpcode s: doUpdateStatusRegister rn:  sourceRegister rd: targetRegister shifterOperand: so
+ 	<inline: true>
+ 	^(self t: type o: flagsOrOpcode s: doUpdateStatusRegister rn: sourceRegister rd: targetRegister) bitOr: so!

Item was changed:
  ----- Method: CogAbstractInstruction>>computeJumpTargetOffsetPlus: (in category 'generate machine code') -----
  computeJumpTargetOffsetPlus: anInteger
  	<inline: true> "Since it's an extraction from other methods."
  	| jumpTarget |
  	<var: #jumpTarget type: #'AbstractInstruction *'>
+ 	jumpTarget := self jumpTargetAddress.
- 	jumpTarget := cogit cCoerceSimple: (operands at: 0) to: #'AbstractInstruction *'.
- 	cogit assertSaneJumpTarget: jumpTarget.
- 	(self isAnInstruction: jumpTarget) ifTrue:
- 		[jumpTarget := cogit cCoerceSimple: jumpTarget address to: #'AbstractInstruction *'].
- 	self assert: jumpTarget ~= 0.
  	^jumpTarget signedIntFromLong - (address + anInteger) signedIntFromLong.!

Item was added:
+ ----- Method: CogAbstractInstruction>>jumpTargetAddress (in category 'generate machine code') -----
+ jumpTargetAddress
+ 	<inline: true> "Since it's an extraction from other methods."
+ 	| jumpTarget |
+ 	<var: #jumpTarget type: #'AbstractInstruction *'>
+ 	jumpTarget := cogit cCoerceSimple: (operands at: 0) to: #'AbstractInstruction *'.
+ 	cogit assertSaneJumpTarget: jumpTarget.
+ 	(self isAnInstruction: jumpTarget) ifTrue:
+ 		[jumpTarget := cogit cCoerceSimple: jumpTarget address to: #'AbstractInstruction *'].
+ 	self assert: jumpTarget ~= 0.
+ 	^jumpTarget!



More information about the Vm-dev mailing list