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

commits at source.squeak.org commits at source.squeak.org
Mon Sep 28 19:26:01 UTC 2015


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

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

Name: VMMaker.oscog-eem.1474
Author: eem
Time: 28 September 2015, 12:23:48.419 pm
UUID: c11cadbf-1f63-4bd2-95cb-4c5d2de058c5
Ancestors: VMMaker.oscog-eem.1473

x64 Cogit:
More support. Get VarBase support sorted out, including in disassembly decoration.

Fix bug by establishing the VarBaseReg in cePrimReturnEnterCogCode enilopmarts.

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

Item was added:
+ ----- Method: CogOutOfLineLiteralsX64Compiler>>concreteRegister: (in category 'encoding') -----
+ concreteRegister: registerIndex
+ 	 "Map a possibly abstract register into a concrete one.  Abstract registers
+ 	  (defined in CogAbstractOpcodes) are all negative.  If registerIndex is
+ 	 negative assume it is an abstract register.
+ 
+ 	[1] Figure 3.4 Register Usage in
+ 		System V Application Binary Interface
+ 		AMD64 Architecture Processor Supplement
+ 
+ 
+ 	N.B. RAX RCX & RDX are caller-save (scratch) registers.  Hence we use RCX for class and RDX for
+ 		receiver/result since these are written in all normal sends."
+ 
+ 	^registerIndex
+ 		caseOf: {
+ 			[TempReg]				-> [RAX].
+ 			[ClassReg]				-> [RCX].
+ 			[ReceiverResultReg]	-> [RDX].
+ 			[SendNumArgsReg]		-> [R8].
+ 			[SPReg]					-> [RSP].
+ 			[FPReg]					-> [RBP].
+ 			[Arg0Reg]				-> [RDI]. "So as to agree with C ABI arg 0"
+ 			[Arg1Reg]				-> [RSI]. "So as to agree with C ABI arg 1"
+ 			[VarBaseReg]			-> [RBX]. "Must be callee saved"
+ 			"No need for a RISCTempReg because out-of-line literal loads imply
+ 			 no need for a special MoveCwR, given movabsq only targets RAX"
+ 			"[RISCTempReg]		-> [R8]."
+ 			[Scratch0Reg]			-> [R9].
+ 			[Scratch1Reg]			-> [R10].
+ 			[Scratch2Reg]			-> [R11].
+ 			[Scratch3Reg]			-> [R12].
+ 			[Scratch4Reg]			-> [R13].
+ 			[Scratch5Reg]			-> [R14].
+ 			[Scratch6Reg]			-> [R15] }
+ 		otherwise:
+ 			[self assert: (registerIndex between: RAX and: R15).
+ 			 registerIndex]!

Item was added:
+ ----- Method: CogX64Compiler class>>VarBaseReg (in category 'accessing') -----
+ VarBaseReg
+ 	"Answer the number of the reg we use to hold the base address of CoInterpreter variables"
+ 	^RBX!

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]].
  		[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: [((operands at: 0) = 0
  											and: [((self concreteRegister: (operands at: 1)) bitAnd: 7) ~= RBP])
  												ifTrue: [4]
  												ifFalse: [5]]
  									ifFalse: [8])
  								+ (((self concreteRegister: (operands at: 1)) bitAnd: 7) = RSP
  									ifTrue: [1]
  									ifFalse: [0])].
  		[MoveRMbr]		-> [^((self isQuick: (operands at: 1))
  									ifTrue: [((operands at: 1) = 0
  											and: [((self concreteRegister: (operands at: 0)) bitAnd: 7) ~= RBP])
  												ifTrue: [3]
  												ifFalse: [4]]
  									ifFalse: [7])
  								+ (((self concreteRegister: (operands at: 2)) bitAnd: 7) = RSP
  									ifTrue: [1]
  									ifFalse: [0])].
+ 		[MoveM16rR]	-> [^((self isQuick: (operands at: 0))
+ 									ifTrue: [((operands at: 0) = 0
+ 											and: [((self concreteRegister: (operands at: 1)) bitAnd: 7) ~= RBP])
+ 												ifTrue: [4]
+ 												ifFalse: [5]]
+ 									ifFalse: [8])
+ 								+ (((self concreteRegister: (operands at: 1)) bitAnd: 7) = RSP
+ 									ifTrue: [1]
+ 									ifFalse: [0])].
+ 		"[MoveM64rRd]	-> [^((self isQuick: (operands at: 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)) ~= 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]].
  		[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>>concretizeJumpR (in category 'generate machine code') -----
+ concretizeJumpR
+ 	<inline: true>
+ 	| reg |
+ 	reg := self concreteRegister: (operands at: 0).
+ 	machineCode
+ 		at: 0 put: 16rFF;
+ 		at: 1 put: (self mod: ModReg RM: reg RO: 4).
+ 	^machineCodeSize := 2!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeMoveAwR (in category 'generate machine code') -----
  concretizeMoveAwR
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| addressOperand reg offset save0 save1 |
  	addressOperand := operands at: 0.
  	(self isAnInstruction: (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *')) ifTrue:
  		[addressOperand := (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *') address].
  	(self isAddressRelativeToVarBase: addressOperand) ifTrue:
  		[save0 := operands at: 0.
  		 save1 := operands at: 1.
  		 operands
  			at: 0 put: addressOperand - cogit varBaseAddress;
+ 			at: 1 put: RBX;
- 			at: 1 put: VarBaseReg;
  			at: 2 put: save1.
  		 self concretizeMoveMwrR.
  		 operands
  			at: 0 put: save0;
  			at: 1 put: save1;
  			at: 2 put: 0.
  		^machineCodeSize].
  	reg := self concreteRegister: (operands at: 1).
  	reg = RAX
  		ifTrue: [offset := 0]
  		ifFalse:
  			[machineCode
  				at: 0 put: (self rexR: 0 x: 0 b: reg);
  				at: 1 put: 16r90 + (reg \\ 8).
  			 offset := 2].
  	machineCode
  		at: 0 + offset put: 16r48;
  		at: 1 + offset put: 16rA1;
  		at: 2 + offset put: (addressOperand bitAnd: 16rFF);
  		at: 3 + offset put: (addressOperand >> 8 bitAnd: 16rFF);
  		at: 4 + offset put: (addressOperand >> 16 bitAnd: 16rFF);
  		at: 5 + offset put: (addressOperand >> 24 bitAnd: 16rFF);
  		at: 6 + offset put: (addressOperand >> 32 bitAnd: 16rFF);
  		at: 7 + offset put: (addressOperand >> 40 bitAnd: 16rFF);
  		at: 8 + offset put: (addressOperand >> 48 bitAnd: 16rFF);
  		at: 9 + offset put: (addressOperand >> 56 bitAnd: 16rFF).
  	reg = RAX ifTrue:
  		[^machineCodeSize := 10].
  	machineCode
  		at: 12 put: (machineCode at: 0);
  		at: 13 put: (machineCode at: 1).
  	^machineCodeSize := 14!

Item was added:
+ ----- Method: CogX64Compiler>>concretizeMoveM16rR (in category 'generate machine code') -----
+ concretizeMoveM16rR
+ 	"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: 16rb7.
+ 	(srcReg ~= RSP and: [srcReg ~= R12]) ifTrue:
+ 		[(offset = 0 and: [destReg ~= RBP and: [destReg ~= R13]]) ifTrue:
+ 			[machineCode
+ 				at: 3 put: (self mod: ModRegInd RM: srcReg RO: destReg).
+ 			 ^machineCodeSize := 4].
+ 		 (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:"
+ 	(offset = 0 and: [destReg ~= RBP and: [destReg ~= R13]]) ifTrue:
+ 		[machineCode
+ 			at: 3 put: (self mod: ModRegInd RM: srcReg RO: destReg);
+ 			at: 4 put: (self s: SIB1 i: 4 b: srcReg).
+ 		 ^machineCodeSize := 5].
+ 	(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>>concretizeMoveRAw (in category 'generate machine code') -----
  concretizeMoveRAw
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
  	| addressOperand reg offset save1 |
  	reg := self concreteRegister: (operands at: 0).
  	addressOperand := operands at: 1.
  	(self isAnInstruction: (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *')) ifTrue:
  		[addressOperand := (cogit cCoerceSimple: addressOperand to: #'AbstractInstruction *') address].
  	(self isAddressRelativeToVarBase: addressOperand) ifTrue:
  		[save1 := operands at: 1.
  		 operands
  			at: 1 put: addressOperand - cogit varBaseAddress;
+ 			at: 2 put: RBX.
- 			at: 2 put: VarBaseReg.
  		 self concretizeMoveRMwr.
  		 operands
  			at: 1 put: save1;
  			at: 2 put: 0.
  		^machineCodeSize].
  	reg = RAX
  		ifTrue: [offset := 0]
  		ifFalse:
  			[machineCode
  				at: 0 put: (self rexR: 0 x: 0 b: reg);
  				at: 1 put: 16r90 + (reg \\ 8).
  			 offset := 2].
  	machineCode
  		at: 0 + offset put: 16r48;
  		at: 1 + offset put: 16rA3;
  		at: 2 + offset put: (addressOperand bitAnd: 16rFF);
  		at: 3 + offset put: (addressOperand >> 8 bitAnd: 16rFF);
  		at: 4 + offset put: (addressOperand >> 16 bitAnd: 16rFF);
  		at: 5 + offset put: (addressOperand >> 24 bitAnd: 16rFF);
  		at: 6 + offset put: (addressOperand >> 32 bitAnd: 16rFF);
  		at: 7 + offset put: (addressOperand >> 40 bitAnd: 16rFF);
  		at: 8 + offset put: (addressOperand >> 48 bitAnd: 16rFF);
  		at: 9 + offset put: (addressOperand >> 56 bitAnd: 16rFF).
  	reg = RAX ifTrue:
  		[^machineCodeSize := 10].
  	machineCode
  		at: 12 put: (machineCode at: 0);
  		at: 13 put: (machineCode at: 1).
  	^machineCodeSize := 14!

Item was added:
+ ----- Method: CogX64Compiler>>genRemoveNArgsFromStack: (in category 'abi') -----
+ genRemoveNArgsFromStack: n
+ 	"This is a no-op on x64 since the ABI passes up to 6 args in registers and trampolines currently observe a limit of 4."
+ 	self assert: n <= 6.
+ 	^0!

Item was changed:
  ----- Method: CogX64Compiler>>maybeEstablishVarBase (in category 'abstract instructions') -----
  maybeEstablishVarBase
+ 	"The receiver has a VarBaseReg; generate the code to set it to its value."
+ 	cogit MoveCq: cogit varBaseAddress R: VarBaseReg!
- 	"The receiver does not have a VarBaseReg; do nothing."!

Item was changed:
  ----- Method: Cogit>>lookupCHexString: (in category 'disassembly') -----
  lookupCHexString: aCHexString 
  	<doNotGenerate>
+ 	| pastLastZero |
  	(aCHexString beginsWith: '0x') ifFalse:
  		[^aCHexString].
  	^(self lookupAddress: (Number
+ 								readFrom: (ReadStream on: aCHexString from: 3 to: aCHexString size)
- 								readFrom: (aCHexString copyFrom: 3 to: aCHexString size) asUppercase readStream
  								base: 16))
  		ifNotNil: [:string| aCHexString, '=', string]
+ 		ifNil: [pastLastZero := aCHexString findFirst: [:c| c ~= $0 and: [c ~= $x]].
+ 			pastLastZero = 0 ifTrue: [pastLastZero := aCHexString size + 1].
+ 			(aCHexString size >= 16 and: [pastLastZero >= 4])
+ 				ifTrue: [aCHexString copyReplaceFrom: 3 to: pastLastZero - 1 with: '']
+ 				ifFalse: [aCHexString]]!
- 		ifNil: [aCHexString]!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genPrimReturnEnterCogCodeEnilopmart: (in category 'initialization') -----
  genPrimReturnEnterCogCodeEnilopmart: profiling
  	"Generate the substitute return code for an external or FFI primitive call.
  	 On success simply return, extracting numArgs from newMethod.
  	 On primitive failure call ceActivateFailingPrimitiveMethod: newMethod."
  	| jmpSample continuePostSample jmpFail |
  	<var: #jmpSample type: #'AbstractInstruction *'>
  	<var: #continuePostSample type: #'AbstractInstruction *'>
  	<var: #jmpFail type: #'AbstractInstruction *'>
  	self zeroOpcodeIndex.
+ 	backEnd maybeEstablishVarBase. "Must happen sometime"
  
  	profiling ifTrue:
  		["Test nextProfileTick for being non-zero and call checkProfileTick: if so.
  		  N.B. nextProfileTick is 64-bits so 32-bit systems need to test both halves."
  		objectMemory wordSize = 4
  			ifTrue:
  				[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  				 self MoveAw: coInterpreter nextProfileTickAddress + objectMemory wordSize R: ClassReg.
  				 self OrR: TempReg R: ClassReg]
  			ifFalse:
  				[self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  				 self CmpCq: 0 R: TempReg].
  		"If set, jump to record sample call."
  		jmpSample := self JumpNonZero: 0.
  		continuePostSample := self Label].
  
  	self maybeCompileAllocFillerCheck.
  
  	"Test primitive failure"
  	self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
  	self flag: 'ask concrete code gen if move sets condition codes?'.
  	self CmpCq: 0 R: TempReg.
  	jmpFail := self JumpNonZero: 0.
  
  	"Switch back to the Smalltalk stack.  Stack better be in either of these two states:
  		success:	stackPointer	->	result (was receiver)
  										arg1
  										...
  										argN
  										return pc
  		failure:							receiver
  										arg1
  										...
  					stackPointer	->	argN
  										return pc
  	We push the instructionPointer to reestablish the return pc in the success case,
  	but leave it to ceActivateFailingPrimitiveMethod: to do so in the failure case."
  
  	backEnd hasLinkRegister
  		ifTrue:
  			[backEnd genLoadStackPointers.											"Switch back to Smalltalk stack."
  			 backEnd hasPCRegister
  				ifTrue:
  					[self PopR: ReceiverResultReg.										"Pop result from stack"
  					 self MoveAw: coInterpreter instructionPointerAddress R: PCReg]	"Return"
  				ifFalse:
  					[self MoveMw: 0 r: SPReg R: ReceiverResultReg.						"Fetch result from stack"
  					 self MoveAw: coInterpreter instructionPointerAddress R: LinkReg.	"Get ret pc"
  					 self RetN: objectMemory wordSize]]								"Return, popping result from stack"
  		ifFalse:
  			[self MoveAw: coInterpreter instructionPointerAddress R: ClassReg.	"Get return pc"
  			 backEnd genLoadStackPointers.									"Switch back to Smalltalk stack."
  			 self MoveMw: 0 r: SPReg R: ReceiverResultReg.						"Fetch result from stack"
  			 self MoveR: ClassReg Mw: 0 r: SPReg.								"Restore return pc"
  			 self RetN: 0].														"Return, popping result from stack"
  
  	"Primitive failed.  Invoke C code to build the frame and continue."
  	jmpFail jmpTarget: (self MoveAw: coInterpreter newMethodAddress R: SendNumArgsReg).
  	"Reload sp with CStackPointer; easier than popping args of checkProfileTick."
  	self MoveAw: self cStackPointerAddress R: SPReg.
  	self 
  		compileCallFor: #ceActivateFailingPrimitiveMethod:
  		numArgs: 1
  		arg: SendNumArgsReg
  		arg: nil
  		arg: nil
  		arg: nil
  		resultReg: nil
  		saveRegs: false.
  
  	"On Spur ceActivateFailingPrimitiveMethod: may retry the primitive and return if successful.
  	 So continue by returning to the caller.
  	 Switch back to the Smalltalk stack.  Stack should be in this state:
  				success:	stackPointer ->	result (was receiver)
  											arg1
  											...
  											argN
  											return pc
  	 We can push the instructionPointer or load it into the LinkRegister to reestablish the return pc"
  	self MoveAw: coInterpreter instructionPointerAddress
  		R: (backEnd hasLinkRegister ifTrue: [LinkReg] ifFalse: [ClassReg]).
  	backEnd genLoadStackPointers.
  	backEnd hasLinkRegister
  		ifTrue:
  			[self MoveMw: 0 r: SPReg R: ReceiverResultReg]	"Fetch result from stack"
  		ifFalse:
  			[self MoveMw: objectMemory wordSize r: SPReg R: ReceiverResultReg.	"Fetch result from stack"
  			 self PushR: ClassReg].											"Restore return pc on CISCs"
  	self RetN: objectMemory wordSize.	"return to caller, popping receiver"
  
  	profiling ifTrue:
  		["Call ceCheckProfileTick: to record sample and then continue.  newMethod
  		 should be up-to-date.  Need to save and restore the link reg around this call."
  		 jmpSample jmpTarget: self Label.
  		 backEnd saveAndRestoreLinkRegAround:
  			[self CallFullRT: (self cCode: '(unsigned long)ceCheckProfileTick'
  						inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick])].
  		 self Jump: continuePostSample]!



More information about the Vm-dev mailing list