[Vm-dev] VM Maker: VMMaker.oscog-cb.1208.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Apr 17 16:24:12 UTC 2015


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

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

Name: VMMaker.oscog-cb.1208
Author: cb
Time: 17 April 2015, 9:22:27.991 am
UUID: 9111283d-f29a-4d77-8c95-f8150f9358ca
Ancestors: VMMaker.oscog-cb.1207

empty log messageFixed a bug where the JIT would resolve == between two literals that could be becomed.

=============== Diff against VMMaker.oscog-cb.1207 ===============

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>genEnsureOopInRegNotForwarded:scratchReg:jumpBackTo: (in category 'compile abstract instructions') -----
+ genEnsureOopInRegNotForwarded: reg scratchReg: scratch jumpBackTo: instruction
+ 	"Make sure that the oop in reg is not forwarded.  This routine assumes the object will
+ 	 never be forwarded to an immediate, as it is used to unforward  literal variables (associations). 
+ 	 Use the fact that isForwardedObjectClassIndexPun is a power of two to save an instruction."
+ 	| skip ok |
+ 	<var: #ok type: #'AbstractInstruction *'>
+ 	<var: #skip type: #'AbstractInstruction *'>
+ 	<var: #loop type: #'AbstractInstruction *'>
+ 	self assert: reg ~= scratch.
+ 	cogit MoveR: reg R: scratch.
+ 	skip := self genJumpImmediateInScratchReg: scratch.
+ 	"notionally
+ 		self genGetClassIndexOfNonImm: reg into: scratch.
+ 		cogit CmpCq: objectMemory isForwardedObjectClassIndexPun R: TempReg.
+ 	 but the following is an instruction shorter:"
+ 	cogit MoveMw: 0 r: reg R: scratch.
+ 	cogit
+ 		AndCq: objectMemory classIndexMask - objectMemory isForwardedObjectClassIndexPun
+ 		R: scratch.
+ 	ok := cogit JumpNonZero:  0.
+ 	self genLoadSlot: 0 sourceReg: reg destReg: reg.
+ 	cogit Jump: instruction.
+ 	skip jmpTarget: (ok jmpTarget: cogit Label).
+ 	^0!

Item was added:
+ ----- Method: CogObjectRepresentationForSpur>>isUnannotatableConstant: (in category 'compile abstract instructions') -----
+ isUnannotatableConstant: simStackEntry
+ 	<inline: true>
+ 	^ simStackEntry type = SSConstant 
+ 		and: [(self shouldAnnotateObjectReference: simStackEntry constant) not ]!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>genSpecialSelectorEqualsEquals (in category 'bytecode generators') -----
  genSpecialSelectorEqualsEquals
  	"Override to count inlined branches if followed by a conditional branch.
  	 We borrow the following conditional branch's counter and when about to
  	 inline the comparison we decrement the counter (without writing it back)
  	 and if it trips simply abort the inlining, falling back to the normal send which
  	 will then continue to the conditional branch which will trip and enter the abort."
  	| nextPC postBranchPC targetBytecodePC primDescriptor branchDescriptor nExts
  	  counterAddress countTripped unforwardArg unforwardRcvr |
  	<var: #countTripped type: #'AbstractInstruction *'>
  	<var: #primDescriptor type: #'BytecodeDescriptor *'>
  	<var: #branchDescriptor type: #'BytecodeDescriptor *'>
  
+ 	((coInterpreter isOptimizedMethod: methodObj) or: [needsFrame not]) ifTrue: [ ^ super genSpecialSelectorEqualsEquals ].
- 	(coInterpreter isOptimizedMethod: methodObj) ifTrue: [ ^ super genSpecialSelectorEqualsEquals ].
  
  	self ssFlushTo: simStackPtr - 2.
  	primDescriptor := self generatorAt: byte0.
  
  	nextPC := bytecodePC + primDescriptor numBytes.
  	nExts := 0.
  	[branchDescriptor := self generatorAt: (objectMemory fetchByte: nextPC ofObject: methodObj) + (byte0 bitAnd: 256).
  	 branchDescriptor isExtension] whileTrue:
  		[nExts := nExts + 1.
  		 nextPC := nextPC + branchDescriptor numBytes].
  	"Only interested in inlining if followed by a conditional branch."
  	(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
  		[^self genSpecialSelectorSend].
  
  	targetBytecodePC := nextPC
  							+ branchDescriptor numBytes
  							+ (self spanFor: branchDescriptor at: nextPC exts: nExts in: methodObj).
  	postBranchPC := nextPC + branchDescriptor numBytes.
  	unforwardRcvr := (self ssValue: 1) type ~= SSConstant
  						or: [objectRepresentation shouldAnnotateObjectReference: (self ssValue: 1) constant].
  	unforwardArg := self ssTop type ~= SSConstant
  						or: [objectRepresentation shouldAnnotateObjectReference: self ssTop constant].
  	self marshallSendArguments: 1.
  
  	self ssAllocateRequiredReg: SendNumArgsReg. "Use this as the count reg."
  	counterAddress := counters + ((self sizeof: #sqInt) * counterIndex).
  	self flag: 'will need to use MoveAw32:R: if 64 bits'.
  	self assert: objectMemory wordSize = CounterBytes.
  	self MoveAw: counterAddress R: SendNumArgsReg.
  	self SubCq: 16r10000 R: SendNumArgsReg. "Count executed"
  	"If counter trips simply abort the inlined comparison and send continuing to the following
  	 branch *without* writing back.  A double decrement will not trip the second time."
  	countTripped := self JumpCarry: 0.
  	self MoveR: SendNumArgsReg Aw: counterAddress. "write back"
  	unforwardRcvr ifTrue:
  		[objectRepresentation genEnsureOopInRegNotForwarded: ReceiverResultReg scratchReg: TempReg].
  	unforwardArg ifTrue:
  		[objectRepresentation genEnsureOopInRegNotForwarded: Arg0Reg scratchReg: TempReg].
  	self CmpR: Arg0Reg R: ReceiverResultReg.
  	"Cmp is weird/backwards so invert the comparison.  Further since there is a following conditional
  	 jump bytecode define non-merge fixups and leave the cond bytecode to set the mergeness."
  	self gen: (branchDescriptor isBranchTrue ifTrue: [JumpZero] ifFalse: [JumpNonZero])
  		operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
  	self SubCq: 1 R: SendNumArgsReg. "Count untaken"
  	self MoveR: SendNumArgsReg Aw: counterAddress. "write back"
  	self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC).
  	countTripped jmpTarget: self Label.
  	^self genMarshalledSend: (coInterpreter specialSelector: byte0 - self firstSpecialSelectorBytecodeOffset)
  		numArgs: 1
  		sendTable: ordinarySendTrampolines!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genSpecialSelectorEqualsEquals (in category 'bytecode generators') -----
  genSpecialSelectorEqualsEquals
  	| nextPC postBranchPC targetBytecodePC primDescriptor branchDescriptor nExts
  	  unforwardArg unforwardRcvr jumpEqual jumpNotEqual rcvrReg argReg result |
  	<var: #jumpEqual type: #'AbstractInstruction *'>
  	<var: #jumpNotEqual type: #'AbstractInstruction *'>
  	<var: #primDescriptor type: #'BytecodeDescriptor *'>
  	<var: #branchDescriptor type: #'BytecodeDescriptor *'>
  	primDescriptor := self generatorAt: byte0.
  	"forwarders have been followed in cog:selector:"
+ 	((objectRepresentation isUnannotatableConstant: self ssTop)
+ 		and: [ objectRepresentation isUnannotatableConstant: (self ssValue: 1) ]) ifTrue:
- 	(self ssTop type = SSConstant
- 	 and: [(self ssValue: 1) type = SSConstant]) ifTrue:
  		[self assert: primDescriptor isMapped not.
  		 result := self ssTop constant = (self ssValue: 1) constant
  									ifTrue: [objectMemory trueObject]
  									ifFalse: [objectMemory falseObject].
  		 self ssPop: 2.
  		 ^self ssPushConstant: result].
  
  	nextPC := bytecodePC + primDescriptor numBytes.
  	nExts := 0.
  	[branchDescriptor := self generatorAt: (objectMemory fetchByte: nextPC ofObject: methodObj) + (byte0 bitAnd: 256).
  	 branchDescriptor isExtension] whileTrue:
  		[nExts := nExts + 1.
  		 nextPC := nextPC + branchDescriptor numBytes].
  	"If branching the stack must be flushed for the merge"
  	(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifTrue:
  		[self ssFlushTo: simStackPtr - 2].
  
+ 	unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.
+ 	unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.
- 	unforwardRcvr := (self ssValue: 1) type ~= SSConstant
- 						or: [objectRepresentation shouldAnnotateObjectReference: (self ssValue: 1) constant].
- 	unforwardArg := self ssTop type ~= SSConstant
- 						or: [objectRepresentation shouldAnnotateObjectReference: self ssTop constant].
  
  	"Don't use ReceiverResultReg for receiver to keep ReceiverResultReg live.
  	 Optimize e.g. rcvr == nil, the common case for ifNil: et al."
  	needsFrame
  		ifTrue: 
  			[unforwardArg ifTrue:
  				[self ssAllocateRequiredReg: (argReg := Arg0Reg) upThrough: simStackPtr - 1].
  			 self ssAllocateRequiredReg: (rcvrReg := Arg1Reg) upThrough: simStackPtr - 2]
  		ifFalse:
  			[unforwardArg ifTrue:
  				[argReg := self ssAllocatePreferredReg: ClassReg].
  			 rcvrReg := self ssAllocatePreferredReg: SendNumArgsReg].
  	unforwardArg
  		ifTrue:
  			[self ssTop popToReg: argReg.
  			 objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg.
  			 (self ssValue: 1) popToReg: rcvrReg.
  			 unforwardRcvr ifTrue:
  				[objectRepresentation genEnsureOopInRegNotForwarded: rcvrReg scratchReg: TempReg].
  			 self CmpR: argReg R: rcvrReg]
  		ifFalse:
  			[(self ssValue: 1) popToReg: rcvrReg.
  			 unforwardRcvr ifTrue:
  				[objectRepresentation genEnsureOopInRegNotForwarded: rcvrReg scratchReg: TempReg].
  			 self CmpCq: self ssTop constant R: rcvrReg].
  	self ssPop: 2.
  
  	"If not followed by a branch, resolve to true or false."
  	(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
  		[jumpNotEqual := self JumpNonZero: 0.
  		 self annotate: (self MoveCw: objectMemory trueObject R: rcvrReg)
  			objRef: objectMemory trueObject.
  		 jumpEqual := self Jump: 0.
  		 jumpNotEqual jmpTarget: (self annotate: (self MoveCw: objectMemory falseObject R: rcvrReg)
  										objRef: objectMemory falseObject).
  		 jumpEqual jmpTarget: self Label.
  		 self ssPushRegister: rcvrReg.
  		 ^0].
  
  	"Further since there is a following conditional jump bytecode, define
  	 non-merge fixups and leave the cond bytecode to set the mergeness."
  	targetBytecodePC := nextPC
  							+ branchDescriptor numBytes
  							+ (self spanFor: branchDescriptor at: nextPC exts: nExts in: methodObj).
  	postBranchPC := nextPC + branchDescriptor numBytes.
  	(self fixupAt: nextPC - initialPC) targetInstruction = 0
  		ifTrue: "The next instruction is dead.  we can skip it."
  			[deadCode := true.
  		 	 self ensureFixupAt: targetBytecodePC - initialPC.
  			 self ensureFixupAt: postBranchPC - initialPC]
  		ifFalse:
  			[self ssPushConstant: objectMemory trueObject]. "dummy value"
  	self gen: (branchDescriptor isBranchTrue ifTrue: [JumpZero] ifFalse: [JumpNonZero])
  		operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
  		deadCode ifFalse: [self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC)].
  	^0!



More information about the Vm-dev mailing list