[Vm-dev] VM Maker: VMMaker.oscog-tpr.1219.mcz

commits at source.squeak.org commits at source.squeak.org
Sun Apr 19 18:10:24 UTC 2015


tim Rowledge uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-tpr.1219.mcz

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

Name: VMMaker.oscog-tpr.1219
Author: tpr
Time: 19 April 2015, 11:08:55.629 am
UUID: 244f3faa-c54f-43e5-95b7-9441aa8445de
Ancestors: VMMaker.oscog-eem.1218

Merge in tpr work on the jump/call-long/full changes.
Re-organize the ARM dispatch/compute tabels to match the x86 and simplify life when comparing.

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

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"
  	
+ 	
  	opcode
  		caseOf: {
+ 		"Noops & Pseudo Ops"
+ 		[Label]					-> [^maxSize := 0].
+ 		[AlignmentNops]		-> [^maxSize := (operands at: 0) - 1].
+ 		[Fill16]					-> [^maxSize := 4].
+ 		[Fill32]					-> [^maxSize := 4].
+ 		[FillFromWord]			-> [^maxSize := 4].
+ 		[Nop]					-> [^maxSize := 4].
+ 		"ARM Specific Control/Data Movement"
+ 		[BICCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
- 			"Noops & Pseudo Ops"
- 			[Label]					-> [^maxSize := 0].
- 			[AlignmentNops]		-> [^maxSize := (operands at: 0) - 1].
- 			"Specific Control/Data Movement"
- 			[BICCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 20]].
+ 		[TstCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
- 			"Control"
- 			[CallFull]				-> [^maxSize := 20].
- 			[JumpFull]				-> [^maxSize := 20].
- 			[RetN]					-> [^(operands at: 0) = 0 
- 											ifTrue: [maxSize := 4]
- 											ifFalse: [maxSize := 8]].
- 			"Arithmetic"
- 			[CmpCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 20]].
+ 		[SMULL]				-> [^maxSize := 4].
+ 		"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)
- 			[AddCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 20]].
+ 		[AndCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
- 			[AndCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 20]].
+ 		[AndCqRR]				-> [^self rotateable8bitImmediate: (operands at: 0)
- 			[SubCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 20]].
+ 		[CmpCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
- 			[AndCqRR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 20]].
+ 		[OrCqR]					-> [^self rotateable8bitImmediate: (operands at: 0)
- 			[OrCqR]					-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 20]].
+ 		[SubCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
- 			[TstCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| maxSize := 4]
  											ifFalse: [maxSize := 20]].
+ 		[XorCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
- 			[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]
- 			[AddCwR]				-> [^maxSize := 20].
- 			[AndCwR]				-> [^maxSize := 20].
- 			[CmpCwR]				-> [^maxSize := 20].
- 			[OrCwR]				-> [^maxSize := 20].
- 			[SubCwR]				-> [^maxSize := 20].
- 			[XorCwR]				-> [^maxSize := 20].
- 			[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)
- 			"Data Movement"
- 			[MoveAwR]				-> [^maxSize := (self isAddressRelativeToVarBase: (operands at: 0))
- 														ifTrue: [4]
- 														ifFalse: [20]].
- 			[MoveCqR]				-> [^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)
- 											ifFalse: [maxSize := 16]].
- 			[MoveCwR]				-> [^maxSize := 16].
- 			[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 ]].
- 			[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 := (self isAddressRelativeToVarBase: (operands at: 1))
- 														ifTrue: [4]
- 														ifFalse: [20]].
- 			[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"
- 		}
- 		otherwise: [^maxSize := 4].
- 	^4 "to keep C compiler quiet"
  !

Item was added:
+ ----- Method: CogARMCompiler>>concretizeAddRdRd (in category 'generate machine code - concretize') -----
+ concretizeAddRdRd
+ 	self assert: false.
+ 	self notYetImplemented
+ !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeCall (in category 'generate machine code - concretize') -----
  concretizeCall
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
+ 	"Call is used only for calls within code-space, See CallFull for general anywhere in address space calling"
- 	"build either a
- 	BL offset
- 	or
- 	{move offset to offsetReg}
- 	BLX offsetReg
- 	instruction sequence. In production VMs we expect never to have long calls within generated code"
  	| offset |
  	self assert: (operands at: 0) ~= 0.
  	self assert: (operands at: 0) \\ 4 = 0.
  	offset := (operands at: 0) signedIntFromLong - (address + 8 "normal pc offset") signedIntFromLong.
+ 	self assert: (self isInImmediateJumpRange: offset). "+- 24Mb is plenty of range in code space"
+ 	self machineCodeAt: 0 put: (self bl: offset).
- 	self assert: (self isInImmediateJumpRange: offset).
- 	self machineCodeAt: 0 put: (self bl: offset). "BL offset"
  	^machineCodeSize := 4!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeCmpRdRd (in category 'generate machine code - concretize') -----
+ concretizeCmpRdRd
+ 	self assert: false.
+ 	self notYetImplemented
+ !

Item was added:
+ ----- Method: CogARMCompiler>>concretizeConvertRRd (in category 'generate machine code - concretize') -----
+ concretizeConvertRRd
+ 	self assert: false.
+ 	self notYetImplemented
+ !

Item was added:
+ ----- Method: CogARMCompiler>>concretizeDivRdRd (in category 'generate machine code - concretize') -----
+ concretizeDivRdRd
+ 	self assert: false.
+ 	self notYetImplemented
+ !

Item was added:
+ ----- Method: CogARMCompiler>>concretizeFillFromWord (in category 'generate machine code - concretize') -----
+ concretizeFillFromWord
+ 	self assert: false.
+ 	self notYetImplemented
+ !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeJumpFull (in category 'generate machine code - concretize') -----
  concretizeJumpFull
  	"Will get inlined into concretizeAt: switch."
+ 	"A JumpFull is used when we need to jump to anywhere in 32bit address space rather than somewhere known to be in code-space. It also must be relocatable and non-varying with the jump range. On ARM this means using the build-long-const + BX sequence."
- 	"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 instrOffset|
  	<var: #jumpTarget type: #'AbstractInstruction *'>
  	jumpTarget := self longJumpTargetAddress.
  	instrOffset := self at: 0 moveCw: jumpTarget intoR: ConcreteIPReg.
+ 	"bx ConcreteIPReg"
+ 	self machineCodeAt: instrOffset put: (self cond: AL bx: 0 target: ConcreteIPReg).
- 	"bx RISCTempReg"
- 	self machineCodeAt: instrOffset put: (self cond: 0 bx: 0 target: ConcreteIPReg).
- 	self assert: instrOffset = 16.
  	^machineCodeSize := instrOffset + 4!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeMoveM64rRd (in category 'generate machine code - concretize') -----
+ concretizeMoveM64rRd
+ 	self assert: false.
+ 	self notYetImplemented
+ !

Item was added:
+ ----- Method: CogARMCompiler>>concretizeMoveRdM64r (in category 'generate machine code - concretize') -----
+ concretizeMoveRdM64r
+ 	self assert: false.
+ 	self notYetImplemented!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeMulRdRd (in category 'generate machine code - concretize') -----
+ concretizeMulRdRd
+ 	self assert: false.
+ 	self notYetImplemented
+ !

Item was added:
+ ----- Method: CogARMCompiler>>concretizeSqrtRd (in category 'generate machine code - concretize') -----
+ concretizeSqrtRd
+ 	self assert: false.
+ 	self notYetImplemented
+ !

Item was added:
+ ----- Method: CogARMCompiler>>concretizeSubRdRd (in category 'generate machine code - concretize') -----
+ concretizeSubRdRd
+ 	self assert: false.
+ 	self notYetImplemented
+ !

Item was changed:
  ----- Method: CogARMCompiler>>dispatchConcretize (in category 'generate machine code') -----
  dispatchConcretize
  	"Attempt to generate concrete machine code for the instruction at address.
  	 This is the inner dispatch of concretizeAt: actualAddress which exists only
  	 to get around the branch size limits in the SqueakV3 (blue book derived)
  	 bytecode set."
  	<returnTypeC: #void>
  	cond ifNotNil:
  		[self concretizeConditionalInstruction.
  		 ^self].
  		 
  	opcode caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]					-> [^self concretizeLabel].
  		[AlignmentNops]		-> [^self concretizeAlignmentNops].
  		[Fill16]					-> [^self concretizeFill16].
  		[Fill32]					-> [^self concretizeFill32].
  		[FillFromWord]			-> [^self concretizeFillFromWord].
  		[Nop]					-> [^self concretizeNop].
+ 		"ARM Specific Control/Data Movement" 
+ 		[LDMFD]				-> [^self concretizeLDMFD].
+ 		[STMFD]				-> [^self concretizeSTMFD].
+ 		[SMULL]				-> [^self concretizeSMULL]	.
+ 		[BICCqR]					-> [^self concretizeDataOperationCqR: BicOpcode].
  		"Control"
+ 		[Call]						-> [^self concretizeCall]. "call code within code space"
+ 		[CallFull]					-> [^self concretizeCallFull]. "call code anywhere in address space"
- 		[CallFull]					-> [^self concretizeCallFull].
- 		[Call]						-> [^self concretizeCall].
  		[JumpR]						-> [^self concretizeJumpR].
+ 		[JumpFull]					-> [^self concretizeJumpFull]."jump within address space"
+ 		[JumpLong]					-> [^self concretizeConditionalJump: AL]."jumps witihn code space"
- 		[JumpFull]					-> [^self concretizeJumpFull].
- 		[JumpLong]					-> [^self concretizeConditionalJump: AL].
  		[JumpLongZero]			-> [^self concretizeConditionalJump: EQ].
  		[JumpLongNonZero]		-> [^self concretizeConditionalJump: NE].
  		[Jump]						-> [^self concretizeConditionalJump: AL].
  		[JumpZero]					-> [^self concretizeConditionalJump: EQ].
  		[JumpNonZero]				-> [^self concretizeConditionalJump: NE].
  		[JumpNegative]				-> [^self concretizeConditionalJump: MI].
  		[JumpNonNegative]			-> [^self concretizeConditionalJump: PL].
  		[JumpOverflow]				-> [^self concretizeConditionalJump: VS].
  		[JumpNoOverflow]			-> [^self concretizeConditionalJump: VC].
  		[JumpCarry]				-> [^self concretizeConditionalJump: CS].
  		[JumpNoCarry]				-> [^self concretizeConditionalJump: CC].
  		[JumpLess]					-> [^self concretizeConditionalJump: LT].
  		[JumpGreaterOrEqual]		-> [^self concretizeConditionalJump: GE].
  		[JumpGreater]				-> [^self concretizeConditionalJump: GT].
  		[JumpLessOrEqual]			-> [^self concretizeConditionalJump: LE].
  		[JumpBelow]				-> [^self concretizeConditionalJump: CC]. "unsigned lower"
  		[JumpAboveOrEqual]		-> [^self concretizeConditionalJump: CS]. "unsigned greater or equal"
  		[JumpAbove]				-> [^self concretizeConditionalJump: HI].
  		[JumpBelowOrEqual]		-> [^self concretizeConditionalJump: LS].
  		[JumpFPEqual]				-> [^self concretizeFPConditionalJump: EQ].
  		[JumpFPNotEqual]			-> [^self concretizeFPConditionalJump: NE].
+ 		[JumpFPLess]				-> [^self concretizeFPConditionalJump: LT].
- 		"[JumpFPLess]				-> [^self concretizeFPConditionalJump: LT].
  		[JumpFPGreaterOrEqual]	-> [^self concretizeFPConditionalJump: GE].
  		[JumpFPGreater]			-> [^self concretizeFPConditionalJump: GT].
  		[JumpFPLessOrEqual]		-> [^self concretizeFPConditionalJump: LE].
  		[JumpFPOrdered]			-> [^self concretizeFPConditionalJump: VC].
+ 		[JumpFPUnordered]			-> [^self concretizeFPConditionalJump: VS].
- 		[JumpFPUnordered]			-> [^self concretizeFPConditionalJump: VS]."
  		[RetN]						-> [^self concretizeRetN].
+ 		[Stop]						-> [^self concretizeStop].
  		"Arithmetic"
  		[AddCqR]					-> [^self concretizeAddCqR].
  		[AddCwR]					-> [^self concretizeDataOperationCwR: AddOpcode].
  		[AddRR]						-> [^self concretizeDataOperationRR: AddOpcode].
+ 		[AddRdRd]					-> [^self concretizeAddRdRd].
- 		"[AddRdRd]					-> [^self concretizeSEE2OpRdRd: 16r58]."
  		[AndCqR]					-> [^self concretizeAndCqR].
  		[AndCqRR]					-> [^self concretizeAndCqRR].
  		[AndCwR]					-> [^self concretizeDataOperationCwR: AndOpcode].
  		[AndRR]						-> [^self concretizeDataOperationRR: AndOpcode].
- 		[BICCqR]					-> [^self concretizeDataOperationCqR: BicOpcode].
  		[CmpCqR]					-> [^self concretizeDataOperationCqR: CmpOpcode].
  		[CmpCwR]					-> [^self concretizeDataOperationCwR: CmpOpcode].
  		[CmpRR]					-> [^self concretizeDataOperationRR: CmpOpcode].
  		[CmpRdRd]					-> [^self concretizeCmpRdRd].
+ 		[DivRdRd]					-> [^self concretizeDivRdRd].
+ 		[MulRdRd]					-> [^self concretizeMulRdRd].
- 		"[DivRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5E].
- 		[MulRdRd]					-> [^self concretizeSEE2OpRdRd: 16r59]."
  		[OrCqR]						-> [^self concretizeDataOperationCqR: OrOpcode].
  		[OrCwR]					-> [^self concretizeDataOperationCwR: OrOpcode].
  		[OrRR]						-> [^self concretizeDataOperationRR: OrOpcode].
  		[SubCqR]					-> [^self concretizeSubCqR].
  		[SubCwR]					-> [^self concretizeDataOperationCwR: SubOpcode].
  		[SubRR]						-> [^self concretizeDataOperationRR: SubOpcode].
+ 		[SubRdRd]					-> [^self concretizeSubRdRd].
+ 		[SqrtRd]					-> [^self concretizeSqrtRd].
- 		"[SubRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5C]."
- 		[SqrtRd]						-> [^self concretizeSqrtRd].
  		[TstCqR]					-> [^self concretizeTstCqR].
  		[XorCqR]						-> [^self concretizeDataOperationCqR: XorOpcode].
  		[XorCwR]						-> [^self concretizeDataOperationCwR: XorOpcode].
  		[XorRR]							-> [^self concretizeDataOperationRR: XorOpcode].
  		[NegateR]						-> [^self concretizeNegateR].
  		[LoadEffectiveAddressMwrR]	-> [^self concretizeLoadEffectiveAddressMwrR].
  		[ArithmeticShiftRightCqR]		-> [^self concretizeArithmeticShiftRightCqR].
  		[LogicalShiftRightCqR]			-> [^self concretizeLogicalShiftRightCqR].
  		[LogicalShiftLeftCqR]			-> [^self concretizeLogicalShiftLeftCqR].
  		[ArithmeticShiftRightRR]			-> [^self concretizeArithmeticShiftRightRR].
  		[LogicalShiftLeftRR]				-> [^self concretizeLogicalShiftLeftRR].
  		[LogicalShiftRightRR]			-> [^self concretizeLogicalShiftRightRR].
  		"Data Movement"
  		[MoveCqR]			-> [^self concretizeMoveCqR].
  		[MoveCwR]			-> [^self concretizeMoveCwR].
  		[MoveRR]			-> [^self concretizeMoveRR].
  		[MoveAwR]			-> [^self concretizeMoveAwR].
  		[MoveRAw]			-> [^self concretizeMoveRAw].
- 		"While the two MoveMbR and MoveMwR are quite similar (off by 1 bit), they differ way more to
- 		MoveM16R and MoveM64R. Because of that, they are not merged."
  		[MoveMbrR]			-> [^self concretizeMoveMbrR].
  		[MoveRMbr]			-> [^self concretizeMoveRMbr].
  		[MoveM16rR]		-> [^self concretizeMoveM16rR].
  		[MoveM64rRd]		-> [^self concretizeMoveM64rRd].
  		[MoveMwrR]		-> [^self concretizeMoveMwrR].
  		[MoveXbrRR]		-> [^self concretizeMoveXbrRR].
  		[MoveRXbrR]		-> [^self concretizeMoveRXbrR].
  		[MoveXwrRR]		-> [^self concretizeMoveXwrRR].
  		[MoveRXwrR]		-> [^self concretizeMoveRXwrR].
  		[MoveRMwr]		-> [^self concretizeMoveRMwr].
  		[MoveRdM64r]		-> [^self concretizeMoveRdM64r].
  		[PopR]				-> [^self concretizePopR].
  		[PushR]				-> [^self concretizePushR].
  		[PushCq]			-> [^self concretizePushCq].
  		[PushCw]			-> [^self concretizePushCw].
  		[PrefetchAw]		-> [^self concretizePrefetchAw].
- 		[Stop]				-> [^self concretizeStop].
  		"Conversion"
+ 		[ConvertRRd]		-> [^self concretizeConvertRRd]}!
- 		[ConvertRRd]		-> [^self concretizeConvertRRd].
- 		"ARM specific opcodes" 
- 		[LDMFD]			-> [^self concretizeLDMFD].
- 		[STMFD]			-> [^self concretizeSTMFD].
- 		[SMULL]			-> [^self concretizeSMULL]	}!

Item was changed:
  ----- Method: CogARMCompiler>>jumpLongByteSize (in category 'accessing') -----
  jumpLongByteSize
+ "	Branch/Call ranges.  Jump[Cond] can be generated as short as possible.  Call/Jump[Cond]Long must be generated
+ 	in the same number of bytes irrespective of displacement since their targets may be updated, but they need only
+ 	span 16Mb, the maximum size of the code zone.  This allows e.g. ARM to use single-word call and jump instructions
+ 	for most calls and jumps.  CallFull/JumpFull must also be generated in the same number of bytes irrespective of
+ 	displacement for the same reason, but they must be able to span the full (32-bit or 64-bit) address space because
+ 	they are used to call code in the C runtime, which may be distant from the code zone"
- 	"ARM calls and jumps span +/- 32 mb, more than enough for intra-zone calls and jumps."
  	^4!

Item was changed:
  ----- Method: CogARMCompiler>>rewriteCallAt:target: (in category 'inline cacheing') -----
  rewriteCallAt: callSiteReturnAddress target: callTargetAddress
  	"Rewrite a call instruction to call a different target.  This variant is used to link PICs
  	 in ceSendMiss et al, and to rewrite cached primitive calls.   Answer the extent of
  	 the code change which is used to compute the range of the icache to flush."
  	<var: #callSiteReturnAddress type: #usqInt>
  	<var: #callTargetAddress type: #usqInt>
  	| callDistance call |
  	"self cCode: ''
  		inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 10 to: callSiteReturnAddress - 1]."
  	false
  		ifTrue: [self assert: callTargetAddress >= cogit minCallAddress]
  		ifFalse: [callTargetAddress >= cogit minCallAddress ifFalse:
  					[self error: 'linking callsite to invalid address']].
  	callDistance := (callTargetAddress - (callSiteReturnAddress + 8 "pc offset"- 4 "return offset")) signedIntToLong.
  	self assert: (self isInImmediateJumpRange: callDistance). "we don't support long call updates, yet"
+ 	call := self bl: callDistance.
- 	call := self cond: AL br: 1 offset: callDistance.
  	objectMemory longAt:  callSiteReturnAddress - 4 put: call.
  
  	self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong = callTargetAddress.
  	"self cCode: ''
  		inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 10 to: callSiteReturnAddress - 1]."
  	^4!

Item was changed:
  ----- Method: CogARMCompiler>>rewriteCallFullAt:target: (in category 'inline cacheing') -----
  rewriteCallFullAt: callSiteReturnAddress target: callTargetAddress
+ 	"Rewrite a callFull instruction to jump to a different target.  This variant
- 	"Rewrite a full call instruction to call to a different target.  This variant
  	 is used to rewrite cached primitive calls.   Answer the extent of the
  	 code change which is used to compute the range of the icache to flush."
  	<var: #callSiteReturnAddress type: #usqInt>
  	<var: #callTargetAddress type: #usqInt>
  	"cogit disassembleFrom: callSiteReturnAddress - 40 to: callSiteReturnAddress + 9"
  
+ 	"check that the instruction involved is actually a long jump BX ip (reg 12)
+ 	(CogARMCompiler new blx: 12) hex '16rE12FFF3C'"
+ 	self assert: (objectMemory longAt:  callSiteReturnAddress - 4) = 16rE12FFF3C .
- 	"check that the instruction involved is actually a call BL ip (reg 12)
- 	(CogARMCompiler new bl: 16) hex"
- 	self assert: ((objectMemory longAt:  callSiteReturnAddress - 4) bitAnd: 16rFE000000) = 16rEB000000.
  	
  	"The callTargetAddress is loaded byte by byte."
  	objectMemory byteAt: callSiteReturnAddress - 20 put: (callTargetAddress >> 24 bitAnd: 16rFF).
  	objectMemory byteAt: callSiteReturnAddress - 16 put: (callTargetAddress >> 16 bitAnd: 16rFF).
  	objectMemory byteAt: callSiteReturnAddress - 12 put: (callTargetAddress >> 8 bitAnd: 16rFF).
  	objectMemory byteAt: callSiteReturnAddress - 8 put: (callTargetAddress  bitAnd: 16rFF).
  
  	self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong = callTargetAddress.
  	"self cCode: ''
  		inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 20 to: callSiteReturnAddress - 1]."
  	^20!

Item was changed:
  ----- Method: CogARMCompiler>>rewriteInlineCacheAt:tag:target: (in category 'inline cacheing') -----
  rewriteInlineCacheAt: callSiteReturnAddress tag: cacheTag target: callTargetAddress
  	"Rewrite an inline cache to call a different target for a new tag.  This variant is used
  	 to link unlinked sends in ceSend:to:numArgs: et al.  Answer the extent of the code
  	 change which is used to compute the range of the icache to flush."
  	
  	"chacheTag contains an oop to the selector which need be loaded before jumping"
  	<var: #callSiteReturnAddress type: #usqInt>
  	<var: #callTargetAddress type: #usqInt>
  	| call callDistance |
  	"cogit disassembleFrom: callSiteReturnAddress - 40 to: callSiteReturnAddress + 9"
  	false
  		ifTrue: [self assert: callTargetAddress >= cogit minCallAddress]
  		ifFalse: [callTargetAddress >= cogit minCallAddress ifFalse:
  					[self error: 'linking callsite to invalid address']].
  	callDistance := (callTargetAddress - (callSiteReturnAddress + 8 "pc offset"- 4 "return offset")) signedIntToLong.
  	
  	self assert: (self isInImmediateJumpRange: callDistance). "we don't support long call updates, yet"
+ 	call := self bl: callDistance.
- 	call := self cond: AL br: 1 offset: callDistance.
  	objectMemory longAt:  callSiteReturnAddress - 4 put: call.
  	
  	"The cacheTag is loaded byte by byte. Each byte needs to be encoded with minimal right ring rotation. See also #at:moveCw:intoR:"
  	objectMemory byteAt: callSiteReturnAddress - 20 put: (cacheTag >> 24 bitAnd: 16rFF).
  	objectMemory byteAt: callSiteReturnAddress - 16 put: (cacheTag >> 16 bitAnd: 16rFF).
  	objectMemory byteAt: callSiteReturnAddress - 12 put: (cacheTag >> 8 bitAnd: 16rFF).
  	objectMemory byteAt: callSiteReturnAddress - 8 put: (cacheTag  bitAnd: 16rFF).
  
  	self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong = callTargetAddress.
  	"self cCode: ''
  		inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 20 to: callSiteReturnAddress - 1]."
  	^20!

Item was changed:
  ----- Method: CogARMCompiler>>rewriteJumpFullAt:target: (in category 'inline cacheing') -----
  rewriteJumpFullAt: callSiteReturnAddress target: callTargetAddress
+ 	"Rewrite a full jump instruction to jump to a different target.  This variant
- 	"Rewrite a long jump instruction to jump to a different target.  This variant
  	 is used to rewrite cached primitive calls.   Answer the extent of the
  	 code change which is used to compute the range of the icache to flush."
  	<var: #callSiteReturnAddress type: #usqInt>
  	<var: #callTargetAddress type: #usqInt>
  	"cogit disassembleFrom: callSiteReturnAddress - 40 to: callSiteReturnAddress + 9"
  
  	"check that the instruction involved is actually a long jump BX ip (reg 12)
  	(CogARMCompiler new bx: 12) hex"
  	self assert: (objectMemory longAt:  callSiteReturnAddress - 4) = 16rE12FFF1C .
  	
  	"The callTargetAddress is loaded byte by byte."
  	objectMemory byteAt: callSiteReturnAddress - 20 put: (callTargetAddress >> 24 bitAnd: 16rFF).
  	objectMemory byteAt: callSiteReturnAddress - 16 put: (callTargetAddress >> 16 bitAnd: 16rFF).
  	objectMemory byteAt: callSiteReturnAddress - 12 put: (callTargetAddress >> 8 bitAnd: 16rFF).
  	objectMemory byteAt: callSiteReturnAddress - 8 put: (callTargetAddress  bitAnd: 16rFF).
  
  	self assert: (self callTargetFromReturnAddress: callSiteReturnAddress) signedIntToLong = callTargetAddress.
  	"self cCode: ''
  		inSmalltalk: [cogit disassembleFrom: callSiteReturnAddress - 20 to: callSiteReturnAddress - 1]."
  	^20!

Item was changed:
  ----- Method: CogIA32Compiler>>jumpLongByteSize (in category 'accessing') -----
  jumpLongByteSize
+ "	Branch/Call ranges.  Jump[Cond] can be generated as short as possible.  Call/Jump[Cond]Long must be generated
+ 	in the same number of bytes irrespective of displacement since their targets may be updated, but they need only
+ 	span 16Mb, the maximum size of the code zone.  This allows e.g. ARM to use single-word call and jump instructions
+ 	for most calls and jumps.  CallFull/JumpFull must also be generated in the same number of bytes irrespective of
+ 	displacement for the same reason, but they must be able to span the full (32-bit or 64-bit) address space because
+ 	they are used to call code in the C runtime, which may be distant from the code zone"
  	^5!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genGetActiveContextLarge:inBlock: (in category 'initialization') -----
  genGetActiveContextLarge: isLarge inBlock: isInBlock
  	"Create a trampoline to answer the active context that will
  	 answer it if a frame is already married, and create it otherwise.
  	 Assume numArgs is in SendNumArgsReg and ClassReg is free."
  	| header slotSize jumpSingle loopHead jumpNeedScavenge continuation exit |
  	<var: #jumpNeedScavenge type: #'AbstractInstruction *'>
  	<var: #continuation type: #'AbstractInstruction *'>
  	<var: #jumpSingle type: #'AbstractInstruction *'>
  	<var: #loopHead type: #'AbstractInstruction *'>
  	<var: #exit type: #'AbstractInstruction *'>
  	cogit "load the flag; stash it in both TempReg & ClassReg; do the compare (a prime candidated for use of AndCq:R:R:)"
  		MoveMw: FoxMethod r: FPReg R: ClassReg;
  		AndCq: MFMethodFlagHasContextFlag R: ClassReg R: TempReg.
  	jumpSingle := cogit JumpZero: 0. "jump if flag bit not set"
  	cogit "since the flag bit was set, get the context in the receiver reg and return"
  		MoveMw: FoxThisContext r: FPReg R: ReceiverResultReg;
  		RetN: 0.
  	jumpSingle jmpTarget: cogit Label.
  
  	"OK, it doesn't exist; instantiate and initialize it"
  	"set the hasContext flag; See CoInterpreter class>>initializeFrameIndices"
  	cogit
  		OrCq: MFMethodFlagHasContextFlag R: ClassReg;
  		MoveR: ClassReg Mw: FoxMethod r: FPReg.
  	"now get the home CogMethod into ClassReg and save for post-instantiation."
  	isInBlock
  		ifTrue:
  			[cogit
  				SubCq: 3 R: ClassReg; "-3 is -(hasContext+isBlock) flags"
  				MoveM16: 0 r: ClassReg R: TempReg;
  				SubR: TempReg R: ClassReg]
  		ifFalse:
  			[cogit SubCq: 1 R: ClassReg]. "-1 is hasContext flag"
  
  	"instantiate the context..."
  	slotSize := isLarge ifTrue: [LargeContextSlots] ifFalse: [SmallContextSlots].
  	header := objectMemory
  					headerForSlots: slotSize
  					format: objectMemory indexablePointersFormat
  					classIndex: ClassMethodContextCompactIndex.
  	self flag: #endianness.
  	cogit
  		MoveAw: objectMemory freeStartAddress R: ReceiverResultReg;
  		MoveCq: (self low32BitsOf: header) R: TempReg;
  		MoveR: TempReg Mw: 0 r: ReceiverResultReg;
  		MoveCq: header >> 32 R: TempReg;
  		MoveR: TempReg Mw: 4 r: ReceiverResultReg;
  		MoveR: ReceiverResultReg R: TempReg;
  		AddCq: (objectMemory smallObjectBytesForSlots: slotSize) R: TempReg;
  		MoveR: TempReg Aw: objectMemory freeStartAddress;
  		CmpCq: objectMemory getScavengeThreshold R: TempReg.
  	jumpNeedScavenge := cogit JumpAboveOrEqual: 0.
  
  	"Now initialize the fields of the context.  See CoInterpreter>>marryFrame:SP:copyTemps:"
  	"sender gets frame pointer as a SmallInteger"
  	continuation :=
  	cogit MoveR: FPReg R: TempReg.
  	self genSetSmallIntegerTagsIn: TempReg.
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (SenderIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"pc gets frame caller as a SmallInteger"
  	cogit MoveMw: FoxSavedFP r: FPReg R: TempReg.
  	self genSetSmallIntegerTagsIn: TempReg.
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (InstructionPointerIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Set the method field, freeing up ClassReg again, and frame's context field,"
  	cogit
  		MoveMw: (cogit offset: CogMethod of: #methodObject) r: ClassReg R: TempReg;
  		MoveR: TempReg Mw: objectMemory baseHeaderSize + (MethodIndex * objectMemory wordSize) r: ReceiverResultReg;
  		MoveR: ReceiverResultReg Mw: FoxThisContext r: FPReg.
  
  	"Now compute stack pointer; this is stackPointer (- 1 for return pc if a CISC) - framePointer - 4 (1 each for saved pc, method, context, receiver) + 1 (1-relative) + numArgs"
  	"TPR note - the code here is actually doing
  	context stackPointer := ((((fp - sp) / 4) - [3|4]) + num args) asSmallInteger"
  	cogit
  		MoveR: FPReg R: TempReg;
  		SubR: SPReg R: TempReg;
  		LogicalShiftRightCq: self log2BytesPerWord R: TempReg;
  		SubCq: (cogit backEnd hasLinkRegister ifTrue: [3] ifFalse: [4]) R: TempReg;
  		AddR: SendNumArgsReg R: TempReg.
  	self genConvertIntegerToSmallIntegerInReg: TempReg.
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (StackPointerIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Set closureOrNil to either the stacked receiver or nil"
  	isInBlock
  		ifTrue:
  			[cogit
  				MoveR: SendNumArgsReg R: TempReg;
  				AddCq: 2 R: TempReg; "+2 for saved fp and saved pc"
  				MoveXwr: TempReg R: FPReg R: TempReg]
  		ifFalse:
  			[cogit MoveCw: objectMemory nilObject R: TempReg].
  	cogit MoveR: TempReg Mw: objectMemory baseHeaderSize + (ClosureIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Set the receiver"
  	cogit
  		MoveMw: FoxMFReceiver r: FPReg R: TempReg;
  		MoveR: TempReg Mw: objectMemory baseHeaderSize + (ReceiverIndex * objectMemory bytesPerOop) r: ReceiverResultReg.
  
  	"Now copy the arguments.  This is tricky because of the shortage of registers,.  ClassReg ranges
  	 from 1 to numArgs (SendNumArgsReg), and from ReceiverIndex + 1 to ReceiverIndex + numArgs.
  	 1 to: numArgs do:
  		[:i|
  		temp := longAt(FPReg + ((SendNumArgs - i + 2) * BytesPerWord)). +2 for saved pc and savedfp
  		longAtput(FPReg + FoxMFReceiver + (i * BytesPerWord), temp)]"
  	"TPR note: this is a prime candidate for passing off to the backend to do at least faintly optimal code"
  	cogit MoveCq: 1 R: ClassReg.
  	loopHead := cogit CmpR: SendNumArgsReg R: ClassReg.
  	exit := cogit JumpGreater: 0.
  	cogit
  		MoveR: SendNumArgsReg R: TempReg;
  		SubR: ClassReg R: TempReg;
  		AddCq: 2 R: TempReg; "+2 for saved fp and saved pc"
  		MoveXwr: TempReg R: FPReg R: TempReg;
  		AddCq: ReceiverIndex + (objectMemory baseHeaderSize / objectMemory wordSize) R: ClassReg; "Now convert ClassReg from frame index to context index"
  		MoveR: TempReg Xwr: ClassReg R: ReceiverResultReg;
  		SubCq: ReceiverIndex + (objectMemory baseHeaderSize / objectMemory wordSize) - 1 R: ClassReg; "convert back adding 1 ;-)"
  		Jump: loopHead.
  	exit jmpTarget: cogit Label.
  
  	"Finally nil or copy the non-argument temps.
  	 ClassReg := FPReg + FoxMFReceiver.
  	 SendNumArgsReg := SendNumArgsReg+ReceiverIndex.
  	 [ClassReg := ClassReg - 4.
  	  backEnd hasLinkRegister
  			ifTrue: [ClassReg > SPReg]
  			ifFalse: [ClassReg >= SPReg]] whileTrue:
  		[receiver[SendNumArgsReg] := *ClassReg.
  		 SendNumArgsReg := SendNumArgsReg + 1]]"
  	coInterpreter marryFrameCopiesTemps ifFalse:
  		[cogit MoveCq: objectMemory nilObject R: TempReg].
- 	"Could usefully use AddCq:R:R:"
  	cogit
  		MoveR: FPReg R: ClassReg;
  		AddCq: FoxMFReceiver R: ClassReg;
  		AddCq: ReceiverIndex + 1 + (objectMemory baseHeaderSize / objectMemory wordSize) R: SendNumArgsReg.
  	loopHead :=
  	cogit SubCq: objectMemory wordSize R: ClassReg.
  	cogit CmpR: SPReg R: ClassReg.
  	"If on a CISC there's a retpc for the trampoline call on top of stack; if on a RISC there isn't."
  	exit := cogit backEnd hasLinkRegister
  				ifTrue: [cogit JumpBelow: 0]
  				ifFalse: [cogit JumpBelowOrEqual: 0].
  	coInterpreter marryFrameCopiesTemps ifTrue:
  		[cogit MoveMw: 0 r: ClassReg R: TempReg].
  	cogit
  		MoveR: TempReg Xwr: SendNumArgsReg R: ReceiverResultReg;
  		AddCq: 1 R: SendNumArgsReg;
  		Jump: loopHead.
  	exit jmpTarget: cogit Label.
  
  	cogit RetN: 0.
  	
  	jumpNeedScavenge jmpTarget:
  		(cogit backEnd saveAndRestoreLinkRegAround: [cogit CallRT: ceScheduleScavengeTrampoline]). "We need to push the LR here for ARM, and pop it back after the callRT:"
  	cogit Jump: continuation.
  	^0!

Item was changed:
  ----- Method: Cogit>>JumpFullRT: (in category 'method map') -----
  JumpFullRT: callTarget
  	"Big assumption here that calls and jumps look the same as regards their displacement.
+ 	 This works on x86 and I think on ARM.
+ 	JumpFull is intended to be the jumps anywhere in our address space. See also JumpLong et al. which jump within our *code* space"
- 	 This works on x86 and I think on ARM."
  	<inline: true>
  	<returnTypeC: #'AbstractInstruction *'>
  	^self annotateCall: (self JumpFull: callTarget)!



More information about the Vm-dev mailing list