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

commits at source.squeak.org commits at source.squeak.org
Thu Aug 9 19:22:34 UTC 2012


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

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

Name: VMMaker.oscog-lw.197
Author: lw
Time: 9 August 2012, 9:20:25.228 pm
UUID: 083108ce-456b-f845-be3e-9178a073a073
Ancestors: VMMaker.oscog-eem.196

Fix of #concretizeConditionalJumpLong:.
Refactoring of computeMaximumSize, with the goal to be translatable to C.

=============== Diff against VMMaker.oscog-eem.196 ===============

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

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

Item was changed:
  ----- Method: CogARMCompiler>>computeMaximumSize (in category 'generate machine code') -----
  computeMaximumSize
+ 	"Because we don't use Thumb, each ARM instruction has 4 bytes. Some abstract opcodes need more than one instruction."
- 	"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."
  	
+ 	| rotateableAt0then4or20Block |
+ 	rotateableAt0then4or20Block := [^self rotateable8bitImmediate: (operands at: 0)
- 	({CmpCqR. AddCqR. SubCqR. AndCqR. OrCqR. XorCqR} 
- 		anySatisfy: [ :each | each = opcode])
- 			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 := 16].
  	
+ 	(opcode between: FirstShortJump and: LastJump) ifTrue: [^maxSize := 16].
+ 	
  	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].
  			[MoveRMwr]			-> [self is12BitValue: (operands at: 1)
  											ifTrue: [ :u :i | ^maxSize := 4]
  											ifFalse: [ ^maxSize := 20 ]].
  			[MoveRMbr]				-> [self is12BitValue: (operands at: 1)
  											ifTrue: [ :u :i | ^maxSize := 4]
  											ifFalse: [ ^maxSize := 20 ]].
  			[MoveMwrR]			-> [self is12BitValue: (operands at: 0)
  											ifTrue: [ :u :i | ^maxSize := 4]
  											ifFalse: [ ^maxSize := 20 ]].
  			[MoveMbrR]				-> [self is12BitValue: (operands at: 0)
  											ifTrue: [ :u :i | ^maxSize := 4]
  											ifFalse: [ ^maxSize := 20 ]].
  			[PrefetchAw] 			-> [^maxSize := 16].
  			[RetN]					-> [^(operands at: 0) = 0 
  											ifTrue: [maxSize := 4]
  											ifFalse: [maxSize := 8]].
+ 			[CmpCqR]				-> [rotateableAt0then4or20Block value].
+ 			[AddCqR]				-> [rotateableAt0then4or20Block value].
+ 			[SubCqR]				-> [rotateableAt0then4or20Block value].
+ 			[AndCqR]				-> [rotateableAt0then4or20Block value].
+ 			[OrCqR]					-> [rotateableAt0then4or20Block value].
+ 			[XorCqR]				-> [rotateableAt0then4or20Block value].
+ 			[CmpCwR]				-> [^maxSize := 20].
+ 			[AddCwR]				-> [^maxSize := 20].
+ 			[SubCwR]				-> [^maxSize := 20].
+ 			[AndCwR]				-> [^maxSize := 20].
+ 			[OrCwR]				-> [^maxSize := 20].
+ 			[XorCwR]				-> [^maxSize := 20].
+ 			[JumpR]					-> [^maxSize := 4].
- 			[JumpR]					-> [^maxSize := 8].
  			[JumpFPEqual]			-> [^maxSize := 8].
  			[JumpFPNotEqual]		-> [^maxSize := 8].
  			[JumpFPLess]			-> [^maxSize := 8].
+ 			[JumpFPGreaterOrEqual]-> [^maxSize := 8].
- 			[JumpFPGreaterOrEqual]	-> [^maxSize := 8].
  			[JumpFPGreater]		-> [^maxSize := 8].
  			[JumpFPLessOrEqual]	-> [^maxSize := 8].
  			[JumpFPOrdered]		-> [^maxSize := 8].
  			[JumpFPUnordered]		-> [^maxSize := 8].
  			[JumpLong]				-> [^maxSize := 16].
  			[JumpLongZero]		-> [^maxSize := 16].
  			[JumpLongNonZero]	-> [^maxSize := 16].
+ 			[LoadEffectiveAddressMwrR] -> [rotateableAt0then4or20Block value].
- 			[LoadEffectiveAddressMwrR] -> [self rotateable8bitImmediate: (operands at: 0)
- 												ifTrue: [ :r :i | ^maxSize := 4]
- 												ifFalse: [^maxSize := 20]].
  			[PushCw]				-> [^maxSize := 20].
  		}
  		otherwise: [^maxSize := 4].
  	^4 "to keep C compiler quiet"
  !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeCall (in category 'generate machine code - concretize') -----
  concretizeCall
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| offset |
  	self assert: (operands at: 0) ~= 0.
  	self assert: (operands at: 0) \\ 4 = 0.
  	offset := (operands at: 0) signedIntFromLong - (address + 8) signedIntFromLong.
  	(self isQuick: offset)
  		ifTrue: [
  			self machineCodeAt: 0 put: (self t: 5 o: 8) + (offset >> 2 bitAnd: 16r00FFFFFF). "BL offset"
  			^machineCodeSize := 4]
  		ifFalse: [
- 
  			self concretizeConditionalJumpLong: AL.
+ 			"move the actual jump one instruction later, insterting the pc back up to lr."
  			self machineCodeAt: 16 put: (self machineCodeAt: 12).
  			"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).
  			^machineCodeSize := 20]
+ 	"We should push also lr. The problem is, that any push added here is only executed after return, and therefore useless."!
- 	"We should push at least lr. The problem is, that any push added here is only executed after return, and therefore useless."!

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 longJumpTargetAddress.
  	self at: 0 moveCw: jumpTarget intoR: RISCTempReg.
  	"add pc, r3, #<byte 0>"
+ 	self machineCodeAt: 12 put: (self c: conditionCode t: 1 o: 4 s: 0 rn: RISCTempReg rd: PC shifterOperand: (jumpTarget bitAnd: 16rFF)).
- 	self machineCodeAt: 12 put: (self t: 1 o: 4 s: 0 rn: RISCTempReg rd: PC shifterOperand: (jumpTarget bitAnd: 16rFF)).
  	^machineCodeSize := 16!

Item was changed:
  ----- 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: 0 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: PC shifterOperand: reg).
+ 	^machineCodeSize := 4!
- 	self machineCodeAt: 4 put: (self t: 0 o: 16rD s: 0 rn: 0 rd: PC shifterOperand: reg).
- 	^machineCodeSize := 8!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeMoveRMbr (in category 'generate machine code - concretize') -----
  concretizeMoveRMbr
  	"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:       (self t: 2 o: (8 bitOr: u <<2) s: 1 rn: srcReg rd: destReg shifterOperand: immediate)."
  			self machineCodeAt: 0 
  			"strb 	destReg, [srcReg, #immediate]"
  				put: (self t: 2 o: (16rA bitOr: u<<2) s: 0 rn: destReg rd: srcReg shifterOperand: immediate).
  			^machineCodeSize := 4]
  		ifFalse: [ 
  			self at: 0 moveCw: offset intoR: RISCTempReg.
  			"strb 	destReg, [srcReg, RISCTempReg]"
  			self machineCodeAt: 16 put: (self t: 3 o: 16rE s: 0 rn: srcReg rd: destReg shifterOperand: RISCTempReg).
  			^machineCodeSize := 20 ]!

Item was changed:
  ----- 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     (self t: 2 o: (8 bitOr: u <<2) s: 1 rn: srcReg rd: destReg shifterOperand: immediate)."
  			self machineCodeAt: 0 
  			"strb 	destReg, [srcReg, #immediate]"
  				put: (self t: 2 o: (8 bitOr: u<<2) s: 0 rn: destReg rd: srcReg shifterOperand: immediate).
  			^machineCodeSize := 4]
  		ifFalse: [ 
  			self at: 0 moveCw: offset intoR: RISCTempReg.
  			"strb 	destReg, [srcReg, RISCTempReg]"
  			self machineCodeAt: 16 put: (self t: 3 o: 16rC s: 0 rn: srcReg rd: destReg shifterOperand: RISCTempReg).
  			^machineCodeSize := 20 ]!



More information about the Vm-dev mailing list