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

commits at source.squeak.org commits at source.squeak.org
Tue Jan 21 18:52:57 UTC 2020


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

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

Name: VMMaker.oscog-eem.2667
Author: eem
Time: 21 January 2020, 10:52:42.552802 am
UUID: 96dd9366-74d2-4af1-ad6c-4881e4d2489c
Ancestors: VMMaker.oscog-eem.2666

Cogit: Add AddCqRR (useful for ARMv8 cache flushing).

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

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]].
+ 		[AddCqRR]				-> [^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>>concretizeAndCqRR (in category 'generate machine code - concretize') -----
  concretizeAndCqRR
  	"Will get inlined into concretizeAt: switch."
  	"AND is very important since it's used to mask all sorts of flags in the jit. We take special care to try to find compact ways to make the masks"
  	<inline: true>
  	| val srcReg dstReg |
  	val := operands at: 0.
  	srcReg := operands at: 1.
  	dstReg := operands at: 2.
+ 	self rotateable8bitBitwiseImmediate: val
- 	^self rotateable8bitBitwiseImmediate: val
  		ifTrue:
  			[:rot :immediate :invert|
  			self machineCodeAt: 0 put: (invert
  											ifTrue: [self bics: dstReg rn: srcReg imm: immediate ror: rot]
  											ifFalse: [self ands: dstReg rn: srcReg imm: immediate ror: rot]).
+ 			^4]
- 			4]
  		ifFalse:
  			[| hb |
  			hb := (operands at: 0) highBit.
  			"First see if the constant can be made from a simple shift of 0xFFFFFFFF"
  			1 << hb = (val +1) ifTrue: "MVN temp reg, 0, making 0xffffffff"
  				[self machineCodeAt: 0 put:(self mvn: ConcreteIPReg imm: 0 ror: 0).
  				"Then AND reg, temp reg, lsr #(32-hb)"
  				 self machineCodeAt: 4 put: (self dataOpType: AndOpcode rd: dstReg rn: srcReg rm: ConcreteIPReg lsr: 32 - hb).
  				^8].
+ 			^self concretizeDataOperationCwR: AndOpcode R: dstReg]!
- 			self concretizeDataOperationCwR: AndOpcode]!

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

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

Item was changed:
  ----- Method: CogARMCompiler>>concretizeNegateableDataOperationCqR: (in category 'generate machine code - concretize') -----
  concretizeNegateableDataOperationCqR: armOpcode
  	"Will get inlined into concretizeAt: switch."
  	"4 == Add, 2 == Sub, 10 = Cmp"
  	<inline: true>
  	| val rd rn |
  	val := operands at: 0.
  	rn := operands at: 1.
  	"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."
  	rd := opcode = CmpOpcode ifTrue: [0] ifFalse: [rn].
  
  	self rotateable8bitSignedImmediate: val 
  		ifTrue:
  			[:rot :immediate : negate|
  			self machineCodeAt: 0
  				put: (self
  						type: 1
  						op: (negate ifTrue: [self inverseOpcodeFor: armOpcode] ifFalse: [armOpcode])
  						set: 1
  						rn: rn
  						rd: rd
  						shifterOperand: (rot >> 1"in this usage we have to halve the rot value" << 8 bitOr: immediate)).
  			^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).
  					^8]].
+ 			 ^self concretizeDataOperationCwR: armOpcode R: rd].
- 			 ^self concretizeDataOperationCwR: armOpcode].
  	^0 "to keep Slang happy"!

Item was added:
+ ----- Method: CogARMCompiler>>concretizeNegateableDataOperationCqR:R: (in category 'generate machine code - concretize') -----
+ concretizeNegateableDataOperationCqR: armOpcode R: rd
+ 	"Will get inlined into concretizeAt: switch."
+ 	"4 == Add, 2 == Sub, 10 = Cmp"
+ 	<inline: true>
+ 	| val rn |
+ 	val := operands at: 0.
+ 	rn := operands at: 1.
+ 	"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 rotateable8bitSignedImmediate: val 
+ 		ifTrue:
+ 			[:rot :immediate : negate|
+ 			self machineCodeAt: 0
+ 				put: (self
+ 						type: 1
+ 						op: (negate ifTrue: [self inverseOpcodeFor: armOpcode] ifFalse: [armOpcode])
+ 						set: 1
+ 						rn: rn
+ 						rd: rd
+ 						shifterOperand: (rot >> 1"in this usage we have to halve the rot value" << 8 bitOr: immediate)).
+ 			^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).
+ 					^8]].
+ 			 ^self concretizeDataOperationCwR: armOpcode R: rd].
+ 	^0 "to keep Slang happy"!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeSubCqR (in category 'generate machine code - concretize') -----
  concretizeSubCqR
  	"Will get inlined into concretizeAt: switch."
  	"Try whether the quick constant is a small negative number. If it is, optimize."
  	<var: #word type: #sqInt>
  	<inline: true>
+ 	| word reg |
- 	| word |
  	word := operands at: 0.
+ 	reg := operands at: 1.
  	self rotateable8bitImmediate: word
+ 		ifTrue: [ :rot :immediate |
- 		ifTrue: [ :rot :immediate | | reg |
- 			reg := operands at: 1.
  			self machineCodeAt: 0 put: (self subs: reg rn: reg imm: immediate ror: rot).
  			^4]
  		ifFalse: [].
  	"before building a full load of a big constant, see if we can do an add of the constant negated"
+ 	self rotateable8bitImmediate: word negated
+ 		ifTrue: [ :rot :immediate |
- 	^self rotateable8bitImmediate: word negated
- 		ifTrue: [ :rot :immediate | | reg |
- 			reg := operands at: 1.
  			self machineCodeAt: 0 put: (self adds: reg rn: reg imm: immediate ror: rot).
+ 			^4]
+ 		ifFalse: [].
+ 	^self concretizeDataOperationCwR: SubOpcode R: reg!
- 			4]
- 		ifFalse: [self concretizeDataOperationCwR: SubOpcode]!

Item was changed:
  ----- Method: CogARMCompiler>>concretizeTstCqR (in category 'generate machine code - concretize') -----
  concretizeTstCqR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
+ 	| reg |
+ 	reg := operands at: 1.
+ 	self rotateable8bitImmediate: (operands at: 0)
+ 		ifTrue: [ :rot :immediate |
- 	^self rotateable8bitImmediate: (operands at: 0)
- 		ifTrue: [ :rot :immediate | | reg |
- 			reg := operands at: 1.
  			self machineCodeAt: 0 put: (self tst: reg rn: reg imm: immediate ror: rot).
+ 			^4]
+ 		ifFalse: [].
+ 	^self concretizeDataOperationCwR: TstOpcode R: reg!
- 			4]
- 		ifFalse: [self concretizeDataOperationCwR: TstOpcode]!

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 R: (operands at: 1)].
+ 		[AddCqRR]					-> [^self concretizeNegateableDataOperationCqR: AddOpcode R: (operands at: 2)].
- 		[AddCqR]					-> [^self concretizeNegateableDataOperationCqR: AddOpcode].
  		[AndCqR]					-> [^self concretizeInvertibleDataOperationCqR: AndOpcode].
  		[AndCqRR]					-> [^self concretizeAndCqRR].
+ 		[CmpCqR]					-> [^self concretizeNegateableDataOperationCqR: CmpOpcode R: 0].
- 		[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].
  		[LogicalShiftLeftCqR]			-> [^self concretizeLogicalShiftLeftCqR].
  		[ArithmeticShiftRightCqRR]		-> [^self concretizeArithmeticShiftRightCqRR].
  		[LogicalShiftRightCqRR]		-> [^self concretizeLogicalShiftRightCqRR].
  		[LogicalShiftLeftCqRR]			-> [^self concretizeLogicalShiftLeftCqRR].
  		[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:
  SharedPool subclass: #CogRTLOpcodes
  	instanceVariableNames: ''
+ 	classVariableNames: 'AddCqR AddCqRR 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 Mo
 veCqR MoveCwR 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 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'
  	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>>AddCq:R:R: (in category 'abstract instructions') -----
+ AddCq: quickConstant R: srcReg R: destReg
+ 	<inline: false>
+ 	<returnTypeC: #'AbstractInstruction *'>
+ 	| first |
+ 	backEnd hasThreeAddressArithmetic ifTrue:
+ 		[^self gen: AddCqRR quickConstant: quickConstant operand: srcReg operand: destReg].
+ 	srcReg = destReg ifTrue:
+ 		[^self gen: AddCqR quickConstant: quickConstant operand: destReg].
+ 	first := self gen: MoveRR operand: srcReg operand: destReg.
+ 	self gen: AddCqR quickConstant: quickConstant operand: destReg.
+ 	^first!



More information about the Vm-dev mailing list