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

commits at source.squeak.org commits at source.squeak.org
Sun Sep 27 02:02:11 UTC 2015


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

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

Name: VMMaker.oscog-eem.1470
Author: eem
Time: 26 September 2015, 6:59:57.54 pm
UUID: 1c861b42-d808-4f4d-822f-99d58bff669d
Ancestors: VMMaker.oscog-eem.1469

Cogit:
More x64 compilation support.  Now all trampolines up to, but not including, the object representation ones are generated.  Fix a bug in the x64's concretizeMoveCqR.

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

Item was changed:
  ----- Method: CogARMCompiler>>genMarshallNArgs:arg:arg:arg:arg: (in category 'abi') -----
  genMarshallNArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3
  	"Generate the code to pass up to four arguments in a C run-time call.  Hack: each argument is either a
  	 negative number, that of an abstract register, or a non-negative number, that of a constant parameter.
  
  	 Run-time calls have no more than four arguments, so chosen so that on ARM, where in its C ABI the
  	 first four integer arguments are passed in registers, all arguments can be passed in registers.  We
  	 defer to the back end to generate this code not so much that teh back end knows whether it uses
  	 the stack or registers to pass arguments (it does, but...). In fact we defer for an extremely evil reason.
  	 Doing so allows the x64 (where up to 6 args are passed) to assign the register arguments in an order
  	 that allows some of the argument registers to be used for specificabstract  registers, specifically
  	 ReceiverResultReg and ClassReg.  This is evil, evil, evil, but also its really nice to keep using the old
  	 register assignments the principal author has grown accustomed to."
  	<inline: true>
  	numArgs = 0 ifTrue: [^self].
+ 	regOrConst0 >= 0
- 	regOrConst0 < 0
  		ifTrue: [cogit MoveCq: regOrConst0 R: CArg0Reg]
  		ifFalse: [cogit MoveR: regOrConst0 R: CArg0Reg].
  	numArgs = 1 ifTrue: [^self].
+ 	regOrConst1 >= 0
- 	regOrConst1 < 0
  		ifTrue: [cogit MoveCq: regOrConst1 R: CArg1Reg]
  		ifFalse: [cogit MoveR: regOrConst1 R: CArg1Reg].
  	numArgs = 2 ifTrue: [^self].
+ 	regOrConst2 >= 0
- 	regOrConst2 < 0
  		ifTrue: [cogit MoveCq: regOrConst2 R: CArg2Reg]
  		ifFalse: [cogit MoveR: regOrConst2 R: CArg2Reg].
  	numArgs = 3 ifTrue: [^self].
+ 	regOrConst3 >= 0
- 	regOrConst3 < 0
  		ifTrue: [cogit MoveCq: regOrConst3 R: CArg3Reg]
  		ifFalse: [cogit MoveR: regOrConst3 R: CArg3Reg]!

Item was added:
+ ----- Method: CogX64Compiler>>cResultRegister (in category 'accessing') -----
+ cResultRegister
+ 	"Answer the abstract register for the C result register.
+ 	 Only partially implemented.  Works on x64 since TempReg = RAX = C result reg."
+ 	^self abstractRegisterForConcreteRegister: RAX!

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: [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])]."
- 											ifFalse: [0])].
  		[MoveMbrR]		-> [^((self isQuick: (operands at: 0))
+ 											ifTrue: [5]
+ 											ifFalse: [8])
+ 										+ ((self concreteRegister: (operands at: 1)) = RSP
- 											ifTrue: [4]
- 											ifFalse: [7])
- 										+ ((self concreteRegister: (operands at: 1)) = ESP
  											ifTrue: [1]
  											ifFalse: [0])].
+ 		[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))
- 		[MoveRMbr]		-> [^((self isQuick: (operands at: 1))
- 											ifTrue: [3]
- 											ifFalse: [6])
- 										+ ((self concreteRegister: (operands at: 2)) = ESP
- 											ifTrue: [1]
- 											ifFalse: [0])].
- 		[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)) ~= 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 added:
+ ----- Method: CogX64Compiler>>concretizeCall (in category 'generate machine code') -----
+ concretizeCall
+ 	"Will get inlined into concretizeAt: switch."
+ 	<inline: true>
+ 	| offset |
+ 	self assert: (operands at: 0) ~= 0.
+ 	offset := (operands at: 0) signedIntFromLong - (address + 5) signedIntFromLong.
+ 	machineCode
+ 		at: 0 put: 16rE8;
+ 		at: 1 put: (offset bitAnd: 16rFF);
+ 		at: 2 put: (offset >> 8 bitAnd: 16rFF);
+ 		at: 3 put: (offset >> 16 bitAnd: 16rFF);
+ 		at: 4 put: (offset >> 24 bitAnd: 16rFF).
+ 	^machineCodeSize := 5!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeCallFull (in category 'generate machine code') -----
+ concretizeCallFull
+ 	"Since CallFull (and JumpFull) is used to invoke code in dynamically-loaded plugins it shouldn't
+ 	 assume that code will be loaded within 2Gb of the code zone.  Hence generate a full 64-bit call,
+ 	 movabsq 0x123456789abcdef0, %rax; callq %rax."
+ 	<inline: true>
+ 	| operand |
+ 	operand := operands at: 0.
+ 	machineCode
+ 		at: 0 put: 16r48;
+ 		at: 1 put: 16rA1;
+ 		at: 2 put: (operand bitAnd: 16rFF);
+ 		at: 3 put: (operand >> 8 bitAnd: 16rFF);
+ 		at: 4 put: (operand >> 16 bitAnd: 16rFF);
+ 		at: 5 put: (operand >> 24 bitAnd: 16rFF);
+ 		at: 6 put: (operand >> 32 bitAnd: 16rFF);
+ 		at: 7 put: (operand >> 40 bitAnd: 16rFF);
+ 		at: 8 put: (operand >> 48 bitAnd: 16rFF);
+ 		at: 9 put: (operand >> 56 bitAnd: 16rFF);
+ 		at: 10 put: 16rFF;
+ 		at: 11 put: (self mod: 3 RM: RAX RO: 2).
+ 	^machineCodeSize := 12!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeJumpFull (in category 'generate machine code') -----
+ concretizeJumpFull
+ 	"Since JumpFull (and CallFull) is used to invoke code in dynamically-loaded plugins it shouldn't
+ 	 assume that code will be loaded within 2Gb of the code zone.  Hence generate a full 64-bit call,
+ 	 movabsq 0x123456789abcdef0, %rax; callq %rax."
+ 	<inline: true>
+ 	| operand |
+ 	operand := operands at: 0.
+ 	machineCode
+ 		at: 0 put: 16r48;
+ 		at: 1 put: 16rA1;
+ 		at: 2 put: (operand bitAnd: 16rFF);
+ 		at: 3 put: (operand >> 8 bitAnd: 16rFF);
+ 		at: 4 put: (operand >> 16 bitAnd: 16rFF);
+ 		at: 5 put: (operand >> 24 bitAnd: 16rFF);
+ 		at: 6 put: (operand >> 32 bitAnd: 16rFF);
+ 		at: 7 put: (operand >> 40 bitAnd: 16rFF);
+ 		at: 8 put: (operand >> 48 bitAnd: 16rFF);
+ 		at: 9 put: (operand >> 56 bitAnd: 16rFF);
+ 		at: 10 put: 16rFF;
+ 		at: 11 put: (self mod: 4 RM: RAX RO: 2).
+ 	^machineCodeSize := 12!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveCqR (in category 'generate machine code') -----
  concretizeMoveCqR
  	"Will get inlined into concretizeAt: switch.
  	 On x64 we can short-cut mov 0, reg using xor, and use 32-bit displacement, signed or unsigned, if possible."
  	<inline: true>
  	| value reg |
  	value := operands at: 0.
  	(self is32BitSignedImmediate: value) ifFalse:
  		[^self concretizeMoveCwR].
  	reg := self concreteRegister: (operands at: 1).
  	machineCode at: 0 put: (self rexR: reg x: 0 b: reg).
  	value = 0 ifTrue:
  		[machineCode
  			at: 1 put: 16r31;
  			at: 2 put: (self mod: ModReg RM: reg RO: reg).
  		^machineCodeSize := 3].
  	machineCode
  		at: 1 put: 16rC7;
+ 		at: 2 put: (self mod: ModReg RM: reg RO: 0);
- 		at: 2 put: (self mod: ModReg RM: reg RO: reg);
  		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>>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 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:"
+ 	(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 changed:
  ----- Method: CogX64Compiler>>genMarshallNArgs:arg:arg:arg:arg: (in category 'abi') -----
  genMarshallNArgs: numArgs arg: regOrConst0 arg: regOrConst1 arg: regOrConst2 arg: regOrConst3
  	"Generate the code to pass up to four arguments in a C run-time call.  Hack: each argument is either a
  	 negative number, that of an abstract register, or a non-negative number, that of a constant parameter.
  
  	 Run-time calls have no more than four arguments, so chosen so that on ARM, where in its C ABI the
  	 first four integer arguments are passed in registers, all arguments can be passed in registers.  We
  	 defer to the back end to generate this code not so much that teh back end knows whether it uses
  	 the stack or registers to pass arguments (it does, but...). In fact we defer for an extremely evil reason.
  	 Doing so allows the x64 (where up to 6 args are passed) to assign the register arguments in an order
  	 that allows some of the argument registers to be used for specificabstract  registers, specifically
  	 ReceiverResultReg and ClassReg.  This is evil, evil, evil, but also its really nice to keep using the old
  	 register assignments the principal author has grown accustomed to.
  
  	 How can this possibly work?  Look at Cogit class>>runtime for a list of the run-time calls and their
  	 arguments, including which arguments are passed in which registers.  Look at CogX64Compiler's
  	 subclass implementations of concreteRegister:.  There are no calls in which ReceiverResultReg (RDX)
  	 and/or ClassReg (RCX) are passed along with Arg0Reg and Arg1Reg, and none in which the use of
  	 either ReceiverResultReg or ClassReg conflict for args 3 & 4.  So if args are assigned in order, the
  	 registers do not get overwritten.  Yes, this is evil, but it's so nice to continue to use RCX & RDX."
  	<inline: true>
  	numArgs = 0 ifTrue: [^self].
+ 	regOrConst0 >= 0
- 	regOrConst0 < 0
  		ifTrue: [cogit MoveCq: regOrConst0 R: RDI]
+ 		ifFalse:
+ 			[(self concreteRegister: regOrConst0) ~= RDI ifTrue:
+ 				[cogit MoveR: regOrConst0 R: RDI]].
- 		ifFalse: [cogit MoveR: regOrConst0 R: RDI].
  	numArgs = 1 ifTrue: [^self].
+ 	regOrConst1 >= 0
- 	regOrConst1 < 0
  		ifTrue: [cogit MoveCq: regOrConst1 R: RSI]
+ 		ifFalse:
+ 			[(self concreteRegister: regOrConst1) ~= RSI ifTrue:
+ 				[cogit MoveR: regOrConst1 R: RSI]].
- 		ifFalse: [cogit MoveR: regOrConst1 R: RSI].
  	numArgs = 2 ifTrue: [^self].
+ 	regOrConst2 >= 0
- 	regOrConst2 < 0
  		ifTrue: [cogit MoveCq: regOrConst2 R: RDX]
+ 		ifFalse:
+ 			[(self concreteRegister: regOrConst2) ~= RDX ifTrue:
+ 				[cogit MoveR: regOrConst2 R: RDX]].
- 		ifFalse: [cogit MoveR: regOrConst2 R: RDX].
  	numArgs = 3 ifTrue: [^self].
+ 	regOrConst3 >= 0
- 	regOrConst3 < 0
  		ifTrue: [cogit MoveCq: regOrConst3 R: RCX]
+ 		ifFalse:
+ 			[(self concreteRegister: regOrConst3) ~= RCX ifTrue:
+ 				[cogit MoveR: regOrConst3 R: RCX]]!
- 		ifFalse: [cogit MoveR: regOrConst3 R: RCX]!

Item was added:
+ ----- Method: CogX64Compiler>>genPushRegisterArgsForAbortMissNumArgs: (in category 'smalltalk calling convention') -----
+ genPushRegisterArgsForAbortMissNumArgs: numArgs
+ 	"Ensure that the register args are pushed before the outer and
+ 	 inner retpcs at an entry miss for arity <= self numRegArgs.  The
+ 	 outer retpc is that of a call at a send site.  The inner is the call
+ 	 from a method or PIC abort/miss to the trampoline."
+ 
+ 	"This won't be as clumsy on a RISC.  But putting the receiver and
+ 	 args above the return address means the CoInterpreter has a
+ 	 single machine-code frame format which saves us a lot of work."
+ 
+ 	"Iff there are register args convert
+ 		base	->	outerRetpc		(send site retpc)
+ 		sp		->	innerRetpc		(PIC abort/miss retpc)
+ 	 to
+ 		base	->	receiver
+ 					(arg0)
+ 					(arg1)
+ 					outerRetpc
+ 		sp		->	innerRetpc		(PIC abort/miss retpc)"
+ 	numArgs <= cogit numRegArgs ifTrue:
+ 		[self assert: cogit numRegArgs <= 2.
+ 		 numArgs = 0 ifTrue:
+ 			[cogit MoveMw: 0 r: SPReg R: TempReg.
+ 			 cogit PushR: TempReg.
+ 			 cogit MoveMw: objectMemory wordSize * 2 r: SPReg R: TempReg.
+ 			 cogit MoveR: TempReg Mw: objectMemory wordSize r: SPReg.
+ 			 cogit MoveR: ReceiverResultReg Mw: 2 * objectMemory wordSize r: SPReg.
+ 			 ^self].
+ 		 numArgs = 1 ifTrue:
+ 			[cogit MoveMw: objectMemory wordSize r: SPReg R: TempReg.
+ 			 cogit PushR: TempReg.
+ 			 cogit MoveMw: objectMemory wordSize r: SPReg R: TempReg.
+ 			 cogit PushR: TempReg.
+ 			 cogit MoveR: ReceiverResultReg Mw: 3 * objectMemory wordSize r: SPReg.
+ 			 cogit MoveR: Arg0Reg Mw: 2 * objectMemory wordSize r: SPReg.
+ 			 ^self].
+ 		 numArgs = 2 ifTrue:
+ 			[cogit PushR: Arg1Reg.
+ 			 cogit MoveMw: objectMemory wordSize * 2 r: SPReg R: TempReg.
+ 			 cogit PushR: TempReg.
+ 			 cogit MoveMw: objectMemory wordSize * 2 r: SPReg R: TempReg.
+ 			 cogit PushR: TempReg.
+ 			 cogit MoveR: ReceiverResultReg Mw: 4 * objectMemory wordSize r: SPReg.
+ 			 cogit MoveR: Arg0Reg Mw: 3 * objectMemory wordSize r: SPReg.
+ 			 ^self]]!

Item was added:
+ ----- Method: CogX64Compiler>>genRestoreRegs (in category 'abi') -----
+ genRestoreRegs
+ 	"Restore the general purpose registers for a trampoline call.
+ 	 c.f. genSaveRegisters"
+ 	cogit
+ 		PopR: RAX;
+ 		PopR: RBX;
+ 		PopR: RCX;
+ 		PopR: RDX;
+ 		PopR: RSI;
+ 		PopR: RDI;
+ 		PopR: R8;
+ 		PopR: R9;
+ 		PopR: R10;
+ 		PopR: R11;
+ 		PopR: R12;
+ 		PopR: R13;
+ 		PopR: R14;
+ 		PopR: R15.
+ 	^0!

Item was added:
+ ----- Method: CogX64Compiler>>genSaveRegisters (in category 'abi') -----
+ genSaveRegisters
+ 	"Save the general purpose registers for a trampoline call."
+ 	cogit
+ 		PushR: R15;
+ 		PushR: R14;
+ 		PushR: R13;
+ 		PushR: R12;
+ 		PushR: R11;
+ 		PushR: R10;
+ 		PushR: R9;
+ 		PushR: R8;
+ 		PushR: RDI;
+ 		PushR: RSI;
+ 		PushR: RDX;
+ 		PushR: RCX;
+ 		PushR: RBX;
+ 		PushR: RAX.
+ 	^0!

Item was added:
+ ----- Method: CogX64Compiler>>isBigEndian (in category 'testing') -----
+ isBigEndian
+ 	<inline: true>
+ 	^false!

Item was added:
+ ----- Method: CogX64Compiler>>minAbstractGeneralPurposeReg (in category 'accessing') -----
+ minAbstractGeneralPurposeReg
+ 	"Answer the smallest index of an abstract general-purpose register used by this compiler.
+ 	 N.B.  Abstract registers are negative numbers."
+ 	<inline: true>
+ 	^Scratch5Reg!

Item was added:
+ ----- Method: CogX64Compiler>>numberOfSaveableRegisters (in category 'abi') -----
+ numberOfSaveableRegisters
+ 	"Answer the number of registers to be saved in a trampoline call that saves registers.
+ 	 See genSaveRegisters"
+ 	<cmacro: '(self) 14'>
+ 	^14!

Item was added:
+ ----- Method: CogX64Compiler>>saveAndRestoreLinkRegAround: (in category 'abi') -----
+ saveAndRestoreLinkRegAround: aBlock
+ 	"If the processor's ABI includes a link register, generate instructions
+ 	 to save and restore it around aBlock, which is assumed to generate code."
+ 	<inline: true>
+ 	^aBlock value!



More information about the Vm-dev mailing list