[Vm-dev] VM Maker: VMMaker.oscog-eem.2637.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Dec 27 01:21:22 UTC 2019


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

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

Name: VMMaker.oscog-eem.2637
Author: eem
Time: 26 December 2019, 5:21:06.892276 pm
UUID: 9406ac13-a311-4154-b390-671ad1789116
Ancestors: VMMaker.oscog-eem.2636

Implement and use the full set of ShiftCqRR

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

Item was changed:
  ----- Method: CogARMCompiler>>computeMaximumSize (in category 'generate machine code') -----
  computeMaximumSize
  	"Because we don't use Thumb, each ARM instruction has 4 bytes. Many
  	 abstract opcodes need more than one instruction. Instructions that refer
  	 to constants and/or literals depend on literals being stored in-line or out-of-line.
  
  	 N.B.  The ^N forms are to get around the bytecode compiler's long branch
  	 limits which are exceeded when each case jumps around the otherwise."
  
  	opcode
  		caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]					-> [^0].
  		[Literal]					-> [^4].
  		[AlignmentNops]		-> [^(operands at: 0) - 4].
  		[Fill32]					-> [^4].
  		[Nop]					-> [^4].
  		"Control"
  		[Call]					-> [^4].
  		[CallFull]				-> [^self literalLoadInstructionBytes + 4].
  		[JumpR]					-> [^4].
  		[Jump]					-> [^4].
  		[JumpFull]				-> [^self literalLoadInstructionBytes + 4].
  		[JumpLong]				-> [^4].
  		[JumpZero]				-> [^4].
  		[JumpNonZero]			-> [^4].
  		[JumpNegative]			-> [^4].
  		[JumpNonNegative]		-> [^4].
  		[JumpOverflow]			-> [^4].
  		[JumpNoOverflow]		-> [^4].
  		[JumpCarry]			-> [^4].
  		[JumpNoCarry]			-> [^4].
  		[JumpLess]				-> [^4].
  		[JumpGreaterOrEqual]	-> [^4].
  		[JumpGreater]			-> [^4].
  		[JumpLessOrEqual]		-> [^4].
  		[JumpBelow]			-> [^4].
  		[JumpAboveOrEqual]	-> [^4].
  		[JumpAbove]			-> [^4].
  		[JumpBelowOrEqual]	-> [^4].
  		[JumpLongZero]		-> [^4].
  		[JumpLongNonZero]	-> [^4].
  		[JumpFPEqual]			-> [^8].
  		[JumpFPNotEqual]		-> [^8].
  		[JumpFPLess]			-> [^8].
  		[JumpFPGreaterOrEqual]-> [^8].
  		[JumpFPGreater]		-> [^8].
  		[JumpFPLessOrEqual]	-> [^8].
  		[JumpFPOrdered]		-> [^8].
  		[JumpFPUnordered]		-> [^8].
  		[RetN]					-> [^(operands at: 0) = 0 ifTrue: [4] ifFalse: [8]].
  		[Stop]					-> [^4].
  
  		"Arithmetic"
  		[AddCqR]				-> [^self rotateable8bitSignedImmediate: (operands at: 0)
  										ifTrue: [:r :i :n| 4]
  										ifFalse: [self literalLoadInstructionBytes + 4]].
  		[AndCqR]				-> [^self rotateable8bitBitwiseImmediate: (operands at: 0)
  										ifTrue: [:r :i :n| 4]
  										ifFalse:
  											[self literalLoadInstructionBytes = 4
  												ifTrue: [8]
  												ifFalse:
  													[1 << (operands at: 0) highBit = ((operands at: 0) + 1)
  														ifTrue: [8]
  														ifFalse: [self literalLoadInstructionBytes + 4]]]].
  		[AndCqRR]				-> [^self rotateable8bitBitwiseImmediate: (operands at: 0)
  										ifTrue: [:r :i :n| 4]
  										ifFalse:
  											[self literalLoadInstructionBytes = 4
  												ifTrue: [8]
  												ifFalse:
  													[1 << (operands at: 0) highBit = ((operands at: 0) + 1)
  														ifTrue: [8]
  														ifFalse: [self literalLoadInstructionBytes + 4]]]].
  		[CmpCqR]				-> [^self rotateable8bitSignedImmediate: (operands at: 0)
  											ifTrue: [:r :i :n| 4]
  											ifFalse: [self literalLoadInstructionBytes + 4]].
  		[OrCqR]					-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| 4]
  											ifFalse: [self literalLoadInstructionBytes + 4]].
  		[SubCqR]				-> [^self rotateable8bitSignedImmediate: (operands at: 0)
  											ifTrue: [:r :i :n| 4]
  											ifFalse: [self literalLoadInstructionBytes + 4]].
  		[TstCqR]				-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| 4]
  											ifFalse: [self literalLoadInstructionBytes + 4]].
  		[XorCqR]				-> [^self rotateable8bitBitwiseImmediate: (operands at: 0)
  										ifTrue: [:r :i :n| 4]
  										ifFalse:
  											[self literalLoadInstructionBytes = 4
  												ifTrue: [8]
  												ifFalse:
  													[1 << (operands at: 0) highBit = ((operands at: 0) + 1)
  														ifTrue: [8]
  														ifFalse: [self literalLoadInstructionBytes + 4]]]].
  		[AddCwR]				-> [^self literalLoadInstructionBytes + 4].
  		[AndCwR]				-> [^self literalLoadInstructionBytes + 4].
  		[CmpCwR]				-> [^self literalLoadInstructionBytes + 4].
  		[OrCwR]				-> [^self literalLoadInstructionBytes + 4].
  		[SubCwR]				-> [^self literalLoadInstructionBytes + 4].
  		[XorCwR]				-> [^self literalLoadInstructionBytes + 4].
  		[AddRR]				-> [^4].
  		[AndRR]				-> [^4].
  		[CmpRR]				-> [^4].
  		[OrRR]					-> [^4].
  		[XorRR]					-> [^4].
  		[SubRR]				-> [^4].
  		[AddRRR]				-> [^4].
  		[SubRRR]				-> [^4].
  		[NegateR]				-> [^4].
  		[LoadEffectiveAddressMwrR]
  									-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| 4]
  											ifFalse: [self literalLoadInstructionBytes + 4]].
  
  		[LogicalShiftLeftCqR]		-> [^4].
  		[LogicalShiftRightCqR]		-> [^4].
+ 		[ArithmeticShiftRightCqRR]	-> [^4].
  		[LogicalShiftRightCqRR]	-> [^4].
+ 		[LogicalShiftLeftCqRR]		-> [^4].
  		[ArithmeticShiftRightCqR]	-> [^4].
  		[LogicalShiftLeftRR]			-> [^4].
  		[LogicalShiftRightRR]		-> [^4].
  		[ArithmeticShiftRightRR]	-> [^4].
  		[AddRdRd]					-> [^4].
  		[CmpRdRd]					-> [^4].
  		[SubRdRd]					-> [^4].
  		[MulRdRd]					-> [^4].
  		[DivRdRd]					-> [^4].
  		[SqrtRd]					-> [^4].
  		[ClzRR]					-> [^4].
  		"ARM Specific Arithmetic"
  		[SMULL]				-> [^4].
  		[MSR]					-> [^4].
  		[CMPSMULL]			-> [^4]. "special compare for genMulR:R: usage"
  		"ARM Specific Data Movement"
  		[PopLDM]				-> [^4].
  		[PushSTM]				-> [^4].
  		"Data Movement"						
  		[MoveCqR]				-> [^self literalLoadInstructionBytes = 4
  										ifTrue: [self literalLoadInstructionBytes]
  										ifFalse:
  											[self rotateable8bitBitwiseImmediate: (operands at: 0)
  												ifTrue: [:r :i :n| 4]
  												ifFalse: [self literalLoadInstructionBytes]]].
  		[MoveCwR]				-> [^self literalLoadInstructionBytes = 4
  										ifTrue: [self literalLoadInstructionBytes]
  										ifFalse:
  											[(self inCurrentCompilation: (operands at: 0))
  												ifTrue: [4]
  												ifFalse: [self literalLoadInstructionBytes]]].
  		[MoveRR]				-> [^4].
  		[MoveRdRd]				-> [^4].
  		[MoveAwR]				-> [^(self isAddressRelativeToVarBase: (operands at: 0))
  													ifTrue: [4]
  													ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveRAw]				-> [^(self isAddressRelativeToVarBase: (operands at: 1))
  													ifTrue: [4]
  													ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveAbR]				-> [^(self isAddressRelativeToVarBase: (operands at: 0))
  													ifTrue: [4]
  													ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveRAb]				-> [^(self isAddressRelativeToVarBase: (operands at: 1))
  													ifTrue: [4]
  													ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveRMwr]			-> [^self is12BitValue: (operands at: 1)
  										ifTrue: [:u :i| 4]
  										ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveRdM64r]			-> [^4]. 
  		[MoveMbrR]				-> [^self is12BitValue: (operands at: 0)
  										ifTrue: [:u :i| 4]
  										ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveRMbr]				-> [^self is12BitValue: (operands at: 1)
  										ifTrue: [:u :i| 4]
  										ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveRM16r]				-> [^self is12BitValue: (operands at: 1)
  										ifTrue: [:u :i| 4]
  										ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveM16rR]			-> [^self rotateable8bitImmediate: (operands at: 0)
  											ifTrue: [:r :i| 4]
  											ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveM64rRd]			-> [^4].
  		[MoveMwrR]			-> [^self is12BitValue: (operands at: 0)
  										ifTrue: [:u :i| 4]
  										ifFalse: [self literalLoadInstructionBytes + 4]].
  		[MoveXbrRR]			-> [^4].
  		[MoveRXbrR]			-> [^4].
  		[MoveXwrRR]			-> [^4].
  		[MoveRXwrR]			-> [^4].
  		[PopR]					-> [^4].
  		[PushR]					-> [^4].
  		[PushCw]				-> [^self literalLoadInstructionBytes = 4
  										ifTrue: [self literalLoadInstructionBytes + 4]
  										ifFalse:
  											[(self inCurrentCompilation: (operands at: 0))
  												ifTrue: [8]
  												ifFalse:
  													[self rotateable8bitBitwiseImmediate: (operands at: 0)
  														ifTrue: [:r :i :n| 8]
  														ifFalse: [self literalLoadInstructionBytes + 4]]]].
  		[PushCq]				-> [^self literalLoadInstructionBytes = 4
  										ifTrue: [self literalLoadInstructionBytes + 4]
  										ifFalse:
  											[self rotateable8bitBitwiseImmediate: (operands at: 0)
  												ifTrue: [:r :i :n| 8]
  												ifFalse: [self literalLoadInstructionBytes + 4]]].
  		[PrefetchAw] 			-> [^(self isAddressRelativeToVarBase: (operands at: 0))
  										ifTrue: [4]
  										ifFalse: [self literalLoadInstructionBytes + 4]].
  		"Conversion"
  		[ConvertRRd]			-> [^8].
  		}.
  	^0 "to keep C compiler quiet"
  !

Item was changed:
  ----- Method: CogARMCompiler>>concretizeArithmeticShiftRightCqR (in category 'generate machine code - concretize') -----
  concretizeArithmeticShiftRightCqR
  	"Will get inlined into concretizeAt: switch."
  	"this is an unfortunate waste of an instruction in most cases since the shift can usually be done in a subsequent arithmetic instruction. 
  	Handle for now with a MOVS reg, reg, ASR #distance"
  	<inline: true>
  	| distance reg |
+ 	distance := (operands at: 0).
- 	distance := (operands at: 0) min: 31.
  	reg := operands at: 1.
+ 	self assert: (distance between: 1 and: 31).
  	"cond 000 1101 0 0000 dest dist -100 srcR"
  	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 1 rn: 0 rd: reg 
  									shifterOperand: (distance << 7 bitOr: (64 "flag for arithmetic" bitOr: reg))).
+ 	"cogit processor disassembleInstructionAt: 0 In: machineCode object"
  	^4!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeArithmeticShiftRightCqRR (in category 'generate machine code - concretize') -----
+ concretizeArithmeticShiftRightCqRR
+ 	"Will get inlined into concretizeAt: switch."
+ 	"this is an unfortunate waste of an instruction in most cases since the shift can usually be done in a subsequent arithmetic instruction. 
+ 	Handle for now with a MOVS reg, reg, ASR #distance"
+ 	<inline: true>
+ 	| distance srcReg destReg |
+ 	distance := (operands at: 0).
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
+ 	self assert: (distance between: 1 and: 31).
+ 	"cond 000 1101 0 0000 dest dist -100 srcR"
+ 	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 1 rn: 0 rd: destReg 
+ 									shifterOperand: (distance << 7 bitOr: (64 "flag for arithmetic" bitOr: srcReg))).
+ 	"cogit processor disassembleInstructionAt: 0 In: machineCode object"
+ 	^4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeLogicalShiftLeftCqR (in category 'generate machine code - concretize') -----
  concretizeLogicalShiftLeftCqR
  	"Will get inlined into concretizeAt: switch."
  	"this is an unfortunate waste of an instruction in most cases since the shift can usually be done in a subsequent arithmetic instruction. 
  	Handle for now with a MOVS reg, reg, LSL #distance"
  	<inline: true>
  	| distance reg |
+ 	distance := (operands at: 0).
- 	distance := (operands at: 0) min: 31.
  	reg := operands at: 1.
+ 	self assert: (distance between: 1 and: 31).
  	"cond 000 1101 0 0000 dest dista 000 srcR"
  	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 1 rn: 0 rd: reg shifterOperand: (distance << 7 bitOr: reg)).
+ 	"cogit processor disassembleInstructionAt: 0 In: machineCode object"
  	^4!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeLogicalShiftLeftCqRR (in category 'generate machine code - concretize') -----
+ concretizeLogicalShiftLeftCqRR
+ 	"Will get inlined into concretizeAt: switch."
+ 	"this is an unfortunate waste of an instruction in most cases since the shift can usually be done in a subsequent arithmetic instruction. 
+ 	Handle for now with a MOVS reg, reg, LSL #distance"
+ 	<inline: true>
+ 	| distance srcReg destReg |
+ 	distance := (operands at: 0).
+ 	srcReg := operands at: 1.
+ 	destReg := operands at: 2.
+ 	self assert: (distance between: 1 and: 31).
+ 	"cond 000 1101 0 0000 dest dista 000 srcR"
+ 	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 1 rn: 0 rd: destReg shifterOperand: (distance << 7 bitOr: srcReg)).
+ 	"cogit processor disassembleInstructionAt: 0 In: machineCode object"
+ 	^4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeLogicalShiftRightCqR (in category 'generate machine code - concretize') -----
  concretizeLogicalShiftRightCqR
  	"Will get inlined into concretizeAt: switch."
  	"this is an unfortunate waste of an instruction in most cases since the shift can usually be done in a subsequent arithmetic instruction. 
  	Handle for now with a MOVS reg, reg, LSR #distance"
  	<inline: true>
  	| distance reg |
+ 	distance := (operands at: 0).
- 	distance := (operands at: 0) min: 31.
  	reg := operands at: 1.
+ 	self assert: (distance between: 1 and: 31).
  	"cond 000 1101 0 0000 dest dist -010 srcR"
  	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 1 rn: 0 rd: reg 
  									shifterOperand: (distance << 7 bitOr: (32 bitOr: reg))).
+ 	"cogit processor disassembleInstructionAt: 0 In: machineCode object"
  	^4!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeLogicalShiftRightCqRR (in category 'generate machine code - concretize') -----
  concretizeLogicalShiftRightCqRR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| distance srcReg destReg |
+ 	distance := (operands at: 0).
- 	distance := (operands at: 0) min: 31.
  	srcReg := operands at: 1.
  	destReg := operands at: 2.
+ 	self assert: (distance between: 1 and: 31).
  	"cond 000 1101 0 0000 dest dist -010 srcR"
  	self machineCodeAt: 0 put: (self type: 0 op: MoveOpcode set: 1 rn: 0 rd: destReg 
  									shifterOperand: (distance << 7 bitOr: (32 bitOr: srcReg))).
  	"cogit processor disassembleInstructionAt: 0 In: machineCode object"
  	^4!

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."
  	conditionOrNil ifNotNil:
  		[^self concretizeConditionalInstruction].
  		 
  	opcode caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]					-> [^self concretizeLabel].
  		[Literal]					-> [^self concretizeLiteral].
  		[AlignmentNops]		-> [^self concretizeAlignmentNops].
  		[Fill32]					-> [^self concretizeFill32].
  		[Nop]					-> [^self concretizeNop].
  		"Control"
  		[Call]						-> [^self concretizeCall]. "call code within code space"
  		[CallFull]					-> [^self concretizeCallFull]. "call code anywhere in address space"
  		[JumpR]					-> [^self concretizeJumpR].
  		[JumpFull]					-> [^self concretizeJumpFull]."jump within address space"
  		[JumpLong]				-> [^self concretizeConditionalJump: AL]."jump within code space"
  		[JumpLongZero]			-> [^self concretizeConditionalJump: EQ].
  		[JumpLongNonZero]		-> [^self concretizeConditionalJump: NE].
  		[Jump]						-> [^self concretizeConditionalJump: AL]. "jump within a method, etc"
  		[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].
  		[JumpFPGreaterOrEqual]	-> [^self concretizeFPConditionalJump: GE].
  		[JumpFPGreater]			-> [^self concretizeFPConditionalJump: GT].
  		[JumpFPLessOrEqual]		-> [^self concretizeFPConditionalJump: LE].
  		[JumpFPOrdered]			-> [^self concretizeFPConditionalJump: VC].
  		[JumpFPUnordered]			-> [^self concretizeFPConditionalJump: VS].
  		[RetN]						-> [^self concretizeRetN].
  		[Stop]						-> [^self concretizeStop].
  		"Arithmetic"
  		[AddCqR]					-> [^self concretizeNegateableDataOperationCqR: AddOpcode].
  		[AndCqR]					-> [^self concretizeInvertibleDataOperationCqR: AndOpcode].
  		[AndCqRR]					-> [^self concretizeAndCqRR].
  		[CmpCqR]					-> [^self concretizeNegateableDataOperationCqR: CmpOpcode].
  		[OrCqR]					-> [^self concretizeDataOperationCqR: OrOpcode].
  		[SubCqR]					-> [^self concretizeSubCqR].
  		[TstCqR]					-> [^self concretizeTstCqR].
  		[XorCqR]					-> [^self concretizeInvertibleDataOperationCqR: XorOpcode].
  		[AddCwR]					-> [^self concretizeDataOperationCwR: AddOpcode].
  		[AndCwR]					-> [^self concretizeDataOperationCwR: AndOpcode].
  		[CmpCwR]					-> [^self concretizeDataOperationCwR: CmpOpcode].
  		[OrCwR]					-> [^self concretizeDataOperationCwR: OrOpcode].
  		[SubCwR]					-> [^self concretizeDataOperationCwR: SubOpcode].
  		[XorCwR]					-> [^self concretizeDataOperationCwR: XorOpcode].
  		[AddRR]					-> [^self concretizeDataOperationRR: AddOpcode].
  		[AndRR]					-> [^self concretizeDataOperationRR: AndOpcode].
  		[CmpRR]					-> [^self concretizeDataOperationRR: CmpOpcode].
  		[OrRR]						-> [^self concretizeDataOperationRR: OrOpcode].
  		[SubRR]					-> [^self concretizeDataOperationRR: SubOpcode].
  		[XorRR]						-> [^self concretizeDataOperationRR: XorOpcode].
  		[AddRRR]					-> [^self concretizeDataOperationRRR: AddOpcode].
  		[SubRRR]					-> [^self concretizeDataOperationRRR: SubOpcode].
  		[AddRdRd]					-> [^self concretizeAddRdRd].
  		[CmpRdRd]					-> [^self concretizeCmpRdRd].
  		[DivRdRd]					-> [^self concretizeDivRdRd].
  		[MulRdRd]					-> [^self concretizeMulRdRd].
  		[SubRdRd]					-> [^self concretizeSubRdRd].
  		[SqrtRd]					-> [^self concretizeSqrtRd].
  		[NegateR]						-> [^self concretizeNegateR].
  		[LoadEffectiveAddressMwrR]	-> [^self concretizeLoadEffectiveAddressMwrR].
  		[ArithmeticShiftRightCqR]		-> [^self concretizeArithmeticShiftRightCqR].
  		[LogicalShiftRightCqR]			-> [^self concretizeLogicalShiftRightCqR].
- 		[LogicalShiftRightCqRR]		-> [^self concretizeLogicalShiftRightCqRR].
  		[LogicalShiftLeftCqR]			-> [^self concretizeLogicalShiftLeftCqR].
+ 		[ArithmeticShiftRightCqRR]		-> [^self concretizeArithmeticShiftRightCqRR].
+ 		[LogicalShiftRightCqRR]		-> [^self concretizeLogicalShiftRightCqRR].
+ 		[LogicalShiftLeftCqRR]			-> [^self concretizeLogicalShiftLeftCqRR].
+ 		[ArithmeticShiftRightRR]		-> [^self concretizeArithmeticShiftRightRR].
- 		[ArithmeticShiftRightRR]			-> [^self concretizeArithmeticShiftRightRR].
  		[LogicalShiftLeftRR]				-> [^self concretizeLogicalShiftLeftRR].
  		[LogicalShiftRightRR]			-> [^self concretizeLogicalShiftRightRR].
  		[ClzRR]						-> [^self concretizeClzRR].
  		"ARM Specific Arithmetic" 
  		[SMULL]			-> [^self concretizeSMULL]	.
  		[CMPSMULL]		-> [^self concretizeCMPSMULL].
  		[MSR]				-> [^self concretizeMSR].
  		"ARM Specific Data Movement"
  		[PopLDM]			-> [^self concretizePushOrPopMultipleRegisters: false].
  		[PushSTM]			-> [^self concretizePushOrPopMultipleRegisters: true].
  		"Data Movement"
  		[MoveCqR]			-> [^self concretizeMoveCqR].
  		[MoveCwR]			-> [^self concretizeMoveCwR].
  		[MoveRR]			-> [^self concretizeMoveRR].
  		[MoveAwR]			-> [^self concretizeMoveAwR].
  		[MoveRAw]			-> [^self concretizeMoveRAw].
  		[MoveAbR] 			 -> [^self concretizeMoveAbR].
   		[MoveRAb]			-> [^self concretizeMoveRAb].
  		[MoveMbrR]			-> [^self concretizeMoveMbrR].
  		[MoveRMbr]			-> [^self concretizeMoveRMbr].
  		[MoveRM16r]		-> [^self concretizeMoveRM16r].
  		[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].
  		"Conversion"
  		[ConvertRRd]		-> [^self concretizeConvertRRd]}.
  
  	^0 "keep Slang happy"!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genJumpIsSmallIntegerValue:scratch: (in category 'compile abstract instructions') -----
  genJumpIsSmallIntegerValue: aRegister scratch: scratchReg
  	"Generate a test for aRegister containing an integer value in the SmallInteger range, and a jump if so, answering the jump.
  	 c.f. Spur32BitMemoryManager>>isIntegerValue:"
  	<returnTypeC: #'AbstractInstruction *'>
  	^cogit
+ 		LogicalShiftLeftCq: 1 R: aRegister R: scratchReg;
- 		MoveR: aRegister R: scratchReg;
- 		LogicalShiftLeftCq: 1 R: scratchReg;
  		XorR: aRegister R: scratchReg;
  		JumpGreaterOrEqual: 0!

Item was changed:
  ----- Method: CogObjectRepresentationFor32BitSpur>>genJumpNotSmallIntegerValue:scratch: (in category 'compile abstract instructions') -----
  genJumpNotSmallIntegerValue: aRegister scratch: scratchReg
  	"Generate a test for aRegister containing an integer value outside the SmallInteger range, and a jump if so, answering the jump.
  	 c.f. Spur32BitMemoryManager>>isIntegerValue:"
  	<returnTypeC: #'AbstractInstruction *'>
  	^cogit
+ 		ArithmeticShiftRightCq: 1 R: aRegister R: scratchReg;
- 		MoveR: aRegister R: scratchReg;
- 		ArithmeticShiftRightCq: 1 R: scratchReg;
  		XorR: aRegister R: scratchReg;
  		JumpLess: 0!

Item was changed:
  ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpIsSmallIntegerValue:scratch: (in category 'compile abstract instructions') -----
  genJumpIsSmallIntegerValue: aRegister scratch: scratchReg
  	"Generate a test for aRegister containing an integer value in the SmallInteger range, and a jump if so, answering the jump.
  	 c.f. Spur64BitMemoryManager>>isIntegerValue:"
  	<returnTypeC: #'AbstractInstruction *'>
  	^cogit
+ 		ArithmeticShiftRightCq: 63 - objectMemory numTagBits R: aRegister R: scratchReg;
- 		MoveR: aRegister R: scratchReg;
- 		ArithmeticShiftRightCq: 63 - objectMemory numTagBits R: scratchReg;
  		AddCq: 1 R: scratchReg;
  		AndCq: 1 << (objectMemory numTagBits + 1) - 1 R: scratchReg; "sign and top numTags bits must be the same"
  		CmpCq: 1 R: scratchReg;
  		JumpLessOrEqual: 0!

Item was changed:
  ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotSmallFloatValueBits:scratch: (in category 'compile abstract instructions') -----
  genJumpNotSmallFloatValueBits: reg scratch: exponent
  	"Generate a test to check that the integer register contains a floating point value within the SmallFloat64 range,
  	 and answer the jump.  c.f. Spur64BitMemoryManager>>isSmallFloatValue:"
  	| jumpFail jumpTest jumpMinExponent jumpMaxExponent jumpZeroMantissa |
  	<var: #jumpFail type: #'AbstractInstruction *'>
  	<var: #jumpTest type: #'AbstractInstruction *'>
  	<var: #jumpMinExponent type: #'AbstractInstruction *'>
  	<var: #jumpMaxExponent type: #'AbstractInstruction *'>
  	<var: #jumpZeroMantissa type: #'AbstractInstruction *'>
  	self flag: 'if we combine the exponent range test with the conversion to tagged representation we test for a zero exponent only once. further, if we extract tags once into a scratch on the input side we test for immediates, SmallInteger and SmallFloat using the same intermediate result.  so to do is to move fp arithmetic into the object representations'.
- 	cogit MoveR: reg R: exponent.
  	true
  		ifTrue: [cogit
+ 				LogicalShiftLeftCq: 1 R: reg R: exponent; "drop sign"
- 				LogicalShiftLeftCq: 1 R: exponent; "drop sign"
  				LogicalShiftRightCq: objectMemory smallFloatMantissaBits + 1 R: exponent] "shift exponent down"
  		ifFalse: [cogit
+ 				LogicalShiftRightCq: objectMemory smallFloatMantissaBits R: reg R: exponent;
- 				LogicalShiftRightCq: objectMemory smallFloatMantissaBits R: exponent;
  				AndCq: 16r7FF R: exponent].  "ieee double precision mantissa is 11 bits"
  	cogit CmpCq: objectMemory smallFloatExponentOffset R: exponent.
  	jumpMinExponent := cogit JumpLessOrEqual: 0.
  	cogit CmpCq: 255 + objectMemory smallFloatExponentOffset R: exponent. "SmallFloat exponent is 8 bits"
  	jumpMaxExponent := cogit JumpLessOrEqual: 0.
  	jumpFail :=
  	cogit Jump: 0.
  	jumpMinExponent jmpTarget:
  	(cogit TstCq: 1 << objectMemory smallFloatMantissaBits - 1 R: reg). "test mantissa bits"
  	jumpZeroMantissa := cogit JumpZero: 0.
  	cogit CmpCq: objectMemory smallFloatExponentOffset R: exponent.
  	jumpTest :=
  	cogit Jump: 0.
  	jumpZeroMantissa jmpTarget:
  	(cogit CmpCq: 0 R: exponent).
  	jumpTest jmpTarget:
  	(cogit JumpNonZero: jumpFail).
  	jumpMaxExponent jmpTarget: cogit Label.
  	^jumpFail!

Item was changed:
  ----- Method: CogObjectRepresentationFor64BitSpur>>genJumpNotSmallIntegerValue:scratch: (in category 'compile abstract instructions') -----
  genJumpNotSmallIntegerValue: aRegister scratch: scratchReg
  	"Generate a test for aRegister containing an integer value outside the SmallInteger range, and a jump if so, answering the jump.
  	 c.f. Spur64BitMemoryManager>>isIntegerValue:"
  	<returnTypeC: #'AbstractInstruction *'>
  	^cogit
+ 		ArithmeticShiftRightCq: 63 - objectMemory numTagBits R: aRegister R: scratchReg;
- 		MoveR: aRegister R: scratchReg;
- 		ArithmeticShiftRightCq: 63 - objectMemory numTagBits R: scratchReg;
  		AddCq: 1 R: scratchReg;
  		AndCq: 1 << (objectMemory numTagBits + 1) - 1 R: scratchReg; "sign and top numTags bits must be the same"
  		CmpCq: 1 R: scratchReg;
  		JumpGreater: 0!

Item was changed:
  ----- Method: CogObjectRepresentationForSqueakV3>>genJumpIsSmallIntegerValue:scratch: (in category 'compile abstract instructions') -----
  genJumpIsSmallIntegerValue: aRegister scratch: scratchReg
  	"Generate a test for aRegister containing an integer value in the SmallInteger range, and a jump if so, answering the jump.
  	 c.f. ObjectMemory>>isIntegerValue:"
  	<returnTypeC: #'AbstractInstruction *'>
  	^cogit
+ 		LogicalShiftLeftCq: 1 R: aRegister R: scratchReg;
- 		MoveR: aRegister R: scratchReg;
- 		LogicalShiftLeftCq: 1 R: scratchReg;
  		XorR: aRegister R: scratchReg;
  		JumpGreaterOrEqual: 0!

Item was changed:
  ----- Method: CogObjectRepresentationForSqueakV3>>genJumpNotSmallIntegerValue:scratch: (in category 'compile abstract instructions') -----
  genJumpNotSmallIntegerValue: aRegister scratch: scratchReg
  	"Generate a test for aRegister containing an integer value outside the SmallInteger range, and a jump if so, answering the jump.
  	 c.f. ObjectMemory>>isIntegerValue:"
  	<returnTypeC: #'AbstractInstruction *'>
  	^cogit
+ 		ArithmeticShiftRightCq: 1 R: aRegister R: scratchReg;
- 		MoveR: aRegister R: scratchReg;
- 		ArithmeticShiftRightCq: 1 R: scratchReg;
  		XorR: aRegister R: scratchReg;
  		JumpLess: 0!

Item was changed:
  SharedPool subclass: #CogRTLOpcodes
  	instanceVariableNames: ''
+ 	classVariableNames: 'AddCqR AddCwR AddRR AddRRR AddRdRd AddRsRs AddcCqR AddcRR AlignmentNops AndCqR AndCqRR AndCwR AndRR ArithmeticShiftRightCqR ArithmeticShiftRightCqRR ArithmeticShiftRightRR Call CallFull CallR ClzRR CmpC32R CmpCqR CmpCwR CmpRR CmpRdRd CmpRsRs ConvertRRd ConvertRRs ConvertRdR ConvertRdRs ConvertRsR ConvertRsRd DivRdRd DivRsRs Fill32 FirstJump FirstShortJump Jump JumpAbove JumpAboveOrEqual JumpBelow JumpBelowOrEqual JumpCarry JumpFPEqual JumpFPGreater JumpFPGreaterOrEqual JumpFPLess JumpFPLessOrEqual JumpFPNotEqual JumpFPOrdered JumpFPUnordered JumpFull JumpGreater JumpGreaterOrEqual JumpLess JumpLessOrEqual JumpLong JumpLongNonZero JumpLongZero JumpNegative JumpNoCarry JumpNoOverflow JumpNonNegative JumpNonZero JumpOverflow JumpR JumpZero Label LastJump LastRTLCode Literal LoadEffectiveAddressMwrR LogicalShiftLeftCqR LogicalShiftLeftCqRR LogicalShiftLeftRR LogicalShiftRightCqR LogicalShiftRightCqRR LogicalShiftRightRR MoveA32R MoveAbR MoveAwR MoveC32R MoveCqR Mo
 veCwR MoveM16rR MoveM32rR MoveM32rRs MoveM64rRd MoveM8rR MoveMbrR MoveMs8rR MoveMwrR MoveRA32 MoveRAb MoveRAw MoveRM16r MoveRM32r MoveRM8r MoveRMbr MoveRMwr MoveRR MoveRRd MoveRX16rR MoveRX32rR MoveRXbrR MoveRXwrR MoveRdM64r MoveRdR MoveRdRd MoveRsM32r MoveRsRs MoveX16rRR MoveX32rRR MoveXbrRR MoveXwrRR MulRdRd MulRsRs NegateR Nop NotR OrCqR OrCwR OrRR PopR PrefetchAw PushCq PushCw PushR RetN RotateLeftCqR RotateRightCqR SignExtend16RR SignExtend32RR SignExtend8RR SqrtRd SqrtRs Stop SubCqR SubCwR SubRR SubRRR SubRdRd SubRsRs SubbCqR SubbRR TstCqR XorCqR XorCwR XorRR XorRdRd XorRsRs ZeroExtend16RR ZeroExtend32RR ZeroExtend8RR'
- 	classVariableNames: 'AddCqR AddCwR AddRR AddRRR AddRdRd AddRsRs AddcCqR AddcRR AlignmentNops AndCqR AndCqRR AndCwR AndRR ArithmeticShiftRightCqR ArithmeticShiftRightRR Call CallFull CallR ClzRR CmpC32R CmpCqR CmpCwR CmpRR CmpRdRd CmpRsRs ConvertRRd ConvertRRs ConvertRdR ConvertRdRs ConvertRsR ConvertRsRd DivRdRd DivRsRs Fill32 FirstJump FirstShortJump Jump JumpAbove JumpAboveOrEqual JumpBelow JumpBelowOrEqual JumpCarry JumpFPEqual JumpFPGreater JumpFPGreaterOrEqual JumpFPLess JumpFPLessOrEqual JumpFPNotEqual JumpFPOrdered JumpFPUnordered JumpFull JumpGreater JumpGreaterOrEqual JumpLess JumpLessOrEqual JumpLong JumpLongNonZero JumpLongZero JumpNegative JumpNoCarry JumpNoOverflow JumpNonNegative JumpNonZero JumpOverflow JumpR JumpZero Label LastJump LastRTLCode Literal LoadEffectiveAddressMwrR LogicalShiftLeftCqR LogicalShiftLeftRR LogicalShiftRightCqR LogicalShiftRightCqRR LogicalShiftRightRR MoveA32R MoveAbR MoveAwR MoveC32R MoveCqR MoveCwR MoveM16rR MoveM32rR MoveM32rRs MoveM64rR
 d MoveM8rR MoveMbrR MoveMs8rR MoveMwrR MoveRA32 MoveRAb MoveRAw MoveRM16r MoveRM32r MoveRM8r MoveRMbr MoveRMwr MoveRR MoveRRd MoveRX16rR MoveRX32rR MoveRXbrR MoveRXwrR MoveRdM64r MoveRdR MoveRdRd MoveRsM32r MoveRsRs MoveX16rRR MoveX32rRR MoveXbrRR MoveXwrRR MulRdRd MulRsRs NegateR Nop NotR OrCqR OrCwR OrRR PopR PrefetchAw PushCq PushCw PushR RetN RotateLeftCqR RotateRightCqR SignExtend16RR SignExtend32RR SignExtend8RR SqrtRd SqrtRs Stop SubCqR SubCwR SubRR SubRRR SubRdRd SubRsRs SubbCqR SubbRR TstCqR XorCqR XorCwR XorRR XorRdRd XorRsRs ZeroExtend16RR ZeroExtend32RR ZeroExtend8RR'
  	poolDictionaries: ''
  	category: 'VMMaker-JIT'!
  
  !CogRTLOpcodes commentStamp: 'eem 12/26/2015 14:00' prior: 0!
  I am a pool for the Register-Transfer-Language to which Cog compiles.  I define unique integer values for all RTL opcodes.  See CogAbstractInstruction for instances of instructions with the opcodes that I define.!

Item was changed:
  ----- Method: CogRTLOpcodes class>>initialize (in category 'class initialization') -----
(excessive size, no diff calculated)

Item was added:
+ ----- Method: Cogit>>ArithmeticShiftRightCq:R:R: (in category 'abstract instructions') -----
+ ArithmeticShiftRightCq: quickConstant R: srcReg R: destReg
+ 	"destReg := (signed)srcReg >> quickConstant"
+ 	<inline: false>
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	| first |
+ 	<var: 'first' type: #'AbstractInstruction *'>
+ 	backEnd hasThreeAddressArithmetic ifTrue:
+ 		[^self gen: ArithmeticShiftRightCqRR operand: quickConstant operand: srcReg operand: destReg].
+ 	first := self gen: MoveRR operand: srcReg operand: destReg.
+ 	self gen: ArithmeticShiftRightCqR operand: quickConstant operand: destReg.
+ 	^first!

Item was added:
+ ----- Method: Cogit>>LogicalShiftLeftCq:R:R: (in category 'abstract instructions') -----
+ LogicalShiftLeftCq: quickConstant R: srcReg R: destReg
+ 	"destReg := srcReg << quickConstant"
+ 	<inline: false>
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	| first |
+ 	<var: 'first' type: #'AbstractInstruction *'>
+ 	backEnd hasThreeAddressArithmetic ifTrue:
+ 		[^self gen: LogicalShiftLeftCqRR operand: quickConstant operand: srcReg operand: destReg].
+ 	first := self gen: MoveRR operand: srcReg operand: destReg.
+ 	self gen: LogicalShiftLeftCqR operand: quickConstant operand: destReg.
+ 	^first!



More information about the Vm-dev mailing list