[Vm-dev] VM Maker: VMMaker.oscogSPC-eem.2128.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Feb 14 01:05:41 UTC 2017


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

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

Name: VMMaker.oscogSPC-eem.2128
Author: eem
Time: 13 February 2017, 5:04:50.850654 pm
UUID: 69c741fe-e9bd-4599-8fd9-a2bd3fabea56
Ancestors: VMMaker.oscogSPC-eem.2127

64-bit Cogit:
Fix a regression in CogX64Compiler>>concretizeConvertRRd and a bug in CogX64Compiler>>concretizeConvertRdR.

Fix a bug in genPrimitiveSmallFloatSquareRoot.  The primitive must fail for negative arguments.

InterpreterPrimitives:
Simplify the boxed and immediate unary float primitives to do less stack manipulations and/or primFailCode testing.

RegisterAllocatingCogit:
Synthesize the dummy value when falling through from an inlinable special selector comparison to a following conditional jump by copying the top of stack from the fixup at the jump to avoid a false conflict.

Flush registers that are only live on one path at a non-merge fixup (arguably this is rong; I may have non-merge fixups confused; but it works).
Change fixup tracing to include whether the fixup is a merge or not.

=============== Diff against VMMaker.oscogSPC-eem.2127 ===============

Item was changed:
  ----- Method: CogBytecodeFixup>>recordBcpc: (in category 'simulation') -----
  recordBcpc: theBytecodePC
  	<inline: true>
  	self cCode: '' inSmalltalk:
+ 		[(bcpc isNil or: [bcpc = theBytecodePC])
+ 			ifTrue: [bcpc := theBytecodePC]
+ 			ifFalse:
- 		[bcpc
- 			ifNil: [bcpc := theBytecodePC]
- 			ifNotNil:
  				[bcpc := bcpc isInteger
  							ifTrue: [{bcpc. theBytecodePC}]
  							ifFalse: [bcpc, {theBytecodePC}]]]!

Item was changed:
  ----- Method: CogObjectRepresentation>>genPrimitiveSmallFloatSquareRoot (in category 'primitive generators') -----
  genPrimitiveSmallFloatSquareRoot
  	<option: #Spur64BitMemoryManager>
+ 	| jumpFailAlloc jumpNegative |
- 	| jumpFailAlloc |
  	<var: #jumpFailAlloc type: #'AbstractInstruction *'>
+ 	<var: #jumpNegative type: #'AbstractInstruction *'>
  	self genGetSmallFloatValueOf: ReceiverResultReg scratch: SendNumArgsReg into: DPFPReg0.
+ 	cogit
+ 		XorRd: DPFPReg1 Rd: DPFPReg1; "+0.0 is all zeros"
+ 		CmpRd: DPFPReg0 Rd: DPFPReg1.
+ 	jumpNegative := cogit JumpFPGreater: 0.
  	cogit SqrtRd: DPFPReg0.
  	jumpFailAlloc := self
  						genAllocFloatValue: DPFPReg0
  						into: SendNumArgsReg
  						scratchReg: ClassReg
  						scratchReg: TempReg.
  	cogit MoveR: SendNumArgsReg R: ReceiverResultReg.
  	cogit genPrimReturn.
+ 	jumpNegative jmpTarget: (jumpFailAlloc jmpTarget: cogit Label).
- 	jumpFailAlloc jmpTarget: cogit Label.
  	^0!

Item was changed:
  ----- Method: CogX64Compiler>>computeMaximumSize (in category 'generate machine code') -----
(excessive size, no diff calculated)

Item was changed:
  ----- Method: CogX64Compiler>>concretizeConvertRRd (in category 'generate machine code') -----
  concretizeConvertRRd
  	"Will get inlined into concretizeAt: switch."
  	<inline: true>
+ 	| srcReg destReg |
- 	| srcReg destReg skip |
  	srcReg := operands at:0.
  	destReg := operands at: 1.
  	machineCode
+ 		at: 0 put: 16rF2;
+ 		at: 1 put: (self rexR: destReg x: 0 b: srcReg);
+ 		at: 2 put: 16r0F;
+ 		at: 3 put: 16r2A;
+ 		at: 4 put: (self mod: ModReg RM: srcReg RO: destReg).
+ 	 ^machineCodeSize := 5!
- 		at: 0 put: 16rF2.
- 	(srcReg <= 7 and: [destReg <= 7])
- 		ifTrue: [skip := 0]
- 		ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: destReg x: 0 b: srcReg)].
- 		
- 	machineCode
- 		at: skip + 1 put: 16r0F;
- 		at: skip + 2 put: 16r2A;
- 		at: skip + 3 put: (self mod: ModReg RM: srcReg RO: destReg).
- 	 ^machineCodeSize := skip + 4!

Item was changed:
  ----- Method: CogX64Compiler>>concretizeConvertRdR (in category 'generate machine code') -----
  concretizeConvertRdR
  	"Will get inlined into concretizeAt: switch."
  	"CVTSD2SI"
  	<inline: true>
+ 	| srcReg destReg |
- 	| srcReg destReg skip |
  	srcReg := operands at:0.
  	destReg := operands at: 1.
  	machineCode
+ 		at: 0 put: 16rF2;
+ 		at: 1 put: (self rexR: destReg x: 0 b: srcReg);
+ 		at: 2 put: 16r0F;
+ 		at: 3 put: 16r2D;
+ 		at: 4 put: (self mod: ModReg RM: srcReg RO: destReg).
+ 	 ^machineCodeSize := 5!
- 		at: 0 put: 16rF2.
- 	(srcReg <= 7 and: [destReg <= 7])
- 		ifTrue: [skip := 0]
- 		ifFalse: [machineCode at: (skip := 1) put: (self rexw: false r: destReg x: 0 b: srcReg)].
- 	
- 	machineCode
- 		at: skip + 1 put: 16r0F;
- 		at: skip + 2 put: 16r2D;
- 		at: skip + 3 put: (self mod: ModReg RM: srcReg RO: destReg).
- 	 ^machineCodeSize := skip + 4!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveArctan (in category 'arithmetic float primitives') -----
  primitiveArctan
+ 	"N.B. IMO we should be able to assume the receiver is a float because this primitive is specific to floats. eem 2/13/2017"
- 
  	| rcvr |
  	<var: #rcvr type: #double>
+ 	rcvr := self stackFloatValue: 0.
+ 	self successful ifTrue:
+ 		[self stackTopPut: (objectMemory floatObjectOf:
+ 								(self cCode: [rcvr atan]
- 	rcvr := self popFloat.
- 	self successful
- 		ifTrue: [self pushFloat: (self cCode: [rcvr atan]
  									inSmalltalk: [rcvr = rcvr
  													ifTrue: [rcvr arcTan]
+ 													ifFalse: [Float nan]]))]!
- 													ifFalse: [Float nan]])]
- 		ifFalse: [self unPop: 1]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveExp (in category 'arithmetic float primitives') -----
  primitiveExp
+ 	"Computes E raised to the receiver power.
+ 	 N.B. IMO we should be able to assume the receiver is a float because this primitive is specific to floats. eem 2/13/2017"
- 	"Computes E raised to the receiver power."
- 
  	| rcvr |
  	<var: #rcvr type: #double>
+ 	rcvr := self stackFloatValue: 0.
+ 	self successful ifTrue:
+ 		[self stackTopPut: (objectMemory floatObjectOf:
+ 								(self cCode: [rcvr exp]
- 	rcvr := self popFloat.
- 	self successful
- 		ifTrue: [self pushFloat: (self cCode: [rcvr exp]
  									inSmalltalk: [rcvr = rcvr
  													ifTrue: [rcvr exp]
+ 													ifFalse: [Float nan]]))]!
- 													ifFalse: [Float nan]])]
- 		ifFalse: [self unPop: 1]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveExponent (in category 'arithmetic float primitives') -----
  primitiveExponent
+ 	"Exponent part of this float.
+ 	 N.B. IMO we should be able to assume the receiver is a float because this primitive is specific to floats. eem 2/13/2017"
+ 	| rcvr pwr |
- 	"Exponent part of this float."
- 
- 	| rcvr frac pwr |
  	<var: #rcvr type: #double>
- 	<var: #frac type: #double>
  	<var: #pwr type: #int>
+ 	rcvr := self stackFloatValue: 0.
+ 	self successful ifTrue:
+ 		["rcvr = frac * 2^pwr, where frac is in [0.5..1.0)"
+ 		 self cCode: [self fr: rcvr exp: (self addressOf: pwr)]
+ 			inSmalltalk: [pwr := rcvr exponent].
+ 		 self stackTopPut: (objectMemory integerObjectOf: pwr - 1)]!
- 	rcvr := self popFloat.
- 	self successful
- 		ifTrue: [  "rcvr = frac * 2^pwr, where frac is in [0.5..1.0)"
- 			self cCode: 'frac = frexp(rcvr, &pwr)'
- 					inSmalltalk: [pwr := rcvr exponent].
- 			self pushInteger: pwr - 1]
- 		ifFalse: [self unPop: 1]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveFractionalPart (in category 'arithmetic float primitives') -----
  primitiveFractionalPart
+ 	"Fractional part of this float.
+ 	 N.B. IMO we should be able to assume the receiver is a float because this primitive is specific to floats. eem 2/13/2017"
+ 	| rcvr trunc |
- 	| rcvr frac trunc |
  	<var: #rcvr type: #double>
- 	<var: #frac type: #double>
  	<var: #trunc type: #double>
+ 	rcvr := self stackFloatValue: 0.
+ 	self successful ifTrue:
+ 		[self stackTopPut: (objectMemory floatObjectOf:
+ 							(self cCode: [self mod: rcvr f: (self addressOf: trunc)]
+ 								inSmalltalk: [rcvr fractionPart]))]!
- 	rcvr := self popFloat.
- 	self successful
- 		ifTrue: [frac := self cCode: [self mod: rcvr f: (self addressOf: trunc)]
- 							inSmalltalk: [rcvr fractionPart].
- 				self pushFloat: frac]
- 		ifFalse: [self unPop: 1]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveLogN (in category 'arithmetic float primitives') -----
  primitiveLogN
+ 	"Natural log.
+ 	 N.B. IMO we should be able to assume the receiver is a float because this primitive is specific to floats. eem 2/13/2017"
- 	"Natural log."
- 
  	| rcvr |
  	<var: #rcvr type: #double>
+ 	rcvr := self stackFloatValue: 0.
+ 	self successful ifTrue:
+ 		[self stackTopPut: (objectMemory floatObjectOf:
+ 								(self cCode: [rcvr log]
- 	rcvr := self popFloat.
- 	self successful
- 		ifTrue: [self pushFloat: (self cCode: [rcvr log]
  									inSmalltalk: [rcvr = rcvr
  													ifTrue: [rcvr ln]
+ 													ifFalse: [Float nan]]))]!
- 													ifFalse: [Float nan]])]
- 		ifFalse: [self unPop: 1]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSine (in category 'arithmetic float primitives') -----
  primitiveSine
+ 	"N.B. IMO we should be able to assume the receiver is a float because this primitive is specific to floats. eem 2/13/2017"
- 
  	| rcvr |
  	<var: #rcvr type: #double>
+ 	rcvr := self stackFloatValue: 0.
+ 	self successful ifTrue:
+ 		[self stackTopPut: (objectMemory floatObjectOf:
+ 								(self cCode: [rcvr sin]
- 	rcvr := self popFloat.
- 	self successful
- 		ifTrue: [self pushFloat: (self cCode: [rcvr sin]
  									inSmalltalk: [rcvr = rcvr
  													ifTrue: [rcvr sin]
+ 													ifFalse: [Float nan]]))]!
- 													ifFalse: [Float nan]])]
- 		ifFalse: [self unPop: 1]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatArctan (in category 'arithmetic float primitives') -----
  primitiveSmallFloatArctan
  	<option: #Spur64BitMemoryManager>
  	| rcvr |
  	<var: #rcvr type: #double>
  	rcvr := objectMemory smallFloatValueOf: self stackTop.
+ 	self stackTopPut: (objectMemory floatObjectOf: (self cCode: [rcvr atan]
+ 														inSmalltalk: [rcvr arcTan]))!
- 	self pop: 1
- 		thenPushFloat: (self cCode: [rcvr atan]
- 							inSmalltalk: [rcvr = rcvr
- 											ifTrue: [rcvr arcTan]
- 											ifFalse: [Float nan]])!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatExp (in category 'arithmetic float primitives') -----
  primitiveSmallFloatExp
  	"Computes E raised to the receiver power.
  	 Since SmallFloats cannot represent NaNs there's no need to special case."
  	<option: #Spur64BitMemoryManager>
  
+ 	self stackTopPut: (objectMemory floatObjectOf: (objectMemory smallFloatValueOf: self stackTop) exp)!
- 	self pop: 1 thenPushFloat: (objectMemory smallFloatValueOf: self stackTop) exp!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatExponent (in category 'arithmetic float primitives') -----
  primitiveSmallFloatExponent
  	"Answer the exponent part of this float."
  	<option: #Spur64BitMemoryManager>
  
+ 	self stackTopPut: (objectMemory integerObjectOf: (objectMemory exponentOfSmallFloat: self stackTop) - 1)!
- 	self pop: 1 thenPushInteger: (objectMemory exponentOfSmallFloat: self stackTop) - 1!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatFractionalPart (in category 'arithmetic float primitives') -----
  primitiveSmallFloatFractionalPart
  	<option: #Spur64BitMemoryManager>
  	| rcvr frac trunc |
  	<var: #rcvr type: #double>
  	<var: #frac type: #double>
  	<var: #trunc type: #double>
  	rcvr := objectMemory smallFloatValueOf: self stackTop.
  	frac := self cCode: [self mod: rcvr f: (self addressOf: trunc)]
  				inSmalltalk: [rcvr fractionPart].
+ 	self stackTopPut: (objectMemory floatObjectOf: frac)!
- 	self pop: 1 thenPushFloat: frac!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatLogN (in category 'arithmetic float primitives') -----
  primitiveSmallFloatLogN
  	"Natural log."
  	<option: #Spur64BitMemoryManager>
  	| rcvr |
  	<var: #rcvr type: #double>
  	rcvr := objectMemory smallFloatValueOf: self stackTop.
+ 	self stackTopPut: (objectMemory floatObjectOf: (self cCode: [rcvr log] inSmalltalk: [rcvr ln]))!
- 	self pop: 1
- 		thenPushFloat: (self cCode: [rcvr log]
- 							inSmalltalk: [rcvr = rcvr
- 											ifTrue: [rcvr ln]
- 											ifFalse: [Float nan]])!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatSine (in category 'arithmetic float primitives') -----
  primitiveSmallFloatSine
  	<option: #Spur64BitMemoryManager>
  	| rcvr |
  	<var: #rcvr type: #double>
  	rcvr := objectMemory smallFloatValueOf: self stackTop.
+ 	self stackTopPut: (objectMemory floatObjectOf: rcvr sin)!
- 	self pop: 1
- 		thenPushFloat: (self cCode: [rcvr sin]
- 							inSmalltalk: [rcvr = rcvr
- 											ifTrue: [rcvr sin]
- 											ifFalse: [Float nan]])!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatSquareRoot (in category 'arithmetic float primitives') -----
  primitiveSmallFloatSquareRoot
  	<option: #Spur64BitMemoryManager>
+ 	| rcvr |
+ 	rcvr := objectMemory smallFloatValueOf: self stackTop.
+ 	rcvr >= 0.0
+ 		ifTrue: [self stackTopPut: (objectMemory floatObjectOf: rcvr sqrt)]
+ 		ifFalse: [self primitiveFail]!
- 
- 	self pop: 1 thenPushFloat: (objectMemory smallFloatValueOf: self stackTop) sqrt!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSmallFloatTruncated (in category 'arithmetic float primitives') -----
  primitiveSmallFloatTruncated
  	<option: #Spur64BitMemoryManager>
  	| rcvr trunc |
  	<var: #rcvr type: #double>
  	<var: #trunc type: #double>
  	rcvr := objectMemory smallFloatValueOf: self stackTop.
  	self cCode: [self mod: rcvr f: (self addressOf: trunc)]
  		inSmalltalk: [trunc := rcvr truncated].
  	(trunc between: objectMemory minSmallInteger asFloat and: objectMemory maxSmallInteger asFloat)
+ 		ifTrue: [self stackTopPut: (objectMemory integerObjectOf: trunc asInteger)]
- 		ifTrue: [self pop: 1 thenPushInteger: trunc asInteger]
  		ifFalse: [self primitiveFail]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveSquareRoot (in category 'arithmetic float primitives') -----
  primitiveSquareRoot
+ 	"N.B. IMO we should be able to assume the receiver is a float because this primitive is specific to floats. eem 2/13/2017"
  	| rcvr |
  	<var: #rcvr type: #double>
+ 	rcvr := self stackFloatValue: 0.
+ 	(self successful and: [rcvr >= 0.0])
+ 		ifTrue: [self stackTopPut: (objectMemory floatObjectOf: rcvr sqrt)]
+ 		ifFalse: [self primitiveFail]!
- 	rcvr := self popFloat.
- 	self success: rcvr >= 0.0.
- 	self successful
- 		ifTrue: [self pushFloat: rcvr sqrt]
- 		ifFalse: [self unPop: 1]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveTruncated (in category 'arithmetic float primitives') -----
+ primitiveTruncated
+ 	"N.B. IMO we should be able to assume the receiver is a float because this primitive is specific to floats. eem 2/13/2017"
- primitiveTruncated 
  	| rcvr trunc |
  	<var: #rcvr type: #double>
  	<var: #trunc type: #double>
+ 	rcvr := self stackFloatValue: 0.
- 	rcvr := self popFloat.
  	self successful ifTrue:
  		[self cCode: [self mod: rcvr f: (self addressOf: trunc)]
+ 			inSmalltalk: [trunc := rcvr = rcvr
+ 									ifTrue: [rcvr truncated]
+ 									ifFalse: [Float nan]].
+ 		 (trunc between: objectMemory minSmallInteger asFloat and: objectMemory maxSmallInteger asFloat)
+ 			ifTrue: [self stackTopPut: (objectMemory integerObjectOf: trunc asInteger)]
+ 			ifFalse: [self primitiveFail]]!
- 			inSmalltalk: [trunc := rcvr truncated].
- 		self success: (trunc between: objectMemory minSmallInteger asFloat and: objectMemory maxSmallInteger asFloat)].
- 	self successful
- 		ifTrue: [self pushInteger: trunc asInteger]
- 		ifFalse: [self unPop: 1]!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>flushLiveRegistersForCRunTimeCall (in category 'bytecode generator support') -----
  flushLiveRegistersForCRunTimeCall
  	"Flush any live registers for a C call, i.e. don't flush caller-saved registers.
  	 Answer if any registers were flushed."
  	<inline: true>
  	| flushed reg |
  	flushed := false.
  	self assert: simSelf type = SSBaseOffset.
  	reg := simSelf liveRegister.
  	(reg ~= NoReg and: [(self isCallerSavedReg: reg)]) ifTrue:
  		[simSelf liveRegister: NoReg.
  		 flushed := true].
  	0 to: simStackPtr do:
  		[:i|
+ 		 self assert: (self simStackAt: i) type = (i < methodOrBlockNumTemps
- 		 self assert: (self simStackAt: i) type = (i <= methodOrBlockNumTemps
  													ifTrue: [SSBaseOffset]
  													ifFalse: [SSSpill]).
  		 reg := (self simStackAt: i) liveRegister.
  		 (reg ~= NoReg and: [(self isCallerSavedReg: reg)]) ifTrue:
  			[(self simStackAt: i) liveRegister: NoReg.
  			 flushed := true]].
  	^flushed!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>flushLiveRegistersForSuspensionPoint (in category 'bytecode generator support') -----
  flushLiveRegistersForSuspensionPoint
  	"Flush any live registers for a C call at a suspension/resumption point, i.e.flush all registers.
  	 Answer if any registers were flushed."
  	<inline: true>
  	| flushed |
  	flushed := false.
  	self assert: simSelf type = SSBaseOffset.
  	simSelf liveRegister ~= NoReg ifTrue:
  		[simSelf liveRegister: NoReg.
  		 flushed := true].
  	0 to: simStackPtr do:
  		[:i|
+ 		 self assert: (self simStackAt: i) type = (i < methodOrBlockNumTemps
- 		 self assert: (self simStackAt: i) type = (i <= methodOrBlockNumTemps
  													ifTrue: [SSBaseOffset]
  													ifFalse: [SSSpill]).
  		 (self simStackAt: i) liveRegister ~= NoReg ifTrue:
  			[(self simStackAt: i) liveRegister: NoReg.
  			 flushed := true]].
  	^flushed!

Item was added:
+ ----- Method: RegisterAllocatingCogit>>flushRegistersOnlyLiveOnFallThrough: (in category 'simulation stack') -----
+ flushRegistersOnlyLiveOnFallThrough: fixup
+ 	"Forward jumps won't generate merge code if the source has a register that is live but the destination does not.
+ 	 For example in
+ 			| v | v := expr1. self expr2 ifTrue: [v := expr3]. ^v
+ 	 v will be assigned to a register in v := expr1 and [v := expr3], but the send of expr2 will flush it along the jumpFalse across [v := expr3].
+ 	 So v will not be in a register if reached from the jump.  Hence at the join at the end of [v := expr3] v must be marked as not being in a register."
+ 	| targetSimStack |
+ 	targetSimStack := fixup mergeSimStack.
+ 	0 to: simStackPtr do:
+ 		[:i| | fallThrough target |
+ 		 fallThrough := self simStack: simStack at: i.
+ 		 target := self simStack: targetSimStack at: i.
+ 		 self assert: (fallThrough liveRegister = target liveRegister or: [target liveRegister = NoReg or: [fallThrough liveRegister = NoReg]]).
+ 		 target liveRegister = NoReg ifTrue:
+ 			[fallThrough liveRegister: NoReg]]!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>genForwardersInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
  genForwardersInlinedIdenticalOrNotIf: orNot
  	| nextPC branchDescriptor unforwardRcvr argReg targetPC
  	  unforwardArg  rcvrReg postBranchPC retry fixup
  	  comparison
  	  needMergeToTarget needMergeToContinue |
  	<var: #branchDescriptor type: #'BytecodeDescriptor *'>
  	<var: #toContinueLabel type: #'AbstractInstruction *'>
  	<var: #toTargetLabel type: #'AbstractInstruction *'>
  	<var: #comparison type: #'AbstractInstruction *'>
  	<var: #retry type: #'AbstractInstruction *'>
  	
  	self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target | 
  		branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetPC := target ].
  
  	"If an operand is an annotable constant, it may be forwarded, so we need to store it into a 
  	register so the forwarder check can jump back to the comparison after unforwarding the constant.
  	However, if one of the operand is an unnanotable constant, does not allocate a register for it 
  	(machine code will use operations on constants) and does not generate forwarder checks."
  	unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.
  	unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.
  
  	self 
  		allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg 
  		rcvrNeedsReg: unforwardRcvr 
  		into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
  
  	"If not followed by a branch, resolve to true or false."
  	(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
  		[^self 
  			genIdenticalNoBranchArgIsConstant: unforwardArg not
  			rcvrIsConstant: unforwardRcvr not
  			argReg: argReg 
  			rcvrReg: rcvrReg 
  			orNotIf: orNot].
  	
  	self assert: (unforwardArg or: [unforwardRcvr]).
  
  	retry := self Label.
  	self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
  	self ssPop: 2.
  
  	(self fixupAt: nextPC) notAFixup "The next instruction is dead.  we can skip it."
  		ifTrue:  [deadCode := true]
  		ifFalse: [self deny: deadCode]. "push dummy value below"
  
  	"self printSimStack; printSimStack: (self fixupAt: postBranchPC) mergeSimStack"
  	"If there are merges to be performed on the forward branches we have to execute
  	 the merge code only along the path requiring that merge, and exactly once."
  	needMergeToTarget := self mergeRequiredForJumpTo: targetPC.
  	needMergeToContinue := self mergeRequiredForJumpTo: postBranchPC.
  	orNot == branchDescriptor isBranchTrue
  		ifFalse: "a == b ifTrue: ... or a ~~ b ifFalse: ... jump on equal to target pc"
  			[fixup := needMergeToContinue
  						ifTrue: [0] "jumps will fall-through to to-continue merge code"
  						ifFalse: [self ensureNonMergeFixupAt: postBranchPC].
  			 comparison := self JumpZero: (needMergeToTarget
  												ifTrue: [0] "comparison will be fixed up to to-target merge code"
  												ifFalse: [self ensureNonMergeFixupAt: targetPC])]
  		ifTrue: "a == b ifFalse: ... or a ~~ b ifTrue: ... jump on equal to post-branch pc"
  			[fixup := needMergeToTarget
  						ifTrue: [0] "jumps will fall-through to to-target merge code"
  						ifFalse: [(self ensureNonMergeFixupAt: targetPC)].
  			 comparison := self JumpZero: (needMergeToContinue
  												ifTrue: [0] "comparison will be fixed up to to-continue merge code"
  												ifFalse: [self ensureNonMergeFixupAt: postBranchPC])].
  
  	"The forwarders check(s) need(s) to jump back to the comparison (retry) if a forwarder is found,
  	 else jump forward either to the next forwarder check or to the postBranch or branch target (fixup).
  	 But if there is merge code along a path, the jump must be to the merge code."
  	(unforwardArg and: [unforwardRcvr]) ifTrue:
  		[objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg jumpBackTo: retry].
  	objectRepresentation 
  		genEnsureOopInRegNotForwarded: (unforwardRcvr ifTrue: [rcvrReg] ifFalse: [argReg]) 
  		scratchReg: TempReg 
  		ifForwarder: retry
  		ifNotForwarder: fixup.
  	"If fixup is zero then the ifNotForwarder path falls through to a Label which is interpreted
  	 as either to-continue or to-target, depending on orNot == branchDescriptor isBranchTrue."
  	orNot == branchDescriptor isBranchTrue
  		ifFalse: "a == b ifTrue: ... or a ~~ b ifFalse: ... jump on equal to target pc"
  			[needMergeToContinue ifTrue: "fall-through to to-continue merge code"
  				[self Jump: (self ensureFixupAt: postBranchPC)].
  			 needMergeToTarget ifTrue: "fixup comparison to to-target merge code"
  				[comparison jmpTarget: self Label.
  				 self Jump: (self ensureFixupAt: targetPC)]]
  		ifTrue: "a == b ifFalse: ... or a ~~ b ifTrue: ... jump on equal to post-branch pc"
  			[needMergeToTarget ifTrue: "fall-through to to-target merge code"
  				[self Jump: (self ensureFixupAt: targetPC)].
  			 needMergeToContinue ifTrue: "fixup comparison to to-continue merge code"
  				[comparison jmpTarget: self Label.
  				 self Jump: (self ensureFixupAt: postBranchPC)]].
  
+ 	deadCode ifFalse: "duplicate the merge fixup's top of stack so as to avoid a false confict."
+ 		[self ssPushDesc: ((self fixupAt: nextPC) mergeSimStack at: simStackPtr + 1)].
- 	deadCode ifFalse:
- 		[self ssPushConstant: objectMemory trueObject]. "dummy value"
  	^0!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>genVanillaInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
  genVanillaInlinedIdenticalOrNotIf: orNot
  	| nextPC postBranchPC targetBytecodePC branchDescriptor
  	  rcvrReg argReg argIsConstant rcvrIsConstant  |
  	<var: #branchDescriptor type: #'BytecodeDescriptor *'>
  	
  	self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target | 
  		branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
  	
  	argIsConstant := self ssTop type = SSConstant.
  	"They can't be both constants to use correct machine opcodes.
  	 However annotable constants can't be resolved statically, hence we need to careful."
  	rcvrIsConstant := argIsConstant not and: [(self ssValue: 1) type = SSConstant].
  	
  	self 
  		allocateEqualsEqualsRegistersArgNeedsReg: argIsConstant not 
  		rcvrNeedsReg: rcvrIsConstant not 
  		into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
  	
  	"If not followed by a branch, resolve to true or false."
  	(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
  		[^ self 
  			genIdenticalNoBranchArgIsConstant: argIsConstant 
  			rcvrIsConstant: rcvrIsConstant 
  			argReg: argReg 
  			rcvrReg: rcvrReg 
  			orNotIf: orNot].
  	
  	self genCmpArgIsConstant: argIsConstant rcvrIsConstant: rcvrIsConstant argReg: argReg rcvrReg: rcvrReg.
  	self ssPop: 2.
  
  	"For now just deny we're in the situation we have yet to implement ;-)"
  	self deny: (self mergeRequiredForJumpTo: targetBytecodePC).
  	self deny: (self mergeRequiredForJumpTo: postBranchPC).
  
  	"Further since there is a following conditional jump bytecode, define
  	 non-merge fixups and leave the cond bytecode to set the mergeness."
  	(self fixupAt: nextPC) notAFixup
  		ifTrue: "The next instruction is dead.  we can skip it."
  			[deadCode := true.
  		 	 self ensureFixupAt: targetBytecodePC.
  			 self ensureFixupAt: postBranchPC]
  		ifFalse:
  			[self deny: deadCode]. "push dummy value below"
  		
  	self genConditionalBranch: (orNot == branchDescriptor isBranchTrue ifTrue: [JumpNonZero] ifFalse: [JumpZero])
  		operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
  
  	"If the branch is dead, then we can just fall through postBranchPC (only a nop in-between), else 
  	we need to jump over the code of the branch"
  	deadCode ifFalse:
  		[self Jump: (self ensureNonMergeFixupAt: postBranchPC).
+ 		 "duplicate the merge fixup's top of stack so as to avoid a false confict."
+ 		 self ssPushDesc: ((self fixupAt: nextPC) mergeSimStack at: simStackPtr + 1)].
+ 
- 		 self ssPushConstant: objectMemory trueObject]. "dummy value"
  	^0!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>mergeWithFixupIfRequired: (in category 'simulation stack') -----
  mergeWithFixupIfRequired: fixup
  	"If this bytecode has a fixup, some kind of merge needs to be done. There are 4 cases:
  		1) the bytecode has no fixup (fixup isNotAFixup)
  			do nothing
  		2) the bytecode has a non merge fixup
  			the fixup has needsNonMergeFixup.
  			The code generating non merge fixup (currently only special selector code) is responsible
  				for the merge so no need to do it.
  			We set deadCode to false as the instruction can be reached from jumps.
  		3) the bytecode has a merge fixup, but execution flow *cannot* fall through to the merge point.
  			the fixup has needsMergeFixup and deadCode = true.
  			ignores the current simStack as it does not mean anything 
  			restores the simStack to the state the jumps to the merge point expects it to be.
  		4) the bytecode has a merge fixup and execution flow *can* fall through to the merge point.
  			the fixup has needsMergeFixup and deadCode = false.
  			flushes the stack to the stack pointer so the fall through execution path simStack is 
  				in the state the merge point expects it to be. 
  			restores the simStack to the state the jumps to the merge point expects it to be.
  			
  	In addition, if this is a backjump merge point, we patch the fixup to hold the current simStackPtr 
+ 	for later assertions. self printSimStack: fixup mergeSimStack"
+ 
- 	for later assertions."
- 	
  	<var: #fixup type: #'BytecodeFixup *'>
  	"case 1"
  	fixup notAFixup ifTrue: [^0].
  
  	"case 2"
  	fixup isNonMergeFixup ifTrue:
+ 		[deadCode
+ 			ifTrue:
+ 				[self deny: fixup simStackPtr isNil.
+ 				 simStackPtr := fixup simStackPtr.
+ 				 self restoreSimStackAtMergePoint: fixup.
+ 				 deadCode := false]
+ 			ifFalse:
+ 				[self flushRegistersOnlyLiveOnFallThrough: fixup].
- 		[deadCode ifTrue:
- 			[self deny: fixup simStackPtr isNil.
- 			 simStackPtr := fixup simStackPtr.
- 			 self restoreSimStackAtMergePoint: fixup.
- 			 deadCode := false].
  		 ^0].
  
  	"cases 3 and 4"
  	self assert: fixup isMergeFixup.
  	self traceMerge: fixup.
  	deadCode 
  		ifTrue: [simStackPtr := fixup simStackPtr] "case 3"
  		ifFalse: [self mergeCurrentSimStackWith: fixup]. "case 4"
  	"cases 3 and 4"
  	deadCode := false.
  	fixup isBackwardBranchFixup ifTrue:
  		[self assert: fixup mergeSimStack isNil.
  		 self setMergeSimStackOf: fixup].
  	fixup targetInstruction: self Label.
  	self assert: simStackPtr = fixup simStackPtr.
  	self cCode: '' inSmalltalk:
  		[self assert: fixup simStackPtr = (self debugStackPointerFor: bytecodePC)].
  	self restoreSimStackAtMergePoint: fixup.
  	
  	^0!

Item was changed:
  ----- Method: StackInterpreter>>shortPrint: (in category 'simulation') -----
  shortPrint: oop
  	<doNotGenerate>
+ 	| name classOop key |
- 	| name classOop |
  	(objectMemory isImmediate: oop) ifTrue:
  		[(objectMemory isImmediateCharacter: oop) ifTrue:
  			[^(objectMemory characterValueOf: oop) < 256
  				ifTrue:
  					['=$', (objectMemory characterValueOf: oop) printString,
  					' ($', (String with: (Character value: (objectMemory characterValueOf: oop))), ')']
  				ifFalse:
  					['=$', (objectMemory characterValueOf: oop) printString, '($???)']].
  		(objectMemory isIntegerObject: oop) ifTrue:
  			[^'=', (objectMemory integerValueOf: oop) printString,
  			' (', (objectMemory integerValueOf: oop) hex, ')'].
  		(objectMemory isImmediateFloat: oop) ifTrue:
  			[^ '=', (objectMemory floatValueOf: oop) printString, ' (', oop hex, ')'].
  		^'= UNKNOWN IMMEDIATE', ' (', (objectMemory integerValueOf: oop) hex, ')'].
  	(objectMemory addressCouldBeObj: oop) ifFalse:
  		[^(oop bitAnd: objectMemory allocationUnit - 1) ~= 0
  			ifTrue: [' is misaligned']
  			ifFalse: [self whereIs: oop]].
  	(objectMemory isFreeObject: oop) ifTrue:
  		[^' is a free chunk of size ', (objectMemory sizeOfFree: oop) printString,
  			(objectMemory hasSpurMemoryManagerAPI
  				ifTrue: [' 0th: ', (objectMemory fetchPointer: 0 ofFreeChunk: oop) hex]
  				ifFalse: [''])].
  	(objectMemory isForwarded: oop) ifTrue:
  		[^' is a forwarded object to ', (objectMemory followForwarded: oop) hex,
  			' of slot size ', (objectMemory numSlotsOfAny: oop) printString].
  	(objectMemory isFloatInstance: oop) ifTrue:
  		[^'=', (objectMemory dbgFloatValueOf: oop) printString].
  	oop = objectMemory nilObject ifTrue:
  		[^'nil'].
  	oop = objectMemory falseObject ifTrue:
  		[^'false'].
  	oop = objectMemory trueObject ifTrue:
  		[^'true'].
  
  	classOop := objectMemory fetchClassOfNonImm: oop.
  	((self objCouldBeClassObj: oop)
  	 and: [(objectMemory numSlotsOf: classOop) = metaclassNumSlots]) ifTrue:
  		[^'class ', (self nameOfClass: oop)].
  	name := self nameOfClass: classOop.
  	name size = 0 ifTrue: [name := '??'].
  	(#('String'  'ByteString') includes: name) ifTrue:
  		[^(self stringOf: oop) printString].
  	(#('Symbol'  'ByteSymbol') includes: name) ifTrue:
  		[^'#', (self stringOf: oop)].
  	name = 'Character' ifTrue: "SpurMemoryManager has immediate Characters (see above); ObjectMemory does not"
  		[^'=', (Character value: (objectMemory integerValueOf: 
  				(objectMemory fetchPointer: 0 ofObject: oop))) printString].
  
  	"Try to spot association-like things; they're all subclasses of LookupKey"
  	((objectMemory isPointersNonImm: oop)
  	 and: [classOop ~= objectMemory nilObject
  	 and: [((objectMemory instanceSizeOf: classOop) between: ValueIndex + 1 and: ValueIndex + 2)
+ 	 and: [(objectMemory addressCouldBeObj: (key := objectMemory fetchPointer: KeyIndex ofObject: oop))
+ 	 and: [(key = objectMemory nilObject and: [self addressCouldBeClassObj: (objectMemory fetchPointer: ValueIndex ofObject: oop)])
+ 		or: [objectMemory isBytesNonImm: key]]]]]) ifTrue:
- 	 and: [(objectMemory addressCouldBeObj: (objectMemory fetchPointer: KeyIndex ofObject: oop))]
- 	 and: [(objectMemory isBytesNonImm: (objectMemory fetchPointer: KeyIndex ofObject: oop))]]]) ifTrue:
  		[| classLookupKey |
  		 classLookupKey := objectMemory fetchClassOfNonImm: (objectMemory splObj: SchedulerAssociation).
  		 [classLookupKey = objectMemory nilObject ifTrue:
  			[^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name].
  		  (objectMemory instanceSizeOf: classLookupKey) = (KeyIndex + 1)] whileFalse:
  			[classLookupKey := self superclassOf: classLookupKey].
+ 		[(objectMemory instanceSizeOf: (self superclassOf: classLookupKey)) = (KeyIndex + 1)] whileTrue:
+ 			[classLookupKey := self superclassOf: classLookupKey].
  		 (self includesBehavior: classOop ThatOf: classLookupKey) ifTrue:
  			[^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name,
  				' ', (self shortPrint: (objectMemory fetchPointer: KeyIndex ofObject: oop)),
  				' -> ',
  				(objectMemory fetchPointer: ValueIndex ofObject: oop) hex8]].
  
  	^(('AEIOU' includes: name first) ifTrue: ['an '] ifFalse: ['a ']), name!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ensureFixupAt: (in category 'compile abstract instructions') -----
  ensureFixupAt: targetPC
  	"Make sure there's a flagged fixup at the target pc in fixups.
  	 Initially a fixup's target is just a flag.  Later on it is replaced with a proper instruction."
  	<returnTypeC: #'BytecodeFixup *'>
  	| fixup |
  	<var: #fixup type: #'BytecodeFixup *'>
  	fixup := self fixupAt:  targetPC.
+ 	self traceFixup: fixup merge: true.
- 	self traceFixup: fixup.
  	self cCode: '' inSmalltalk:
  		[self assert: simStackPtr = (self debugStackPointerFor: targetPC).
  		 (fixup isMergeFixupOrIsFixedUp
  		  and: [fixup isBackwardBranchFixup not]) ifTrue: "ignore backward branch targets"
  			[self assert: fixup simStackPtr = simStackPtr]].
  	fixup isNonMergeFixupOrNotAFixup
  		ifTrue: "convert a non-merge into a merge"
  			[fixup becomeMergeFixup.
  			 fixup simStackPtr: simStackPtr.
  			 LowcodeVM ifTrue: [
  				 fixup simNativeStackPtr: simNativeStackPtr.
  				 fixup simNativeStackSize: simNativeStackSize]]
  		ifFalse:
  			[fixup isBackwardBranchFixup
  				ifTrue: "this is the target of a backward branch and
  						 so doesn't have a simStackPtr assigned yet."
  						[fixup simStackPtr: simStackPtr.
  			 			 LowcodeVM ifTrue:
  				 			[fixup simNativeStackPtr: simNativeStackPtr.
  				 			 fixup simNativeStackSize: simNativeStackSize]]
  				ifFalse:
  					[self assert: fixup simStackPtr = simStackPtr.
  					 LowcodeVM ifTrue:
  				 		[self assert: fixup simNativeStackPtr = simNativeStackPtr.
  		 			 	 self assert: fixup simNativeStackSize = simNativeStackSize]]].
  	fixup recordBcpc: bytecodePC.
  	^fixup!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>ensureNonMergeFixupAt: (in category 'compile abstract instructions') -----
  ensureNonMergeFixupAt: targetPC
  	"Make sure there's a flagged fixup at the target pc in fixups.
  	 Initially a fixup's target is just a flag.  Later on it is replaced with a proper instruction."
  	<returnTypeC: #'BytecodeFixup *'>
  	| fixup |
  	<var: #fixup type: #'BytecodeFixup *'>
  	fixup := self fixupAt:  targetPC.
+ 	self traceFixup: fixup merge: true.
  	fixup notAFixup ifTrue:
  		[fixup becomeNonMergeFixup].
  	self cCode: '' inSmalltalk:
  		[fixup isMergeFixupOrIsFixedUp ifTrue:
  			[self assert:
  					(fixup isBackwardBranchFixup
  					 or: [fixup simStackPtr = (self debugStackPointerFor: targetPC)])]].
  	fixup recordBcpc: bytecodePC.
  	^fixup!

Item was removed:
- ----- Method: StackToRegisterMappingCogit>>traceFixup: (in category 'simulation only') -----
- traceFixup: fixup
- 	<cmacro: '(ign) 0'>
- 	| index |
- 	(compilationTrace anyMask: 32) ifTrue:
- 		[index := (fixups object identityIndexOf: fixup) - 1.
- 		 coInterpreter transcript
- 			ensureCr;
- 			print: bytecodePC; nextPutAll: ' -> '; print: index; nextPut: $/; print: index + initialPC;
- 			nextPut: $:; space.
- 			fixup printStateOn: coInterpreter transcript.
- 			coInterpreter transcript cr; flush]!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>traceFixup:merge: (in category 'simulation only') -----
+ traceFixup: fixup merge: isMerge
+ 	<cmacro: '(igu,ana) 0'>
+ 	| index |
+ 	(compilationTrace anyMask: 32) ifTrue:
+ 		[index := (fixups object identityIndexOf: fixup) - 1.
+ 		 coInterpreter transcript
+ 			ensureCr;
+ 			print: bytecodePC; nextPutAll: ' -> '; print: index; nextPut: $/; print: index + initialPC;
+ 			nextPut: $:; space.
+ 		 isMerge
+ 			ifTrue: [fixup printStateOn: coInterpreter transcript]
+ 			ifFalse: [coInterpreter transcript nextPutAll: 'non-merge'].
+ 		 coInterpreter transcript cr; flush]!



More information about the Vm-dev mailing list