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

commits at source.squeak.org commits at source.squeak.org
Mon Sep 28 00:36:53 UTC 2015


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

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

Name: VMMaker.oscog-eem.1472
Author: eem
Time: 27 September 2015, 5:34:37.934 pm
UUID: 1a6bf281-67c0-4ce6-90c4-438537babf5f
Ancestors: VMMaker.oscog-eem.1471

Cogit:
More x64 support.  Refactor most of the Arith CqR concretizers into one routine.

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

Item was changed:
  ----- Method: CogX64Compiler>>computeMaximumSize (in category 'generate machine code') -----
  computeMaximumSize
  	"Compute the maximum size for each opcode.  This allows jump offsets to
  	 be determined, provided that all backward branches are long branches."
  	"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].
  		[AlignmentNops]		-> [^(operands at: 0) - 1].
  		[Fill16]					-> [^2].
  		[Fill32]					-> [^4].
  		[FillFromWord]			-> [^4].
  		[Nop]					-> [^1].
  		"Specific Control/Data Movement"
  		[CDQ]					-> [^2].
  		[IDIVR]					-> [^3].
  		[IMULRR]				-> [^4].
  		[CPUID]					-> [^2].
  		[CMPXCHGAwR]			-> [^8].
  		[CMPXCHGMwrR]		-> [^9].
  		[LFENCE]				-> [^3].
  		[MFENCE]				-> [^3].
  		[SFENCE]				-> [^3].
  		[LOCK]					-> [^1].
  		"[XCHGAwR]				-> [^6].
  		[XCHGMwrR]			-> [^7]."
  		[XCHGRR]				-> [^((self concreteRegister: (operands at: 0)) = RAX
  									   or: [(self concreteRegister: (operands at: 1)) = RAX])
  											ifTrue: [2]
  											ifFalse: [3]].
  		"Control"
  		[CallFull]					-> [^12].
  		[Call]						-> [^5].
  		[JumpR]						-> [^2].
  		[JumpFull]					-> [self resolveJumpTarget. ^12].
  		[JumpLong]					-> [self resolveJumpTarget. ^5].
  		[Jump]						-> [self resolveJumpTarget. ^5].
  		[JumpZero]					-> [self resolveJumpTarget. ^6].
  		[JumpNonZero]				-> [self resolveJumpTarget. ^6].
  		[JumpNegative]				-> [self resolveJumpTarget. ^6].
  		[JumpNonNegative]			-> [self resolveJumpTarget. ^6].
  		[JumpOverflow]				-> [self resolveJumpTarget. ^6].
  		[JumpNoOverflow]			-> [self resolveJumpTarget. ^6].
  		[JumpCarry]				-> [self resolveJumpTarget. ^6].
  		[JumpNoCarry]				-> [self resolveJumpTarget. ^6].
  		[JumpLess]					-> [self resolveJumpTarget. ^6].
  		[JumpGreaterOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpGreater]				-> [self resolveJumpTarget. ^6].
  		[JumpLessOrEqual]			-> [self resolveJumpTarget. ^6].
  		[JumpBelow]				-> [self resolveJumpTarget. ^6].
  		[JumpAboveOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpAbove]				-> [self resolveJumpTarget. ^6].
  		[JumpBelowOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpLongZero]			-> [self resolveJumpTarget. ^6].
  		[JumpLongNonZero]		-> [self resolveJumpTarget. ^6].
  		[JumpFPEqual]				-> [self resolveJumpTarget. ^6].
  		[JumpFPNotEqual]			-> [self resolveJumpTarget. ^6].
  		[JumpFPLess]				-> [self resolveJumpTarget. ^6].
  		[JumpFPGreaterOrEqual]	-> [self resolveJumpTarget. ^6].
  		[JumpFPGreater]			-> [self resolveJumpTarget. ^6].
  		[JumpFPLessOrEqual]		-> [self resolveJumpTarget. ^6].
  		[JumpFPOrdered]			-> [self resolveJumpTarget. ^6].
  		[JumpFPUnordered]			-> [self resolveJumpTarget. ^6].
  		[RetN]						-> [^(operands at: 0) = 0 ifTrue: [1] ifFalse: [3]].
  		[Stop]						-> [^1].
  
  		"Arithmetic"
  		[AddCqR]		-> [^self computeSizeOfArithCqR].
  		[AndCqR]		-> [^self computeSizeOfArithCqR].
  		[CmpCqR]		-> [^self computeSizeOfArithCqR].
  		[OrCqR]			-> [^self computeSizeOfArithCqR].
  		[SubCqR]		-> [^self computeSizeOfArithCqR].
  		[TstCqR]		-> [^self computeSizeOfArithCqR].
  		[AddCwR]		-> [^self computeSizeOfArithCwR].
  		[AndCwR]		-> [^self computeSizeOfArithCwR].
  		[CmpCwR]		-> [^self computeSizeOfArithCwR].
  		[OrCwR]		-> [^self computeSizeOfArithCwR].
  		[SubCwR]		-> [^self computeSizeOfArithCwR].
  		[XorCwR]		-> [^self computeSizeOfArithCwR].
  		[AddRR]			-> [^3].
  		[AndRR]			-> [^3].
  		[CmpRR]		-> [^3].
  		[OrRR]			-> [^3].
  		[XorRR]			-> [^3].
  		[SubRR]			-> [^3].
  		[NegateR]		-> [^3].
  		"[LoadEffectiveAddressMwrR]
  						-> [^((self isQuick: (operands at: 0))
  											ifTrue: [3]
  											ifFalse: [6])
  										+ ((self concreteRegister: (operands at: 1)) = ESP
  											ifTrue: [1]
+ 											ifFalse: [0])]."
+ 		[LogicalShiftLeftCqR]		-> [^(operands at: 0) = 1 ifTrue: [3] ifFalse: [4]].
+ 		[LogicalShiftRightCqR]		-> [^(operands at: 0) = 1 ifTrue: [3] ifFalse: [4]].
+ 		[ArithmeticShiftRightCqR]	-> [^(operands at: 0) = 1 ifTrue: [3] ifFalse: [4]].
- 											ifFalse: [0])].
- 		[LogicalShiftLeftCqR]		-> [^(operands at: 0) = 1 ifTrue: [2] ifFalse: [3]].
- 		[LogicalShiftRightCqR]		-> [^(operands at: 0) = 1 ifTrue: [2] ifFalse: [3]].
- 		[ArithmeticShiftRightCqR]	-> [^(operands at: 0) = 1 ifTrue: [2] ifFalse: [3]]."
  		[LogicalShiftLeftRR]			-> [^self computeShiftRRSize].
  		[LogicalShiftRightRR]		-> [^self computeShiftRRSize].
  		[ArithmeticShiftRightRR]		-> [^self computeShiftRRSize].
  		[AddRdRd]					-> [^4].
  		[CmpRdRd]					-> [^4].
  		[SubRdRd]					-> [^4].
  		[MulRdRd]					-> [^4].
  		[DivRdRd]					-> [^4].
  		[SqrtRd]					-> [^4].
  		"Data Movement"
  		[MoveCqR]		-> [^(operands at: 0) = 0 ifTrue: [3] ifFalse: [(self is32BitSignedImmediate: (operands at: 0)) ifTrue: [7] ifFalse: [10]]].
  		[MoveCwR]		-> [^10].
  		[MoveRR]		-> [^3].
  		[MoveRdRd]		-> [^4].
  		[MoveAwR]		-> [^(self isAddressRelativeToVarBase: (operands at: 0))
  								ifTrue: [7]
  								ifFalse: [(self concreteRegister: (operands at: 1)) = RAX ifTrue: [10] ifFalse: [14]]].
  		[MoveRAw]		-> [^(self isAddressRelativeToVarBase: (operands at: 1))
  								ifTrue: [7]
  								ifFalse: [(self concreteRegister: (operands at: 0)) = RAX ifTrue: [10] ifFalse: [14]]].
  		[MoveRMwr]	-> [^((self isQuick: (operands at: 1))
  									ifTrue: [((operands at: 1) = 0
  											and: [((self concreteRegister: (operands at: 2)) bitAnd: 7) ~= RBP])
  												ifTrue: [3]
  												ifFalse: [4]]
  									ifFalse: [7])
  								+ (((self concreteRegister: (operands at: 2)) bitAnd: 7) = RSP
  									ifTrue: [1]
  									ifFalse: [0])].
  		"[MoveRdM64r]	-> [^((self isQuick: (operands at: 1))
  											ifTrue: [5]
  											ifFalse: [8])
  										+ ((self concreteRegister: (operands at: 2)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])]."
  		[MoveMbrR]		-> [^((self isQuick: (operands at: 0))
  											ifTrue: [5]
  											ifFalse: [8])
+ 										+ (((self concreteRegister: (operands at: 1)) = RSP
+ 											or: [(self concreteRegister: (operands at: 1)) = R12])
- 										+ ((self concreteRegister: (operands at: 1)) = RSP
  											ifTrue: [1]
  											ifFalse: [0])].
+ 		[MoveRMbr]		-> [^((self concreteRegister: (operands at: 2)) = RSP
+ 							  or: [(self concreteRegister: (operands at: 2)) = R12])
- 		[MoveRMbr]		-> [^(self concreteRegister: (operands at: 2)) = RSP
  								ifTrue: [8]
  								ifFalse: [(self isQuick: (operands at: 1)) ifTrue: [4] ifFalse: [7]]].
  		"[MoveM16rR]	-> [^((self isQuick: (operands at: 0))
  											ifTrue: [4]
  											ifFalse: [7])
  										+ ((self concreteRegister: (operands at: 1)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
  		[MoveM64rRd]	-> [^((self isQuick: (operands at: 0))
  											ifTrue: [5]
  											ifFalse: [8])
  										+ ((self concreteRegister: (operands at: 1)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])]."
  		[MoveMwrR]		-> [^((self isQuick: (operands at: 0))
  									ifTrue: [((operands at: 0) = 0
  											and: [((self concreteRegister: (operands at: 1)) bitAnd: 7) ~= RBP])
  												ifTrue: [3]
  												ifFalse: [4]]
  									ifFalse: [7])
  								+ (((self concreteRegister: (operands at: 1)) bitAnd: 7) = RSP
  									ifTrue: [1]
  									ifFalse: [0])].
  		"[MoveXbrRR]	-> [self assert: (self concreteRegister: (operands at: 0)) ~= ESP.
  							^(self concreteRegister: (operands at: 1)) = EBP
  											ifTrue: [5]
  											ifFalse: [4]].
  		[MoveRXbrR]	->	[self assert: (self concreteRegister: (operands at: 1)) ~= ESP.
  							^((self concreteRegister: (operands at: 2)) = EBP
  											ifTrue: [4]
  											ifFalse: [3])
  										+ ((self concreteRegister: (operands at: 0)) >= 4
  											ifTrue: [2]
+ 											ifFalse: [0])]."
+ 		[MoveXwrRR]	-> [self assert: (self concreteRegister: (operands at: 0)) ~= RSP.
+ 							^((self concreteRegister: (operands at: 1)) = RBP
+ 							   or: [(self concreteRegister: (operands at: 1)) = R13])
+ 											ifTrue: [5]
+ 											ifFalse: [4]].
+ 		[MoveRXwrR]	-> [self assert: (self concreteRegister: (operands at: 1)) ~= RSP.
+ 							^((self concreteRegister: (operands at: 2)) = RBP
+ 							   or: [(self concreteRegister: (operands at: 2)) = R13])
+ 											ifTrue: [5]
+ 											ifFalse: [4]].
- 											ifFalse: [0])].
- 		[MoveXwrRR]	-> [self assert: (self concreteRegister: (operands at: 0)) ~= ESP.
- 							^(self concreteRegister: (operands at: 1)) = EBP
- 											ifTrue: [4]
- 											ifFalse: [3]].
- 		[MoveRXwrR]	-> [self assert: (self concreteRegister: (operands at: 1)) ~= ESP.
- 							^(self concreteRegister: (operands at: 2)) = EBP
- 											ifTrue: [4]
- 											ifFalse: [3]]."
  		[PopR]			-> [^(self concreteRegister: (operands at: 0)) < 8 ifTrue: [1] ifFalse: [2]].
  		[PushR]			-> [^(self concreteRegister: (operands at: 0)) < 8 ifTrue: [1] ifFalse: [2]].
  		[PushCq]		-> [^(self isQuick: (operands at: 0)) ifTrue: [2] ifFalse: [5]].
  		[PushCw]		-> [^self computeSizeOfArithCwR - 1].
  		[PrefetchAw]	-> [^self hasSSEInstructions ifTrue: [12] ifFalse: [0]].
  		"Conversion"
  		"[ConvertRRd]	-> [^4]" }.
  	^0 "to keep C compiler quiet"!

Item was removed:
- ----- Method: CogX64Compiler>>concretizeAddCqR (in category 'generate machine code') -----
- concretizeAddCqR
- 	"Will get inlined into concretizeAt: switch."
- 	<inline: true>
- 	| mask reg |
- 	mask := operands at: 0.
- 	reg := self concreteRegister: (operands at: 1).
- 	machineCode
- 		at: 0 put: (self rexR: 0 x: 0 b: reg).
- 	(self isQuick: mask) ifTrue:
- 		[machineCode
- 			at: 1 put: 16r83;
- 			at: 2 put: (self mod: ModReg RM: reg RO: 0);
- 			at: 3 put: (mask bitAnd: 16rFF).
- 		 ^machineCodeSize := 4].
- 	self assert: mask >> 32 = 0.
- 	reg = RAX ifTrue:
- 		[machineCode
- 			at: 1 put: 16r05;
- 			at: 2 put: (mask bitAnd: 16rFF);
- 			at: 3 put: (mask >> 8 bitAnd: 16rFF);
- 			at: 4 put: (mask >> 16 bitAnd: 16rFF);
- 			at: 5 put: (mask >> 24 bitAnd: 16rFF).
- 		 ^machineCodeSize := 6].
- 	machineCode
- 		at: 1 put: 16r81;
- 		at: 2 put: (self mod: ModReg RM: reg RO: 0);
- 		at: 3 put: (mask bitAnd: 16rFF);
- 		at: 4 put: (mask >> 8 bitAnd: 16rFF);
- 		at: 5 put: (mask >> 16 bitAnd: 16rFF);
- 		at: 6 put: (mask >> 24 bitAnd: 16rFF).
- 	 ^machineCodeSize := 7!

Item was removed:
- ----- Method: CogX64Compiler>>concretizeAndCqR (in category 'generate machine code') -----
- concretizeAndCqR
- 	"Will get inlined into concretizeAt: switch."
- 	<inline: true>
- 	| mask reg |
- 	mask := operands at: 0.
- 	reg := self concreteRegister: (operands at: 1).
- 	machineCode
- 		at: 0 put: (self rexR: 0 x: 0 b: reg).
- 	(self isQuick: mask) ifTrue:
- 		[machineCode
- 			at: 1 put: 16r83;
- 			at: 2 put: (self mod: ModReg RM: reg RO: 4);
- 			at: 3 put: (mask bitAnd: 16rFF).
- 		 ^machineCodeSize := 4].
- 	self assert: mask >> 32 = 0.
- 	reg = RAX ifTrue:
- 		[machineCode
- 			at: 1 put: 16r25;
- 			at: 2 put: (mask bitAnd: 16rFF);
- 			at: 3 put: (mask >> 8 bitAnd: 16rFF);
- 			at: 4 put: (mask >> 16 bitAnd: 16rFF);
- 			at: 5 put: (mask >> 24 bitAnd: 16rFF).
- 		 ^machineCodeSize := 6].
- 	machineCode
- 		at: 1 put: 16r81;
- 		at: 2 put: (self mod: ModReg RM: reg RO: 4);
- 		at: 3 put: (mask bitAnd: 16rFF);
- 		at: 4 put: (mask >> 8 bitAnd: 16rFF);
- 		at: 5 put: (mask >> 16 bitAnd: 16rFF);
- 		at: 6 put: (mask >> 24 bitAnd: 16rFF).
- 	 ^machineCodeSize := 7!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeArithCqRWithRO:raxOpcode: (in category 'generate machine code') -----
+ concretizeArithCqRWithRO: regOpcode raxOpcode: raxOpcode
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: false>
+ 	| value reg |
+ 	value := operands at: 0.
+ 	reg := self concreteRegister: (operands at: 1).
+ 	machineCode
+ 		at: 0 put: (self rexR: 0 x: 0 b: reg).
+ 	(self isQuick: value) ifTrue:
+ 		[machineCode
+ 			at: 1 put: 16r83;
+ 			at: 2 put: (self mod: ModReg RM: reg RO: regOpcode);
+ 			at: 3 put: (value bitAnd: 16rFF).
+ 		 ^machineCodeSize := 4].
+ 	self assert: value >> 32 = 0.
+ 	reg = RAX ifTrue:
+ 		[machineCode
+ 			at: 1 put: raxOpcode;
+ 			at: 2 put: (value bitAnd: 16rFF);
+ 			at: 3 put: (value >> 8 bitAnd: 16rFF);
+ 			at: 4 put: (value >> 16 bitAnd: 16rFF);
+ 			at: 5 put: (value >> 24 bitAnd: 16rFF).
+ 		 ^machineCodeSize := 6].
+ 	machineCode
+ 		at: 1 put: 16r81;
+ 		at: 2 put: (self mod: ModReg RM: reg RO: regOpcode);
+ 		at: 3 put: (value bitAnd: 16rFF);
+ 		at: 4 put: (value >> 8 bitAnd: 16rFF);
+ 		at: 5 put: (value >> 16 bitAnd: 16rFF);
+ 		at: 6 put: (value >> 24 bitAnd: 16rFF).
+ 	 ^machineCodeSize := 7!

Item was removed:
- ----- Method: CogX64Compiler>>concretizeArithmeticShiftRightRR (in category 'generate machine code') -----
- concretizeArithmeticShiftRightRR
- 	"On the x64 the only instructions that shift by the value of a
- 	 register require the shift count to be  in %ecx.  So we may
- 	 have to use swap instructions to get the count into %ecx."
- 	<inline: true>
- 	| shiftCountReg destReg regToShift |
- 	shiftCountReg := self concreteRegister: (operands at: 0).
- 	destReg := self concreteRegister: (operands at: 1).
- 	shiftCountReg = RCX ifTrue:
- 		[machineCode
- 			at: 0 put: (self rexR: 0 x: 0 b: destReg);
- 			at: 1 put: 16rD3;
- 			at: 2 put: (self mod: ModReg RM: destReg RO: 7).
- 		 ^machineCodeSize := 3].
- 	regToShift := destReg = shiftCountReg
- 					ifTrue: [RCX]
- 					ifFalse: [destReg = RCX
- 								ifTrue: [shiftCountReg]
- 								ifFalse: [destReg]].
- 	shiftCountReg = RAX ifTrue:
- 		[machineCode
- 			at: 0 put: 16r48;
- 			at: 1 put: 16r90 + RCX; "XCHG RAX,RCX"
- 			at: 2 put: (self rexR: 0 x: 0 b: regToShift);
- 			at: 3 put: 16rD3;			"SAR RCX,RAX"
- 			at: 4 put: (self mod: ModReg RM: regToShift RO: 7);
- 			at: 5 put: 16r48;
- 			at: 6 put: 16r90 + RCX. "XCHG RAX,RCX"
- 		 ^machineCodeSize := 7].
- 	machineCode
- 		at: 0 put: (self rexR: shiftCountReg x: 0 b: RCX);		"XCHG R?X,RCX"
- 		at: 1 put: 16r87;
- 		at: 2 put: (self mod: ModReg RM: RCX RO: shiftCountReg);
- 		at: 3 put: (self rexR: 0 x: 0 b: regToShift);			"SAR RCX,R!!X"
- 		at: 4 put: 16rD3;
- 		at: 5 put: (self mod: ModReg RM: regToShift RO: 7);
- 		at: 6 put: (self rexR: shiftCountReg x: 0 b: RCX);		"XCHG R?X,RCX"
- 		at: 7 put: 16r87;
- 		at: 8 put: (self mod: ModReg RM: RCX RO: shiftCountReg).
- 	^machineCodeSize := 9!

Item was removed:
- ----- Method: CogX64Compiler>>concretizeCmpCqR (in category 'generate machine code') -----
- concretizeCmpCqR
- 	"Will get inlined into concretizeAt: switch."
- 	<inline: true>
- 	| value reg |
- 	value := operands at: 0.
- 	reg := self concreteRegister: (operands at: 1).
- 	machineCode
- 		at: 0 put: (self rexR: 0 x: 0 b: reg).
- 	(self isQuick: value) ifTrue:
- 		[machineCode
- 			at: 1 put: 16r83;
- 			at: 2 put: (self mod: ModReg RM: reg RO: 7);
- 			at: 3 put: (value bitAnd: 16rFF).
- 		 ^machineCodeSize := 4].
- 	self assert: value >> 32 = 0.
- 	reg = RAX ifTrue:
- 		[machineCode
- 			at: 1 put: 16r3D;
- 			at: 2 put: (value bitAnd: 16rFF);
- 			at: 3 put: (value >> 8 bitAnd: 16rFF);
- 			at: 4 put: (value >> 16 bitAnd: 16rFF);
- 			at: 5 put: (value >> 24 bitAnd: 16rFF).
- 		 ^machineCodeSize := 6].
- 	machineCode
- 		at: 1 put: 16r81;
- 		at: 2 put: (self mod: ModReg RM: reg RO: 7);
- 		at: 3 put: (value bitAnd: 16rFF);
- 		at: 4 put: (value >> 8 bitAnd: 16rFF);
- 		at: 5 put: (value >> 16 bitAnd: 16rFF);
- 		at: 6 put: (value >> 24 bitAnd: 16rFF).
- 	 ^machineCodeSize := 7!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeConditionalJumpLong: (in category 'generate machine code') -----
+ concretizeConditionalJumpLong: conditionCode
+ 	"Will get inlined into concretizeAt: switch."
+ 	"Sizing/generating jumps.
+ 		Jump targets can be to absolute addresses or other abstract instructions.
+ 		Generating initial trampolines instructions may have no maxSize and be to absolute addresses.
+ 		Otherwise instructions must have a machineCodeSize which must be kept to."
+ 	<inline: true>
+ 	| offset |
+ 	offset := self computeJumpTargetOffsetPlus: 6.
+ 	machineCode
+ 		at: 0 put: 16r0F;
+ 		at: 1 put: 16r80 + conditionCode;
+ 		at: 2 put: (offset bitAnd: 16rFF);
+ 		at: 3 put: (offset >> 8 bitAnd: 16rFF);
+ 		at: 4 put: (offset >> 16 bitAnd: 16rFF);
+ 		at: 5 put: (offset >> 24 bitAnd: 16rFF).
+ 	^machineCodeSize := 6!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveMbrR (in category 'generate machine code') -----
  concretizeMoveMbrR
  	"N.B. The Cogit compiler makes no assumption about the upper bits being set to zero.
  	 It will clear the register before hand if necessary."
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| srcReg offset destReg |
  	offset := operands at: 0.
  	srcReg := self concreteRegister: (operands at: 1).
  	destReg := self concreteRegister: (operands at: 2).
  	machineCode
  		at: 0 put: (self rexR: destReg x: 0 b: srcReg);
  		at: 1 put: 16r0f;
  		at: 2 put: 16rb6.
+ 	(srcReg ~= RSP and: [srcReg ~= R12]) ifTrue:
- 	srcReg ~= RSP ifTrue:
  		[(self isQuick: offset) ifTrue:
  			[machineCode
  				at: 3 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  				at: 4 put: (offset bitAnd: 16rFF).
  			 ^machineCodeSize := 5].
  		machineCode
  			at: 3 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  			at: 4 put: (offset bitAnd: 16rFF);
  			at: 5 put: (offset >> 8 bitAnd: 16rFF);
  			at: 6 put: (offset >> 16 bitAnd: 16rFF);
  			at: 7 put: (offset >> 24 bitAnd: 16rFF).
  		^machineCodeSize := 8].
+ 	"RSP & R12:"
- 	"RSP:"
  	(self isQuick: offset) ifTrue:
  		[machineCode
  			at: 3 put: (self mod: ModRegRegDisp8 RM: srcReg RO: destReg);
  			at: 4 put: (self s: SIB1 i: 4 b: srcReg);
  			at: 5 put: (offset bitAnd: 16rFF).
  		 ^machineCodeSize := 6].
  	machineCode
  		at: 3 put: (self mod: ModRegRegDisp32 RM: srcReg RO: destReg);
  		at: 4 put: (self s: SIB1 i: 4 b: srcReg);
  		at: 5 put: (offset bitAnd: 16rFF);
  		at: 6 put: (offset >> 8 bitAnd: 16rFF);
  		at: 7 put: (offset >> 16 bitAnd: 16rFF);
  		at: 8 put: (offset >> 24 bitAnd: 16rFF).
  	^machineCodeSize := 9!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeMoveRXwrR (in category 'generate machine code') -----
+ concretizeMoveRXwrR
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| index base src |
+ 	src := self concreteRegister: (operands at: 0).
+ 	index := self concreteRegister: (operands at: 1).
+ 	base := self concreteRegister: (operands at: 2).
+ 	machineCode
+ 		at: 0 put: (self rexR: src x: index b: base).
+ 	(base ~= RBP and: [base ~= R13]) ifTrue:
+ 		[machineCode
+ 			at: 1 put: 16r89;
+ 			at: 2 put: (self mod: ModRegInd RM: 4 RO: src);
+ 			at: 3 put: (self s: SIB8 i: index b: base).
+ 		 ^machineCodeSize := 4].
+ 	machineCode
+ 		at: 1 put: 16r89;
+ 		at: 2 put: (self mod: ModRegRegDisp8 RM: 4 RO: src);
+ 		at: 3 put: (self s: SIB8 i: index b: base);
+ 		at: 4 put: 0.
+ 	 ^machineCodeSize := 5!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeMoveXwrRR (in category 'generate machine code') -----
+ concretizeMoveXwrRR
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| index base dest |
+ 	index := self concreteRegister: (operands at: 0).
+ 	base := self concreteRegister: (operands at: 1).
+ 	dest := self concreteRegister: (operands at: 2).
+ 	machineCode
+ 		at: 0 put: (self rexR: dest x: index b: base).
+ 	(base ~= RBP and: [base ~= R13]) ifTrue:
+ 		[machineCode
+ 			at: 1 put: 16r8B;
+ 			at: 2 put: (self mod: ModRegInd RM: 4 RO: dest);
+ 			at: 3 put: (self s: SIB8 i: index b: base).
+ 		 ^machineCodeSize := 4].
+ 	machineCode
+ 		at: 1 put: 16r8B;
+ 		at: 2 put: (self mod: ModRegRegDisp8 RM: 4 RO: dest);
+ 		at: 3 put: (self s: SIB8 i: index b: base);
+ 		at: 4 put: 0.
+ 	 ^machineCodeSize := 5!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeShiftCqRegOpcode: (in category 'generate machine code') -----
+ concretizeShiftCqRegOpcode: regOpcode
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| distance reg |
+ 	distance := (operands at: 0) min: 31.
+ 	reg := self concreteRegister: (operands at: 1).
+ 	machineCode
+ 		at: 0 put: (self rexR: 0 x: 0 b: reg).
+ 	distance = 1 ifTrue:
+ 		[machineCode
+ 			at: 1 put: 16rD1;
+ 			at: 2 put: (self mod: ModReg RM: reg RO: regOpcode).
+ 		 ^machineCodeSize := 3].
+ 	machineCode
+ 		at: 1 put: 16rC1;
+ 		at: 2 put: (self mod: ModReg RM: reg RO: regOpcode);
+ 		at: 3 put: distance.
+ 	^machineCodeSize := 4!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeShiftRegRegOpcode: (in category 'generate machine code') -----
+ concretizeShiftRegRegOpcode: regOpcode
+ 	"On the x64 the only instructions that shift by the value of a
+ 	 register require the shift count to be  in %ecx.  So we may
+ 	 have to use swap instructions to get the count into %ecx."
+ 	<inline: true>
+ 	| shiftCountReg destReg regToShift |
+ 	shiftCountReg := self concreteRegister: (operands at: 0).
+ 	destReg := self concreteRegister: (operands at: 1).
+ 	shiftCountReg = RCX ifTrue:
+ 		[machineCode
+ 			at: 0 put: (self rexR: 0 x: 0 b: destReg);
+ 			at: 1 put: 16rD3;
+ 			at: 2 put: (self mod: ModReg RM: destReg RO: regOpcode).
+ 		 ^machineCodeSize := 3].
+ 	regToShift := destReg = shiftCountReg
+ 					ifTrue: [RCX]
+ 					ifFalse: [destReg = RCX
+ 								ifTrue: [shiftCountReg]
+ 								ifFalse: [destReg]].
+ 	shiftCountReg = RAX ifTrue:
+ 		[machineCode
+ 			at: 0 put: 16r48;
+ 			at: 1 put: 16r90 + RCX; "XCHG RAX,RCX"
+ 			at: 2 put: (self rexR: 0 x: 0 b: regToShift);
+ 			at: 3 put: 16rD3;			"SAR RCX,RAX"
+ 			at: 4 put: (self mod: ModReg RM: regToShift RO: regOpcode);
+ 			at: 5 put: 16r48;
+ 			at: 6 put: 16r90 + RCX. "XCHG RAX,RCX"
+ 		 ^machineCodeSize := 7].
+ 	machineCode
+ 		at: 0 put: (self rexR: shiftCountReg x: 0 b: RCX);		"XCHG R?X,RCX"
+ 		at: 1 put: 16r87;
+ 		at: 2 put: (self mod: ModReg RM: RCX RO: shiftCountReg);
+ 		at: 3 put: (self rexR: 0 x: 0 b: regToShift);			"SAR RCX,R!!X"
+ 		at: 4 put: 16rD3;
+ 		at: 5 put: (self mod: ModReg RM: regToShift RO: regOpcode);
+ 		at: 6 put: (self rexR: shiftCountReg x: 0 b: RCX);		"XCHG R?X,RCX"
+ 		at: 7 put: 16r87;
+ 		at: 8 put: (self mod: ModReg RM: RCX RO: shiftCountReg).
+ 	^machineCodeSize := 9!

Item was removed:
- ----- Method: CogX64Compiler>>concretizeSubCqR (in category 'generate machine code') -----
- concretizeSubCqR
- 	"Will get inlined into concretizeAt: switch."
- 	<inline: true>
- 	| value reg |
- 	value := operands at: 0.
- 	reg := self concreteRegister: (operands at: 1).
- 	machineCode
- 		at: 0 put: (self rexR: 0 x: 0 b: reg).
- 	(self isQuick: value) ifTrue:
- 		[machineCode
- 			at: 1 put: 16r83;
- 			at: 2 put: (self mod: ModReg RM: reg RO: 5);
- 			at: 3 put: (value bitAnd: 16rFF).
- 		 ^machineCodeSize := 4].
- 	self assert: value >> 32 = 0.
- 	reg = RAX ifTrue:
- 		[machineCode
- 			at: 1 put: 16r2D;
- 			at: 2 put: (value bitAnd: 16rFF);
- 			at: 3 put: (value >> 8 bitAnd: 16rFF);
- 			at: 4 put: (value >> 16 bitAnd: 16rFF);
- 			at: 5 put: (value >> 24 bitAnd: 16rFF).
- 		 ^machineCodeSize := 6].
- 	machineCode
- 		at: 1 put: 16r81;
- 		at: 2 put: (self mod: ModReg RM: reg RO: 5);
- 		at: 3 put: (value bitAnd: 16rFF);
- 		at: 4 put: (value >> 8 bitAnd: 16rFF);
- 		at: 5 put: (value >> 16 bitAnd: 16rFF);
- 		at: 6 put: (value >> 24 bitAnd: 16rFF).
- 	 ^machineCodeSize := 7!

Item was changed:
  ----- Method: CogX64Compiler>>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>
  	opcode caseOf: {
  		"Noops & Pseudo Ops"
  		[Label]				-> [^self concretizeLabel].
  		[AlignmentNops]	-> [^self concretizeAlignmentNops].
  		[Fill16]				-> [^self concretizeFill16].
  		[Fill32]				-> [^self concretizeFill32].
  		[FillFromWord]		-> [^self concretizeFillFromWord].
  		[Nop]				-> [^self concretizeNop].
  		"Specific Control/Data Movement"
  		[CDQ]					-> [^self concretizeCDQ].
  		[IDIVR]					-> [^self concretizeIDIVR].
  		[IMULRR]				-> [^self concretizeMulRR].
  		[CPUID]					-> [^self concretizeCPUID].
  		[CMPXCHGAwR]			-> [^self concretizeCMPXCHGAwR].
  		[CMPXCHGMwrR]		-> [^self concretizeCMPXCHGMwrR].
  		[LFENCE]				-> [^self concretizeFENCE: 5].
  		[MFENCE]				-> [^self concretizeFENCE: 6].
  		[SFENCE]				-> [^self concretizeFENCE: 7].
  		[LOCK]					-> [^self concretizeLOCK].
  		[XCHGAwR]				-> [^self concretizeXCHGAwR].
  		[XCHGMwrR]			-> [^self concretizeXCHGMwrR].
  		[XCHGRR]				-> [^self concretizeXCHGRR].
  		"Control"
  		[Call]					-> [^self concretizeCall].
  		[CallFull]				-> [^self concretizeCallFull].
  		[JumpR]					-> [^self concretizeJumpR].
  		[JumpFull]				-> [^self concretizeJumpFull].
  		[JumpLong]				-> [^self concretizeJumpLong].
  		[JumpLongZero]		-> [^self concretizeConditionalJump: 16r4].
  		[JumpLongNonZero]	-> [^self concretizeConditionalJump: 16r5].
  		[Jump]					-> [^self concretizeJump].
  		"Table B-1 Intel® 64 and IA-32 Architectures Software Developer's Manual Volume 1: Basic Architecture"
  		[JumpZero]				-> [^self concretizeConditionalJump: 16r4].
  		[JumpNonZero]			-> [^self concretizeConditionalJump: 16r5].
  		[JumpNegative]			-> [^self concretizeConditionalJump: 16r8].
  		[JumpNonNegative]		-> [^self concretizeConditionalJump: 16r9].
  		[JumpOverflow]			-> [^self concretizeConditionalJump: 16r0].
  		[JumpNoOverflow]		-> [^self concretizeConditionalJump: 16r1].
  		[JumpCarry]			-> [^self concretizeConditionalJump: 16r2].
  		[JumpNoCarry]			-> [^self concretizeConditionalJump: 16r3].
  		[JumpLess]				-> [^self concretizeConditionalJump: 16rC].
  		[JumpGreaterOrEqual]	-> [^self concretizeConditionalJump: 16rD].
  		[JumpGreater]			-> [^self concretizeConditionalJump: 16rF].
  		[JumpLessOrEqual]		-> [^self concretizeConditionalJump: 16rE].
  		[JumpBelow]			-> [^self concretizeConditionalJump: 16r2].
  		[JumpAboveOrEqual]	-> [^self concretizeConditionalJump: 16r3].
  		[JumpAbove]			-> [^self concretizeConditionalJump: 16r7].
  		[JumpBelowOrEqual]	-> [^self concretizeConditionalJump: 16r6].
  		[JumpFPEqual]				-> [^self concretizeConditionalJump: 16r4].
  		[JumpFPNotEqual]			-> [^self concretizeConditionalJump: 16r5].
  		[JumpFPLess]				-> [^self concretizeConditionalJump: 16r2].
  		[JumpFPGreaterOrEqual]	-> [^self concretizeConditionalJump: 16r3].
  		[JumpFPGreater]			-> [^self concretizeConditionalJump: 16r7].
  		[JumpFPLessOrEqual]		-> [^self concretizeConditionalJump: 16r6].
  		[JumpFPOrdered]			-> [^self concretizeConditionalJump: 16rB].
  		[JumpFPUnordered]			-> [^self concretizeConditionalJump: 16rA].
  		[RetN]						-> [^self concretizeRetN].
  		[Stop]						-> [^self concretizeStop].
  		"Arithmetic"
+ 		[AddCqR]					-> [^self concretizeArithCqRWithRO: 0 raxOpcode: 15r05].
- 		[AddCqR]					-> [^self concretizeAddCqR].
  		[AddCwR]					-> [^self concretizeAddCwR].
  		[AddRR]						-> [^self concretizeAddRR].
  		[AddRdRd]					-> [^self concretizeSEE2OpRdRd: 16r58].
+ 		[AndCqR]					-> [^self concretizeArithCqRWithRO: 4 raxOpcode: 16r25].
- 		[AndCqR]					-> [^self concretizeAndCqR].
  		[AndCwR]					-> [^self concretizeAndCwR].
  		[AndRR]						-> [^self concretizeAndRR].
  		[TstCqR]					-> [^self concretizeTstCqR].
+ 		[CmpCqR]					-> [^self concretizeArithCqRWithRO: 7 raxOpcode: 16r3D].
- 		[CmpCqR]					-> [^self concretizeCmpCqR].
  		[CmpCwR]					-> [^self concretizeCmpCwR].
  		[CmpRR]					-> [^self concretizeCmpRR].
  		[CmpRdRd]					-> [^self concretizeCmpRdRd].
  		[DivRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5E].
  		[MulRdRd]					-> [^self concretizeSEE2OpRdRd: 16r59].
+ 		[OrCqR]						-> [^self concretizeArithCqRWithRO: 1 raxOpcode: 16r0D].
- 		[OrCqR]						-> [^self concretizeOrCqR].
  		[OrCwR]					-> [^self concretizeOrCwR].
  		[OrRR]						-> [^self concretizeOrRR].
+ 		[SubCqR]					-> [^self concretizeArithCqRWithRO: 5 raxOpcode: 16r2D].
- 		[SubCqR]					-> [^self concretizeSubCqR].
  		[SubCwR]					-> [^self concretizeSubCwR].
  		[SubRR]						-> [^self concretizeSubRR].
  		[SubRdRd]					-> [^self concretizeSEE2OpRdRd: 16r5C].
  		[SqrtRd]						-> [^self concretizeSqrtRd].
  		[XorCwR]						-> [^self concretizeXorCwR].
  		[XorRR]							-> [^self concretizeXorRR].
  		[NegateR]						-> [^self concretizeNegateR].
  		[LoadEffectiveAddressMwrR]	-> [^self concretizeLoadEffectiveAddressMwrR].
+ 		[ArithmeticShiftRightCqR]		-> [^self concretizeShiftCqRegOpcode: 7].
+ 		[LogicalShiftRightCqR]			-> [^self concretizeShiftCqRegOpcode: 5].
+ 		[LogicalShiftLeftCqR]			-> [^self concretizeShiftCqRegOpcode: 4].
+ 		[ArithmeticShiftRightRR]			-> [^self concretizeShiftRegRegOpcode: 7].
+ 		[LogicalShiftLeftRR]				-> [^self concretizeShiftRegRegOpcode: 4].
- 		[ArithmeticShiftRightCqR]		-> [^self concretizeArithmeticShiftRightCqR].
- 		[LogicalShiftRightCqR]			-> [^self concretizeLogicalShiftRightCqR].
- 		[LogicalShiftLeftCqR]			-> [^self concretizeLogicalShiftLeftCqR].
- 		[ArithmeticShiftRightRR]			-> [^self concretizeArithmeticShiftRightRR].
- 		[LogicalShiftLeftRR]				-> [^self concretizeLogicalShiftLeftRR].
  		"Data Movement"
  		[MoveCqR]			-> [^self concretizeMoveCqR].
  		[MoveCwR]			-> [^self concretizeMoveCwR].
  		[MoveRR]			-> [^self concretizeMoveRR].
  		[MoveAwR]			-> [^self concretizeMoveAwR].
  		[MoveRAw]			-> [^self concretizeMoveRAw].
  		[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].
  		"Conversion"
  		[ConvertRRd]		-> [^self concretizeConvertRRd] }!

Item was changed:
  ----- Method: CogX64CompilerTests>>testMoveMbrR (in category 'tests') -----
  testMoveMbrR
  	"self new testMoveMbrR"
  	self concreteCompilerClass registersWithNamesDo:
  		[:sreg :srname|
  		self concreteCompilerClass registersWithNamesDo:
  			[:dreg :drname|
  			((1 to: 19 by: 3) collect: [:po2| 2 raisedToInteger: po2]) do:
  				[:offset| | inst len |
  				inst := self gen: MoveMbrR operand: offset operand: sreg operand: dreg.
  				len := inst concretizeAt: 0.
  				self processor
  					disassembleInstructionAt: 0
  					In: inst machineCode object
+ 					into: [:str :sz| | plainJane herIntended po |
+ 						po := offset bitAnd: 1 << self processor bitsInWord - 1.
- 					into: [:str :sz| | plainJane herIntended |
  						plainJane := self strip: str.
+ 						herIntended := 'movzbq ', (offset = 0 ifTrue: [''] ifFalse: ['0x', (po printStringBase: 16 length: 16 padded: true)]), '(', srname, '), ', drname.
- 						herIntended := 'movzbl 0x', (offset hex allButFirst: 3), '(', srname, '), ', drname.
  						self assert: (plainJane match: herIntended).
  						self assert: len = sz]]]]!

Item was added:
+ ----- Method: CogX64CompilerTests>>testMoveRXwrR (in category 'tests') -----
+ testMoveRXwrR
+ 	"self new testMoveXwrRR"
+ 	self concreteCompilerClass registersWithNamesDo:
+ 		[:idxreg :irname|
+ 			irname ~= '%rsp' ifTrue:
+ 				[self concreteCompilerClass registersWithNamesDo:
+ 					[:basereg :brname|
+ 					self concreteCompilerClass registersWithNamesDo:
+ 						[:sreg :srname|
+ 						((1 to: 19 by: 3) collect: [:po2| 2 raisedToInteger: po2]) do:
+ 							[:offset| | inst len |
+ 							inst := self gen: MoveRXwrR operand: sreg operand: idxreg operand: basereg.
+ 							len := inst concretizeAt: 0.
+ 							self processor
+ 								disassembleInstructionAt: 0
+ 								In: inst machineCode object
+ 								into: [:str :sz| | plainJane herIntended |
+ 									"Convert e.g. '00000000: movl %eax, 0x2(%eax) : 89 40 02' to  'movl %eax, 0x2(%eax)'"
+ 									plainJane := self strip: str.
+ 									herIntended := 'movq ', srname, ', (', brname, ',', irname, ',8)'.
+ 									self assert: (plainJane match: herIntended).
+ 									self assert: len = sz]]]]]]!

Item was changed:
  ----- Method: CogX64CompilerTests>>testMoveXwrRR (in category 'tests') -----
  testMoveXwrRR
  	"self new testMoveXwrRR"
  	self concreteCompilerClass registersWithNamesDo:
  		[:idxreg :irname|
+ 			irname ~= '%rsp' ifTrue:
- 			irname ~= '%esp' ifTrue:
  				[self concreteCompilerClass registersWithNamesDo:
  					[:basereg :brname|
  					self concreteCompilerClass registersWithNamesDo:
  						[:dreg :drname|
  						((1 to: 19 by: 3) collect: [:po2| 2 raisedToInteger: po2]) do:
  							[:offset| | inst len |
  							inst := self gen: MoveXwrRR operand: idxreg operand: basereg operand: dreg.
  							len := inst concretizeAt: 0.
  							self processor
  								disassembleInstructionAt: 0
  								In: inst machineCode object
  								into: [:str :sz| | plainJane herIntended |
  									"Convert e.g. '00000000: movl %eax, 0x2(%eax) : 89 40 02' to  'movl %eax, 0x2(%eax)'"
  									plainJane := self strip: str.
+ 									herIntended := 'movq (', brname, ',', irname, ',8), ',drname.
- 									herIntended := 'movl (', brname, ',', irname, ',4), ',drname.
  									self assert: (plainJane match: herIntended).
  									self assert: len = sz]]]]]]!



More information about the Vm-dev mailing list