[Vm-dev] VM Maker: VMMaker.oscogglue-eem.1036.mcz

commits at source.squeak.org commits at source.squeak.org
Wed May 6 20:47:25 UTC 2015


Eliot Miranda uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscogglue-eem.1036.mcz

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

Name: VMMaker.oscogglue-eem.1036
Author: eem
Time: 6 May 2015, 1:45:25.429 pm
UUID: 054ce1b0-7472-4245-98f8-cb91bbcf5cba
Ancestors: VMMaker.oscogglue-eem.1035

Hacks to get the VM generated.  Fix Smalltalk=>TMethod
time issues with CogARMCompiler.

=============== Diff against VMMaker.oscogglue-eem.1035 ===============

Item was changed:
  ----- Method: CogARMCompiler>>callTargetFromReturnAddress: (in category 'inline cacheing') -----
  callTargetFromReturnAddress: callSiteReturnAddress
+ 	"Answer the address that the call immediately preceeding callSiteReturnAddress will jump to."
+ 	"this is also used by #jumpLongTargetBeforeFollowingAddress:."
- 	"Answer the address the call immediately preceeding callSiteReturnAddress will jump to."
- 	"this is also used by #jumpLongTargetBeforeFOllowingAddress: and so we check for both call and jump related instructions; later on we can use simpler tests once it feels safe to assume we get here always with a call/jump in the proper place"
  	| callDistance call |
  	call := self instructionBeforeAddress: callSiteReturnAddress.
+ 	self assert: ((self instructionIsB: call) or: [self instructionIsBL: call]).
+ 	callDistance := self extractOffsetFromBL: call.
+ 	^callSiteReturnAddress + 4 + callDistance signedIntFromLong!
- 	self assert: call ~= 0. "andeq r0, r0 will not be generated, not even as nops"
- 	((self instructionIsB: call) or:[self instructionIsBL: call])
- 		ifTrue: [ "a short call/jump" callDistance := self extractOffsetFromBL: call.
- 			^callSiteReturnAddress + 4 + callDistance signedIntFromLong].
- 	
- 	((self instructionIsBX: call) or:[self instructionIsBLX: call])
- 		ifTrue:["A Long Call/Jump. Extract the value saved to RISCTempReg from all the instructions before."
- 			^self extractOffsetFromBXAt: callSiteReturnAddress - 4].
- 	self halt
- 	!

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. We only handle those in this caseOf: and let the default return 4"
- 	"Because we don't use Thumb, each ARM instruction has 4 bytes. Some abstract opcodes need more than one instruction."
  	
- 	| rotateableAt0then4or20Block |
- 	rotateableAt0then4or20Block := [^self rotateable8bitImmediate: (operands at: 0)
- 											ifTrue: [:r :i| maxSize := 4]
- 											ifFalse: [maxSize := 20]].
  	
- 	
- 	(opcode between: FirstShortJump and: LastJump) ifTrue: [^maxSize := 16].
- 	
  	opcode
  		caseOf: {
+ 		"Noops & Pseudo Ops"
+ 		[Label]					-> [^maxSize := 0].
+ 		[AlignmentNops]		-> [^maxSize := (operands at: 0) - 4].
+ 		[Fill16]					-> [^maxSize := 4].
+ 		[Fill32]					-> [^maxSize := 4].
+ 		[FillFromWord]			-> [^maxSize := 4].
+ 		[Nop]					-> [^maxSize := 4].
+ 		"ARM Specific Control/Data Movement"
+ 		[BICCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
- 			[Label]					-> [^maxSize := 0].
- 			[AlignmentNops]		-> [^maxSize := (operands at: 0) - 1].
- 			[MoveAwR]				-> [^maxSize := 20].
- 			[MoveCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse: [maxSize := 20]].
+ 		[TstCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
+ 											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse: [maxSize := 20]].
+ 		[SMULL]				-> [^maxSize := 4].
+ 		[MSR]					-> [^maxSize := 4].
+ 		[CMPSMULL]			-> [^maxSize := 4]. "special compare for genMulR:R: usage"
+ 		"Control"
+ 		[Call]					-> [^maxSize := 4].
+ 		[CallFull]				-> [^maxSize := 20].
+ 		[JumpR]					-> [^maxSize := 4].
+ 		[Jump]					-> [^maxSize := 4].
+ 		[JumpFull]				-> [^maxSize := 20].
+ 		[JumpLong]				-> [^maxSize := 4].
+ 		[JumpZero]				-> [^maxSize := 4].
+ 		[JumpNonZero]			-> [^maxSize := 4].
+ 		[JumpNegative]			-> [^maxSize := 4].
+ 		[JumpNonNegative]		-> [^maxSize := 4].
+ 		[JumpOverflow]			-> [^maxSize := 4].
+ 		[JumpNoOverflow]		-> [^maxSize := 4].
+ 		[JumpCarry]			-> [^maxSize := 4].
+ 		[JumpNoCarry]			-> [^maxSize := 4].
+ 		[JumpLess]				-> [^maxSize := 4].
+ 		[JumpGreaterOrEqual]	-> [^maxSize := 4].
+ 		[JumpGreater]			-> [^maxSize := 4].
+ 		[JumpLessOrEqual]		-> [^maxSize := 4].
+ 		[JumpBelow]			-> [^maxSize := 4].
+ 		[JumpAboveOrEqual]	-> [^maxSize := 4].
+ 		[JumpAbove]			-> [^maxSize := 4].
+ 		[JumpBelowOrEqual]	-> [^maxSize := 4].
+ 		[JumpLongZero]		-> [^maxSize := 4].
+ 		[JumpLongNonZero]	-> [^maxSize := 4].
+ 		[JumpFPEqual]			-> [^maxSize := 8].
+ 		[JumpFPNotEqual]		-> [^maxSize := 8].
+ 		[JumpFPLess]			-> [^maxSize := 8].
+ 		[JumpFPGreaterOrEqual]-> [^maxSize := 8].
+ 		[JumpFPGreater]		-> [^maxSize := 8].
+ 		[JumpFPLessOrEqual]	-> [^maxSize := 8].
+ 		[JumpFPOrdered]		-> [^maxSize := 8].
+ 		[JumpFPUnordered]		-> [^maxSize := 8].
+ 		[RetN]					-> [^(operands at: 0) = 0 
+ 										ifTrue: [maxSize := 4]
+ 										ifFalse: [maxSize := 8]].
+ 		[Stop]					-> [^maxSize := 4].
+ 
+ 		"Arithmetic"
+ 		[AddCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
+ 											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse: [maxSize := 20]].
+ 		[AndCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
+ 											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse: [maxSize := 20]].
+ 		[AndCqRR]				-> [^self rotateable8bitImmediate: (operands at: 0)
+ 											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse: [maxSize := 20]].
+ 		[CmpCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
+ 											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse: [maxSize := 20]].
+ 		[OrCqR]					-> [^self rotateable8bitImmediate: (operands at: 0)
+ 											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse: [maxSize := 20]].
+ 		[SubCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
+ 											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse: [maxSize := 20]].
+ 		[XorCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
+ 											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse: [maxSize := 20]].
+ 		[AddCwR]				-> [^maxSize := 20].
+ 		[AndCwR]				-> [^maxSize := 20].
+ 		[CmpCwR]				-> [^maxSize := 20].
+ 		[OrCwR]				-> [^maxSize := 20].
+ 		[SubCwR]				-> [^maxSize := 20].
+ 		[XorCwR]				-> [^maxSize := 20].
+ 		[AddRR]					-> [^maxSize := 4].
+ 		[AndRR]					-> [^maxSize := 4].
+ 		[CmpRR]				-> [^maxSize := 4].
+ 		[OrRR]					-> [^maxSize := 4].
+ 		[XorRR]					-> [^maxSize := 4].
+ 		[SubRR]					-> [^maxSize := 4].
+ 		[NegateR]				-> [^maxSize := 4].
+ 		[LoadEffectiveAddressMwrR]
+ 									-> [^self rotateable8bitImmediate: (operands at: 0)
+ 											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse: [maxSize := 20]].
+ 
+ 		[LogicalShiftLeftCqR]		-> [^maxSize := 4].
+ 		[LogicalShiftRightCqR]		->  [^maxSize := 4].
+ 		[ArithmeticShiftRightCqR]	-> [^maxSize := 4].
+ 		[LogicalShiftLeftRR]			->  [^maxSize := 4].
+ 		[LogicalShiftRightRR]		->  [^maxSize := 4].
+ 		[ArithmeticShiftRightRR]		-> [^maxSize := 4].
+ 		[AddRdRd]			-> [^maxSize := 4].
+ 		[CmpRdRd]			-> [^maxSize := 4].
+ 		[SubRdRd]			-> [^maxSize := 4].
+ 		[MulRdRd]			-> [^maxSize := 4].
+ 		[DivRdRd]			-> [^maxSize := 4].
+ 		[SqrtRd]			-> [^maxSize := 4].		
+ 		"Data Movement"						
+ 		[MoveCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
+ 										ifTrue: [:r :i| maxSize := 4]
+ 										ifFalse: [maxSize := 16]].
+ 		[MoveCwR]				-> [^maxSize := 16].
+ 		[MoveRR]				-> [^maxSize := 4].
+ 		[MoveRdRd]		-> [^maxSize := 4].
+ 		[MoveAwR]				-> [^maxSize := (self isAddressRelativeToVarBase: (operands at: 0))
+ 													ifTrue: [4]
+ 													ifFalse: [20]].
+ 		[MoveRAw]				-> [^maxSize := (self isAddressRelativeToVarBase: (operands at: 1))
+ 													ifTrue: [4]
+ 													ifFalse: [20]].
+ 		[MoveRMwr]			-> [self is12BitValue: (operands at: 1)
+ 										ifTrue: [ :u :i | ^maxSize := 4]
+ 										ifFalse: [ ^maxSize := 20 ]].
+ 		[MoveRdM64r]	-> [^maxSize := 20]. 
+ 		[MoveMbrR]				-> [self is12BitValue: (operands at: 0)
+ 										ifTrue: [ :u :i | ^maxSize := 4]
+ 										ifFalse: [ ^maxSize := 20 ]].
+ 		[MoveRMbr]				-> [self is12BitValue: (operands at: 1)
+ 										ifTrue: [ :u :i | ^maxSize := 4]
+ 										ifFalse: [ ^maxSize := 20 ]].
+ 		[MoveM16rR]			-> [^self rotateable8bitImmediate: (operands at: 0)
+ 											ifTrue: [:r :i| maxSize := 4]
+ 											ifFalse: [maxSize := 20]].
+ 		[MoveM64rRd]	-> [^maxSize := 20].
+ 		[MoveMwrR]			-> [self is12BitValue: (operands at: 0)
+ 										ifTrue: [ :u :i | ^maxSize := 4]
+ 										ifFalse: [ ^maxSize := 20 ]].
+ 		[MoveXbrRR]			-> [^maxSize := 4].
+ 		[MoveRXbrR]			-> [^maxSize := 4].
+ 		[MoveXwrRR]			-> [^maxSize := 4].
+ 		[MoveRXwrR]			-> [^maxSize := 4].
+ 		[PopR]					-> [^maxSize := 4].
+ 		[PushR]					-> [^maxSize := 4].
+ 		[PushCw]				-> [^maxSize := 20].
+ 		[PushCq]				-> [^self rotateable8bitImmediate: (operands at: 0)
+ 											ifTrue: [:r :i| maxSize := 8]
+ 											ifFalse: [maxSize := 20]].
+ 		[PrefetchAw] 			-> [^maxSize := (self isAddressRelativeToVarBase: (operands at: 1))
+ 													ifTrue: [4]
+ 													ifFalse: [20]].
+ 		"Conversion"
+ 		[ConvertRRd]	-> [^maxSize := 4].
+ 
+ 
+ 		}.
+ 	^0 "to keep C compiler quiet"
- 											ifFalse: [maxSize := 16]].
- 			[MoveCwR]				-> [^maxSize := 16].
- 			[MoveRAw]				-> [^maxSize := 20].
- 			[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 := 20].
- 			[Call]					-> [^maxSize := 20 "recomputed in #sizePCDependentInstruction."].
- 			[RetN]					-> [^(operands at: 0) = 0 
- 											ifTrue: [maxSize := 4]
- 											ifFalse: [maxSize := 8]].
- 			[CmpCqR]				-> [rotateableAt0then4or20Block value].
- 			[AddCqR]				-> [rotateableAt0then4or20Block value].
- 			[BICCqR]				-> [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].
- 			[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].
- 			[LoadEffectiveAddressMwrR] -> [rotateableAt0then4or20Block value].
- 			[PushCw]				-> [^maxSize := 20].
- 		}
- 		otherwise: [^maxSize := 4].
- 	^4 "to keep C compiler quiet"
  !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeDataOperationCqR: (in category 'generate machine code - concretize') -----
+ concretizeDataOperationCqR: armOpcode
- concretizeDataOperationCqR: opcode
  	"Will get inlined into concretizeAt: switch."
  	"4 == Add, 2 == Sub, Xor == 1, And == 0, Or == 12, Bic == 14"
  	<inline: true>
+ 	|val rd rn |
+ 	val := operands at: 0.
+ 	rn := self concreteRegister: (operands at: 1).
+ 	rd := opcode = CmpOpcode ifTrue: [0] ifFalse:[rn]. "Extra note - if ever a version of this code wants to NOT set the Set flag - Cmp must always have it set or it will pretend to be a SMALALBT and Very Bad Things might happen"
+ 
+ 	self  rotateable8bitImmediate: val 
+ 		ifTrue: [:rot :immediate |
+ 			self machineCodeAt: 0 put: (self type: 1 op: armOpcode set: 1 rn: rn rd: rd shifterOperand: ((rot>>1)"in this usage we have to halve the rot value" << 8 bitOr: immediate)).
- 	self 
- 		rotateable8bitImmediate: (operands at: 0) 
- 		ifTrue: [:rot :immediate | | reg |
- 			reg := self concreteRegister: (operands at: 1).
- 			self machineCodeAt: 0 put: (self type: 1 op: opcode set: 1 rn: reg rd: reg shifterOperand: ((rot>>1)"in this usage we have to halve the rot value" << 8 bitOr: immediate)).
  			^machineCodeSize := 4]
+ 		ifFalse: ["let's try to see if the constant can be made from a simple shift of 0xFFFFFFFF"
+ 				val > 0 ifTrue: [
+ 					|hb |
+ 					hb := val highBit.
+ 					1 << hb = (val +1)
+ 						ifTrue: [ "MVN temp,  #0, making 0xffffffff"
+ 							self machineCodeAt: 0 put:(self mvn: ConcreteIPReg imm: 0 ror: 0).
+ 							"Then armOpcode reg, temp reg, lsr #(32-hb)"
+ 							 self machineCodeAt: 4 put:(self dataOpType: armOpcode rd: rd  rn: rn rm: ConcreteIPReg lsr: (32-hb)).
+ 							^machineCodeSize :=8]].
+ 					^self concretizeDataOperationCwR: armOpcode].
+ 	^0 "to keep Slang happy"
- 		ifFalse: [^self concretizeDataOperationCwR: opcode].
  	!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeDataOperationCwR: (in category 'generate machine code - concretize') -----
+ concretizeDataOperationCwR: armOpcode
- concretizeDataOperationCwR: opcode
  	"Will get inlined into concretizeAt: switch."
  	"Load the word into the RISCTempReg, then cmp R, RISCTempReg"
  	<inline: true>
+ 	| constant rn rd instrOffset|
- 	| constant srcDestReg instrOffset|
  	constant := operands at: 0.
+ 	rn := (self concreteRegister: (operands at: 1)).
+ 	rd := armOpcode = CmpOpcode ifTrue: [0] ifFalse:[rn].
+ 	instrOffset := self at: 0 moveCw: constant intoR: ConcreteIPReg.
- 	srcDestReg := (self concreteRegister: (operands at: 1)).
- 	instrOffset := self at: 0 moveCw: constant intoR: RISCTempReg.
  	self machineCodeAt: instrOffset 
+ 		put: (self type: 0 op: armOpcode set: 1 rn: rn rd: rd shifterOperand: ConcreteIPReg).
- 		put: (self type: 0 op: opcode set: 1 rn: srcDestReg rd: srcDestReg shifterOperand: RISCTempReg).
  	^machineCodeSize := instrOffset + 4!

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

Item was changed:
  ----- Method: CogARMCompiler>>extractOffsetFromBL: (in category 'testing') -----
  extractOffsetFromBL: instr
+ 	"we are told this is a BL <offset> instruction, so work out the offset it encodes"
+ 	<inline: true>
- "we are told this is a BL <offset> instruction, so work out the offset it encodes"
  	| relativeJump |
  	relativeJump := instr bitAnd: 16r00FFFFFF.
+ 	relativeJump := (relativeJump anyMask: 1<<23)
- 	relativeJump := (relativeJump bitAt: 24) = 1 
  						ifTrue: [((relativeJump bitOr: 16r3F000000) << 2) signedIntFromLong]
  						ifFalse: [relativeJump << 2].
  	^relativeJump!

Item was removed:
- ----- Method: CogARMCompiler>>extractOffsetFromBXAt: (in category 'testing') -----
- extractOffsetFromBXAt: address
- "this should return the long call/jump target"
- 	^(objectMemory byteAt: address -4) 
- 		+ ((objectMemory byteAt: address - 8) << 8) 
- 		+ ((objectMemory byteAt: address - 12) << 16) 
- 		+ ((objectMemory byteAt: address - 16) << 24)!

Item was removed:
- ----- Method: CogARMCompiler>>minimalRightRingRotationFor:initialRotation: (in category 'encoding') -----
- minimalRightRingRotationFor: constant initialRotation: iniRightRingRotation
- 	"Given a constant and some initial rotation, tries to minimize that rotation in an effort to encode the according byte in constant. This is used, to encode the last 12bit of many operations, for which a 8bit immediate rotated by (2*)4bit is available. That immediate need be encoded with minimal rotation."
- 	| byte rightRingRotation |
- 	rightRingRotation := iniRightRingRotation.
- 		"Counter rotation to get the according byte. Because Smalltalk does not have left ring shift, shift further right."
- 		rightRingRotation ~= 0 ifTrue: [
- 			byte := constant >> (-2 * rightRingRotation + 32) bitAnd: 16rFF.
- 			"For 0, the shift has to be 0. For other immediates, the encoding with minimal rightRingRotation should be choosen."
- 			byte = 0
- 				ifTrue: [ rightRingRotation := 0]
- 				ifFalse: [
- 					0 to: 2 do: [ :j | 
- 						(byte bitAnd: 16r03) = 0
- 							ifTrue: [ rightRingRotation := rightRingRotation - 1.
- 									byte := byte >> 2 ]]]]
- 			ifFalse: [ byte := constant bitAnd: 16rFF].
- 	^{rightRingRotation. byte}!



More information about the Vm-dev mailing list