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

commits at source.squeak.org commits at source.squeak.org
Sun Apr 26 15:52:37 UTC 2015


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

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

Name: VMMaker.oscog-cb.1258
Author: cb
Time: 26 April 2015, 5:50:58.72 pm
UUID: db02f249-b7aa-4d3d-bd32-d6660ca3bee4
Ancestors: VMMaker.oscog-cb.1257

I removed a few methods in register allocation because there were too many indirection it was too hard to debug.

I fixed the counter logic which was definitely crashing when the trampoline was used with a caller saved register for counters. I added #allocateRegPreferringCalleeSavedNotConflictingWith: to allocate a callee saved reg for counters if possible.

The sistaCogit still does not start but I'm closer and closer...

Added a few comments in register allocation.

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

Item was added:
+ ----- Method: SistaStackToRegisterMappingCogit>>allocateRegPreferringCalleeSavedNotConflictingWith: (in category 'simulation stack') -----
+ allocateRegPreferringCalleeSavedNotConflictingWith: regMask
+ 	"If there are multiple free registers, choose one which is callee saved,
+ 	else just allocate a register not conflicting with regMask"
+ 	| reg |
+ 	reg := backEnd availableRegisterOrNilFor: ((self liveRegisters bitOr: regMask) bitOr: callerSavedRegMask).
+ 	^ reg
+ 		ifNil: [ self allocateRegNotConflictingWith: regMask ]
+ 		ifNotNil: [ reg ]!

Item was added:
+ ----- Method: SistaStackToRegisterMappingCogit>>genExecutionCountLogicInto:counterReg: (in category 'bytecode generator support') -----
+ genExecutionCountLogicInto: binaryBlock counterReg: counterReg
+ 	<var: #countTripped type: #'AbstractInstruction *'>
+ 	<inline: true>
+ 	| counterAddress countTripped |
+ 	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: counterReg.
+ 	self SubCq: 16r10000 R: counterReg. "Count executed"
+ 	"If counter trips simply abort the comparison continuing to the following
+ 	 branch *without* writing back.  A double decrement will not trip the second time."
+ 	countTripped := self JumpCarry: 0.
+ 	self MoveR: counterReg Aw: counterAddress. "write back"
+ 	binaryBlock value: counterAddress value: countTripped!

Item was removed:
- ----- Method: SistaStackToRegisterMappingCogit>>genExecutionCountLogicInto:counterRegNotConflictingWith: (in category 'bytecode generator support') -----
- genExecutionCountLogicInto: trinaryBlock counterRegNotConflictingWith: regMask
- 	<var: #countTripped type: #'AbstractInstruction *'>
- 	<inline: true>
- 	| counterReg counterAddress countTripped |
- 	counterReg := self allocateRegNotConflictingWith: regMask.
- 	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: counterReg.
- 	self SubCq: 16r10000 R: counterReg. "Count executed"
- 	"If counter trips simply abort the comparison continuing to the following
- 	 branch *without* writing back.  A double decrement will not trip the second time."
- 	countTripped := self JumpCarry: 0.
- 	self MoveR: counterReg Aw: counterAddress. "write back"
- 	trinaryBlock value: counterReg value: counterAddress value: countTripped!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>genExtJumpIfNotInstanceOfBehaviorsOrPopBytecode (in category 'bytecode generators') -----
  genExtJumpIfNotInstanceOfBehaviorsOrPopBytecode
  	"SistaV1: *	254		11111110	kkkkkkkk	jjjjjjjj		branch If Not Instance Of Behavior/Array Of Behavior kkkkkkkk (+ Extend A * 256, where Extend A >= 0) distance jjjjjjjj (+ Extend B * 256, where Extend B >= 0)"
  								
  	| reg literal distance targetFixUp |
  	
  	"We loose the information of in which register is stack top 
  	when jitting the branch target so we need to flush everything. 
  	We could use a fixed register here...."
+ 	reg := self self allocateRegForStackEntryAt: 0.
- 	self ssFlushTo: simStackPtr.
- 	reg := self allocateRegForStackTopEntry.
  	self ssTop popToReg: reg.
+ 	self ssFlushTo: simStackPtr. "flushed but the value is still in reg"
  	
  	literal := self getLiteral: (extA * 256 + byte1).
  	extA := 0.
  	distance := extB * 256 + byte2.
  	extB := 0.
  	
  	targetFixUp := (self ensureFixupAt: bytecodePC + 3 + distance - initialPC) asUnsignedInteger.
  		
  	(objectMemory isArrayNonImm: literal)
  		ifTrue: [objectRepresentation branchIf: reg notInstanceOfBehaviors: literal target: targetFixUp]
  		ifFalse: [objectRepresentation branchIf: reg notInstanceOfBehavior: literal target: targetFixUp].
  						
  	self genPopStackBytecode.
  	
  	^0!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>genJumpIf:to: (in category 'bytecode generator support') -----
  genJumpIf: boolean to: targetBytecodePC
  	"The heart of performance counting in Sista.  Conditional branches are 6 times less
  	 frequent than sends and can provide basic block frequencies (send counters can't).
  	 Each conditional has a 32-bit counter split into an upper 16 bits counting executions
  	 and a lower half counting untaken executions of the branch.  Executing the branch
  	 decrements the upper half, tripping if the count goes negative.  Not taking the branch
  	 decrements the lower half.  N.B. We *do not* eliminate dead branches (true ifTrue:/true ifFalse:)
  	 so that scanning for send and branch data is simplified and that branch data is correct."
  	<inline: false>
  	| desc ok counterAddress countTripped retry counterReg |
  	<var: #ok type: #'AbstractInstruction *'>
  	<var: #desc type: #'CogSimStackEntry *'>
  	<var: #retry type: #'AbstractInstruction *'>
  	<var: #countTripped type: #'AbstractInstruction *'>
  
  	(coInterpreter isOptimizedMethod: methodObj) ifTrue: [ ^ super genJumpIf: boolean to: targetBytecodePC ].
  
  	self ssFlushTo: simStackPtr - 1.
  	desc := self ssTop.
  	self ssPop: 1.
  	desc popToReg: TempReg.
  	
+ 	"We prefer calleeSaved to avoid saving it across the trap trip trampoline"
+ 	counterReg := self allocateRegPreferringCalleeSavedNotConflictingWith: 0. 
+ 	retry := self Label.
  	self 
+ 		genExecutionCountLogicInto: [ :cAddress :countTripBranch | 
- 		genExecutionCountLogicInto: [ :cReg :cAddress :countTripBranch | 
- 			counterReg := cReg. 
  			counterAddress := cAddress. 
  			countTripped := countTripBranch ] 
+ 		counterReg: counterReg.
- 		counterRegNotConflictingWith: 0.
  	counterIndex := counterIndex + 1.
  	
- 	retry := self Label.
- 
  	"Cunning trick by LPD.  If true and false are contiguous subtract the smaller.
  	 Correct result is either 0 or the distance between them.  If result is not 0 or
  	 their distance send mustBeBoolean."
  	self assert: (objectMemory objectAfter: objectMemory falseObject) = objectMemory trueObject.
  	self annotate: (self SubCw: boolean R: TempReg) objRef: boolean.
  	self JumpZero: (self ensureFixupAt: targetBytecodePC - initialPC).
  
  	self genFallsThroughCountLogicCounterReg: counterReg counterAddress: counterAddress.
  
  	self CmpCq: (boolean == objectMemory falseObject
  					ifTrue: [objectMemory trueObject - objectMemory falseObject]
  					ifFalse: [objectMemory falseObject - objectMemory trueObject])
  		R: TempReg.
  	ok := self JumpZero: 0.
  	self MoveCq: 0 R: counterReg. "if counterReg is 0 this is a mustBeBoolean, not a counter trip."
+ 	
+ 	"If counterReg is caller saved then save it"
+ 	(self register: counterReg isInMask: callerSavedRegMask) ifTrue: [ self PushR: counterReg ].
+ 	
  	countTripped jmpTarget:
  		(self CallRT: (boolean == objectMemory falseObject
  						ifTrue: [ceSendMustBeBooleanAddFalseTrampoline]
  						ifFalse: [ceSendMustBeBooleanAddTrueTrampoline])).
+ 						
  	"If we're in an image which hasn't got the Sista code loaded then the ceCounterTripped:
  	 trampoline will return directly to machine code, returning the boolean.  So the code should
  	 jump back to the retry point. The trampoline makes sure that TempReg has been reloaded."
  	self annotateBytecode: self Label.
+ 	
+ 	"If counterReg is caller saved then restore it"
+ 	(self register: counterReg isInMask: callerSavedRegMask) ifTrue: [ self PopR: counterReg ].
+ 	
  	self Jump: retry.
  	ok jmpTarget: self Label.
  	^0!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>genSpecialSelectorComparison (in category 'bytecode generators') -----
  genSpecialSelectorComparison
  	"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
  	  rcvrIsInt argIsInt rcvrInt argInt result jumpNotSmallInts inlineCAB annotateInst
  	  counterAddress countTripped counterReg |
  	<var: #countTripped type: #'AbstractInstruction *'>
  	<var: #primDescriptor type: #'BytecodeDescriptor *'>
  	<var: #jumpNotSmallInts type: #'AbstractInstruction *'>
  	<var: #branchDescriptor type: #'BytecodeDescriptor *'>
  
  	(coInterpreter isOptimizedMethod: methodObj) ifTrue: [ ^ super genSpecialSelectorComparison ].
  
  	self ssFlushTo: simStackPtr - 2.
  	primDescriptor := self generatorAt: byte0.
  	argIsInt := self ssTop type = SSConstant
  				 and: [objectMemory isIntegerObject: (argInt := self ssTop constant)].
  	rcvrIsInt := (self ssValue: 1) type = SSConstant
  				 and: [objectMemory isIntegerObject: (rcvrInt := (self ssValue: 1) constant)].
  
  	"short-cut the jump if operands are SmallInteger constants."
  	(argIsInt and: [rcvrIsInt]) ifTrue:
  		[self cCode: '' inSmalltalk: "In Simulator ints are unsigned..."
  				[rcvrInt := objectMemory integerValueOf: rcvrInt.
  				argInt := objectMemory integerValueOf: argInt].
  		 primDescriptor opcode caseOf: {
  			[JumpLess]				-> [result := rcvrInt < argInt].
  			[JumpLessOrEqual]		-> [result := rcvrInt <= argInt].
  			[JumpGreater]			-> [result := rcvrInt > argInt].
  			[JumpGreaterOrEqual]	-> [result := rcvrInt >= argInt].
  			[JumpZero]				-> [result := rcvrInt = argInt].
  			[JumpNonZero]			-> [result := rcvrInt ~= argInt] }.
  		 "Must enter any annotatedConstants into the map"
  		 self annotateBytecodeIfAnnotated: (self ssValue: 1).
  		 self annotateBytecodeIfAnnotated: self ssTop.
  		 "Must annotate the bytecode for correct pc mapping."
  		 self ssPop: 2.
  		 ^self ssPushAnnotatedConstant: (result
  											ifTrue: [objectMemory trueObject]
  											ifFalse: [objectMemory falseObject])].
  
  	self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target | 
  		branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
  	
  	"Only interested in inlining if followed by a conditional branch."
  	inlineCAB := branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse].
  	"Further, only interested in inlining = and ~= if there's a SmallInteger constant involved.
  	 The relational operators successfully statically predict SmallIntegers; the equality operators do not."
  	(inlineCAB and: [primDescriptor opcode = JumpZero or: [primDescriptor opcode = JumpNonZero]]) ifTrue:
  		[inlineCAB := argIsInt or: [rcvrIsInt]].
  	inlineCAB ifFalse:
  		[^self genSpecialSelectorSend].
  
  	argIsInt
  		ifTrue:
  			[(self ssValue: 1) popToReg: ReceiverResultReg.
  			 annotateInst := self ssTop annotateUse.
  			 self ssPop: 2.
  			 self MoveR: ReceiverResultReg R: TempReg]
  		ifFalse:
  			[self marshallSendArguments: 1.
  			 self MoveR: Arg0Reg R: TempReg.
  			 rcvrIsInt ifFalse:
  				[objectRepresentation isSmallIntegerTagNonZero
  					ifTrue: [self AndR: ReceiverResultReg R: TempReg]
  					ifFalse: [self OrR: ReceiverResultReg R: TempReg]]].
  	jumpNotSmallInts := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  
+ 	counterReg := self allocateRegNotConflictingWith: (self registerMaskFor: ReceiverResultReg and: Arg0Reg).
  	self 
+ 		genExecutionCountLogicInto: [ :cAddress :countTripBranch | 
- 		genExecutionCountLogicInto: [ :cReg :cAddress :countTripBranch | 
- 			counterReg := cReg. 
  			counterAddress := cAddress. 
  			countTripped := countTripBranch ] 
+ 		counterReg: counterReg.
- 		counterRegNotConflictingWith: (self registerMaskFor: ReceiverResultReg and: Arg0Reg).
  
  	argIsInt
  		ifTrue: [annotateInst
  					ifTrue: [self annotateBytecode: (self CmpCq: argInt R: ReceiverResultReg)]
  					ifFalse: [self CmpCq: argInt R: ReceiverResultReg]]
  		ifFalse: [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: [primDescriptor opcode]
  				ifFalse: [self inverseBranchFor: primDescriptor opcode])
  		operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
  		
  	self genFallsThroughCountLogicCounterReg: counterReg counterAddress: counterAddress.
  	
  	self Jump: (self ensureNonMergeFixupAt: postBranchPC - initialPC).
  	countTripped jmpTarget: (jumpNotSmallInts jmpTarget: self Label).
  	
  	argIsInt ifTrue:
  		[self MoveCq: argInt R: Arg0Reg].
  	^self genMarshalledSend: (coInterpreter specialSelector: byte0 - self firstSpecialSelectorBytecodeOffset)
  		numArgs: 1
  		sendTable: ordinarySendTrampolines!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>genSpecialSelectorEqualsEqualsWithForwarders (in category 'bytecode generators') -----
  genSpecialSelectorEqualsEqualsWithForwarders
  	"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 branchDescriptor label counterReg fixup
  	  counterAddress countTripped unforwardArg unforwardRcvr argReg rcvrReg regMask |
  	<var: #fixup type: #'BytecodeFixup *'>
  	<var: #countTripped type: #'AbstractInstruction *'>
  	<var: #primDescriptor type: #'BytecodeDescriptor *'>
  	<var: #branchDescriptor type: #'BytecodeDescriptor *'>
  
  	((coInterpreter isOptimizedMethod: methodObj) or: [needsFrame not]) ifTrue: [ ^ super genSpecialSelectorEqualsEquals ].
  
  	regMask := 0.
  	
  	self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target | 
  		branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
  	
  	unforwardRcvr := (objectRepresentation isUnannotatableConstant: (self ssValue: 1)) not.
  	unforwardArg := (objectRepresentation isUnannotatableConstant: self ssTop) not.
  	
  	"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)."
  	self 
  		allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg 
  		rcvrNeedsReg: unforwardRcvr 
  		into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
  		
  	argReg ifNotNil: [ regMask := self registerMaskFor: argReg ].
  	rcvrReg ifNotNil: [ regMask := regMask bitOr: (self registerMaskFor: rcvrReg) ].
  	
  	"Only interested in inlining if followed by a conditional branch."
  	(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
  		[^ self genEqualsEqualsNoBranchArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg].
  	
+ 	counterReg := self allocateRegNotConflictingWith: regMask.
  	self 
+ 		genExecutionCountLogicInto: [ :cAddress :countTripBranch | 
- 		genExecutionCountLogicInto: [ :cReg :cAddress :countTripBranch | 
- 			counterReg := cReg. 
  			counterAddress := cAddress. 
  			countTripped := countTripBranch ] 
+ 		counterReg: counterReg.
- 		counterRegNotConflictingWith: regMask.
  	
  	self assert: (unforwardArg or: [ unforwardRcvr ]).
  	
  	"If branching the stack must be flushed for the merge"
  	self ssFlushTo: simStackPtr - 2.
  	
  	label := self Label.
  	
  	self genEqualsEqualsComparisonArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
  	
  	self ssPop: 2. "pop by 2 temporarily  for the fixups"
  	branchDescriptor isBranchTrue 
  		ifTrue: 
  			[ fixup := self ensureNonMergeFixupAt: postBranchPC - initialPC.
  			self JumpZero: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger. ]
  		ifFalse: 
  			[ fixup := self ensureNonMergeFixupAt: targetBytecodePC - initialPC.
  			self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger. ].
  	unforwardArg ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg jumpBackTo: label  ].
  	unforwardRcvr ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: rcvrReg scratchReg: TempReg jumpBackTo: label ].
  	self ssPop: -2. 
  	
  	self genFallsThroughCountLogicCounterReg: counterReg counterAddress: counterAddress.
  	self Jump: fixup.
  	countTripped jmpTarget: self Label.
  	
  	"inlined version of #== ignoring the branchDescriptor if the counter trips to have normal state for the optimizer"
  	self genEqualsEqualsNoBranchArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
  	^ 0!

Item was removed:
- ----- Method: StackToRegisterMappingCogit>>allocateAnyReg (in category 'simulation stack') -----
- allocateAnyReg
- 	< inline: true >
- 	^ self allocateRegNotConflictingWith: 0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>allocateEqualsEqualsRegistersArgNeedsReg:rcvrNeedsReg:into: (in category 'bytecode generator support') -----
  allocateEqualsEqualsRegistersArgNeedsReg: argNeedsReg rcvrNeedsReg: rcvrNeedsReg into: binaryBlock
  	<inline: true>
  	| argReg rcvrReg |
  	self assert: (argNeedsReg or: [rcvrNeedsReg]).
  	argNeedsReg
  		ifTrue: 
  			[rcvrNeedsReg
  				ifTrue:
  					[self allocateRegForStackTopTwoEntriesInto: [:rTop :rNext| argReg := rTop. rcvrReg := rNext].
  					 self ssTop popToReg: argReg.
  					 (self ssValue: 1) popToReg: rcvrReg]
  				ifFalse:
+ 					[argReg := self self allocateRegForStackEntryAt: 0.
- 					[argReg := self allocateRegForStackTopEntry.
  					 self ssTop popToReg: argReg]]
  		ifFalse:
  			[self assert: rcvrNeedsReg.
  			rcvrReg := self allocateRegForStackEntryAt: 1.
  			(self ssValue:1) popToReg: rcvrReg].
  		
  	self assert: (argNeedsReg not or: [argReg notNil]).
  	self assert: (rcvrNeedsReg not or: [rcvrReg notNil]).
  	
  	binaryBlock value: rcvrReg value: argReg.!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>allocateRegForStackEntryAt: (in category 'simulation stack') -----
  allocateRegForStackEntryAt: index
+ 	"If the stack entry is already in a register, answers it,
+ 	else allocate a new register for it"
  	<inline: true>
  	^ self allocateRegForStackEntryAt: index notConflictingWith: 0
  	!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>allocateRegForStackEntryAt:notConflictingWith: (in category 'simulation stack') -----
  allocateRegForStackEntryAt: index notConflictingWith: regMask
+ 	"If the stack entry is already in a register not conflicting with regMask, answers it,
+ 	else allocate a new register not conflicting with reg mask"
  	<var: #stackEntry type: #'CogSimStackEntry *'>
  	| stackEntry |
  	stackEntry := self ssValue: index.
  	(stackEntry type = SSRegister and: [ (self register: stackEntry register isInMask: regMask) not ]) ifTrue: 
  		[ ^ stackEntry register].
  	^ self allocateRegNotConflictingWith: regMask
  	!

Item was removed:
- ----- Method: StackToRegisterMappingCogit>>allocateRegForStackTopEntry (in category 'simulation stack') -----
- allocateRegForStackTopEntry
- 	<inline: true>
- 	^ self allocateRegForStackEntryAt: 0
- 	!

Item was removed:
- ----- Method: StackToRegisterMappingCogit>>allocateRegForStackTopEntryNotConflictingWith: (in category 'simulation stack') -----
- allocateRegForStackTopEntryNotConflictingWith: regMask	
- 	<inline: true>
- 	^ self allocateRegForStackEntryAt: 0 notConflictingWith: regMask
- 	!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>allocateRegForStackTopThreeEntriesInto:thirdIsReceiver: (in category 'simulation stack') -----
  allocateRegForStackTopThreeEntriesInto: trinaryBlock thirdIsReceiver: thirdIsReceiver
+ 	"Answers registers for the 3 top values on stack. If the values are already in registers, answers
+ 	these registers, else allocate registers not conflicting with each others.
+ 	If thirdIsReceiver is true, allocate ReceiverResultReg for stackTop - 2 (for ceStoreCheck)."
  	<inline: true>
  	| topRegistersMask rTop rNext rThird |
  	
  	topRegistersMask := 0.
  	
  	(self ssTop type = SSRegister and: [ thirdIsReceiver not or: [ self ssTop register ~= ReceiverResultReg ] ]) ifTrue: 
  		[ topRegistersMask := self registerMaskFor: (rTop := self ssTop register)].
  	((self ssValue: 1) type = SSRegister and: [ thirdIsReceiver not or: [ (self ssValue: 1) register ~= ReceiverResultReg ] ]) ifTrue: 
  		[ topRegistersMask := topRegistersMask bitOr: (self registerMaskFor: (rNext := (self ssValue: 1) register))].
  	((self ssValue: 2) type = SSRegister and: [thirdIsReceiver not or: [ (self ssValue: 2) register = ReceiverResultReg ] ]) ifTrue: 
  		[ topRegistersMask := topRegistersMask bitOr: (self registerMaskFor: (rThird := (self ssValue: 2) register))].
  	
  	rThird ifNil: 
  		[ thirdIsReceiver 
  			ifTrue:
  				[ rThird := ReceiverResultReg.  "Free ReceiverResultReg if it was not free"
  				self ssAllocateRequiredReg: ReceiverResultReg.
  				optStatus isReceiverResultRegLive: false ]
  			ifFalse: [ rThird := self allocateRegNotConflictingWith: topRegistersMask ].
  		topRegistersMask := topRegistersMask bitOr: (self registerMaskFor: rThird) ].
  	
  	rTop ifNil: [ 
  		rTop := self allocateRegNotConflictingWith: topRegistersMask.
  		topRegistersMask := topRegistersMask bitOr: (self registerMaskFor: rTop) ].
  	
  	rNext ifNil: [ rNext := self allocateRegNotConflictingWith: topRegistersMask ].
  	
  	^ trinaryBlock value: rTop value: rNext value: rThird
  	
  	!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>allocateRegForStackTopTwoEntriesInto: (in category 'simulation stack') -----
  allocateRegForStackTopTwoEntriesInto: binaryBlock
+ 	"Answers registers for the 2 top values on stack. If the values are already in registers, answers
+ 	these registers, else allocate registers not conflicting with each others."
  	<inline: true>
  	| topRegistersMask rTop rNext |
  	
  	topRegistersMask := 0.
  	
  	self ssTop type = SSRegister ifTrue: 
  		[ rTop := self ssTop register].
  	(self ssValue: 1) type = SSRegister ifTrue: 
  		[ topRegistersMask := self registerMaskFor: (rNext := (self ssValue: 1) register)].
  	
  	rTop ifNil: [ rTop := self allocateRegNotConflictingWith: topRegistersMask ].
  	
  	rNext ifNil: [ rNext := self allocateRegNotConflictingWith: (self registerMaskFor: rTop) ].
  	
  	^ binaryBlock value: rTop value: rNext
  	
  	!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genBinaryConstOpVarInlinePrimitive: (in category 'inline primitive generators') -----
  genBinaryConstOpVarInlinePrimitive: prim
  	"Const op var version of binary inline primitives."
  	"SistaV1: 248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
  	 See EncoderForSistaV1's class comment and StackInterpreter>>#binaryInlinePrimitive:"
  	| ra val untaggedVal adjust |
+ 	ra := self self allocateRegForStackEntryAt: 0.
- 	ra := self allocateRegForStackTopEntry.
  	self ssTop popToReg: ra.
  	self ssPop: 1.
  	val := self ssTop constant.
  	self ssPop: 1.
  	untaggedVal := val - objectMemory smallIntegerTag.
  	prim caseOf: {
  		"0 through 6, +, -, *, /, //, \\, quo:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  		[0]	->	[self AddCq: untaggedVal R: ra].
  		[1]	->	[self MoveCq: val R: TempReg.
  				 self SubR: ra R: TempReg.
  				 objectRepresentation genAddSmallIntegerTagsTo: TempReg.
  				 self MoveR: TempReg R: ra].
  		[2]	->	[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: ra.
  				 self MoveCq: (objectMemory integerValueOf: val) R: TempReg.
  				 self MulR: TempReg R: ra.
  				 objectRepresentation genAddSmallIntegerTagsTo: ra].
  
  		"2016 through 2019, bitAnd:, bitOr:, bitXor, bitShift:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  
  		"2032	through 2037, >, <, >=, <=. =, ~=, SmallInteger op SmallInteger => Boolean (flags?? then in jump bytecodes if ssTop is a flags value, just generate the instruction!!!!)"
  		"CmpCqR is SubRCq so everything is reversed, but because no CmpRCq things are reversed again and we invert the sense of the jumps."
  		[32] -> [ self CmpCq: val R: ra.
  				self genBinaryInlineComparison: JumpLess opFalse: JumpGreaterOrEqual destReg: ra ].
  		[33] -> [ self CmpCq: val R: ra.
  				self genBinaryInlineComparison: JumpGreater opFalse: JumpLessOrEqual destReg: ra ].
  		[34] -> [ self CmpCq: val R: ra.
  				self genBinaryInlineComparison: JumpLessOrEqual opFalse: JumpGreater destReg: ra ].
  		[35] -> [ self CmpCq: val R: ra.
  				self genBinaryInlineComparison: JumpGreaterOrEqual opFalse: JumpLess destReg: ra ].
  		[36] -> [ self CmpCq: val R: ra.
  				self genBinaryInlineComparison: JumpZero opFalse: JumpNonZero destReg: ra ].
  		[37] -> [ self CmpCq: val R: ra.
  				self genBinaryInlineComparison: JumpNonZero opFalse: JumpZero destReg: ra ].
  
  		"2064	through 2068, Pointer Object>>at:, Byte Object>>at:, Short16 Word Object>>at: LongWord32 Object>>at: Quad64Word Object>>at:. obj op 0-rel SmallInteger => oop"
  		[64] ->	[objectRepresentation genConvertSmallIntegerToIntegerInReg: ra.
  				adjust := (objectMemory baseHeaderSize >> objectMemory shiftForWord) - 1. "shift by baseHeaderSize and then move from 1 relative to zero relative"
  				adjust ~= 0 ifTrue: [ self AddCq: adjust R: ra. ]. 
  				self genMoveConstant: val R: TempReg.
  				self MoveXwr: ra R: TempReg R: ra].
  		[65] ->	[objectRepresentation genConvertSmallIntegerToIntegerInReg: ra.
  				adjust := objectMemory baseHeaderSize - 1. "shift by baseHeaderSize and then move from 1 relative to zero relative"
  				self AddCq: adjust R: ra.
  				self genMoveConstant: val R: TempReg.
  				self MoveXbr: ra R: TempReg R: ra.
  				objectRepresentation genConvertIntegerToSmallIntegerInReg: ra]
  	}
  	otherwise: [^EncounteredUnknownBytecode].
  	self ssPushRegister: ra.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genBinaryVarOpConstInlinePrimitive: (in category 'inline primitive generators') -----
  genBinaryVarOpConstInlinePrimitive: prim
  	"Var op const version of inline binary inline primitives."
  	"SistaV1: 248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
  	 See EncoderForSistaV1's class comment and StackInterpreter>>#binaryInlinePrimitive:"
  	| rr val untaggedVal |
  	val := self ssTop constant.
  	self ssPop: 1.
+ 	rr := self self allocateRegForStackEntryAt: 0.
- 	rr := self allocateRegForStackTopEntry.
  	self ssTop popToReg: rr.
  	self ssPop: 1.
  	untaggedVal := val - objectMemory smallIntegerTag.
  	prim caseOf: {
  		"0 through 6, +, -, *, /, //, \\, quo:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  		[0]	->	[self AddCq: untaggedVal R: rr].
  		[1]	->	[self SubCq: untaggedVal R: rr ].
  		[2]	->	[self flag: 'could use MulCq:R'.
  				 objectRepresentation genShiftAwaySmallIntegerTagsInScratchReg: rr.
  				 self MoveCq: (objectMemory integerValueOf: val) R: TempReg.
  				 self MulR: TempReg R: rr.
  				 objectRepresentation genAddSmallIntegerTagsTo: rr].
  
  		"2016 through 2019, bitAnd:, bitOr:, bitXor, bitShift:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  
  		"2032	through 2037, >, <, >=, <=. =, ~=, SmallInteger op SmallInteger => Boolean (flags?? then in jump bytecodes if ssTop is a flags value, just generate the instruction!!!!)"
  		"CmpCqR is SubRCq so everything is reversed."
  		[32] -> [ self CmpCq: val R: rr.
  				self genBinaryInlineComparison: JumpGreater opFalse: JumpLessOrEqual destReg: rr ].
  		[33] -> [ self CmpCq: val R: rr.
  				self genBinaryInlineComparison: JumpLess opFalse: JumpGreaterOrEqual destReg: rr ].
  		[34] -> [ self CmpCq: val R: rr.
  				self genBinaryInlineComparison: JumpGreaterOrEqual opFalse: JumpLess destReg: rr ].
  		[35] -> [ self CmpCq: val R: rr.
  				self genBinaryInlineComparison: JumpLessOrEqual opFalse: JumpGreater destReg: rr ].
  		[36] -> [ self CmpCq: val R: rr.
  				self genBinaryInlineComparison: JumpZero opFalse: JumpNonZero destReg: rr ].
  		[37] -> [ self CmpCq: val R: rr.
  				self genBinaryInlineComparison: JumpNonZero opFalse: JumpZero destReg: rr ].
  
  		"2064	through 2068, Pointer Object>>at:, Byte Object>>at:, Short16 Word Object>>at: LongWord32 Object>>at: Quad64Word Object>>at:. obj op 0-rel SmallInteger => oop"
  		[64] ->	[objectRepresentation genLoadSlot: (objectMemory integerValueOf: val) - 1 sourceReg: rr destReg: rr].
  		[65] ->	[self MoveCq: (objectMemory integerValueOf: val) + objectMemory baseHeaderSize - 1 R: TempReg.
  				self MoveXbr: TempReg R: rr R: rr.
  				objectRepresentation genConvertIntegerToSmallIntegerInReg: rr]
  
  	}
  	otherwise: [^EncounteredUnknownBytecode].
  	self ssPushRegister: rr.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPushLiteralVariable: (in category 'bytecode generator support') -----
  genPushLiteralVariable: literalIndex
  	<inline: false>
  	| association freeReg |
+ 	freeReg := self allocateRegNotConflictingWith: 0.
- 	freeReg := self allocateAnyReg.
  	association := self getLiteral: literalIndex.
  	"N.B. Do _not_ use ReceiverResultReg to avoid overwriting receiver in assignment in frameless methods."
  	"So far descriptors are not rich enough to describe the entire dereference so generate the register
  	 load but don't push the result.  There is an order-of-evaluation issue if we defer the dereference."
  	self genMoveConstant: association R: TempReg.
  	objectRepresentation
  		genEnsureObjInRegNotForwarded: TempReg
  		scratchReg: freeReg.
  	objectRepresentation
  		genLoadSlot: ValueIndex
  		sourceReg: TempReg
  		destReg: freeReg.
  	self ssPushRegister: freeReg.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genPushMaybeContextReceiverVariable: (in category 'bytecode generator support') -----
  genPushMaybeContextReceiverVariable: slotIndex 
  	<inline: false>
  	| jmpSingle jmpDone |
  	<var: #jmpSingle type: #'AbstractInstruction *'>
  	<var: #jmpDone type: #'AbstractInstruction *'>
  	self assert: needsFrame.
  	self ssAllocateCallReg: ReceiverResultReg and: SendNumArgsReg.
  	self ensureReceiverResultRegContainsSelf.
+ 	(self register: ReceiverResultReg isInMask: callerSavedRegMask) ifTrue:
- 	((self registerMaskFor: ReceiverResultReg) anyMask: callerSavedRegMask) ifTrue:
  		["We have no way of reloading ReceiverResultReg since we need the inst var value as the result."
  		optStatus isReceiverResultRegLive: false].
  	"See CoInterpreter>>contextInstructionPointer:frame: for an explanation
  	 of the instruction pointer slot handling."
  	slotIndex = InstructionPointerIndex ifTrue:
  		[self MoveCq: slotIndex R: SendNumArgsReg.
  		 self CallRT: ceFetchContextInstVarTrampoline.
  		 ^self ssPushRegister: SendNumArgsReg].
  	objectRepresentation
  		genLoadSlot: SenderIndex
  		sourceReg: ReceiverResultReg
  		destReg: TempReg.
  	jmpSingle := objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg.
  	self MoveCq: slotIndex R: SendNumArgsReg.
  	self CallRT: ceFetchContextInstVarTrampoline.
  	jmpDone := self Jump: 0.
  	jmpSingle jmpTarget: self Label.
  	objectRepresentation
  		genLoadSlot: slotIndex
  		sourceReg: ReceiverResultReg
  		destReg: SendNumArgsReg.
  	jmpDone jmpTarget: self Label.
  	^self ssPushRegister: SendNumArgsReg!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genStorePop:LiteralVariable: (in category 'bytecode generator support') -----
  genStorePop: popBoolean LiteralVariable: litVarIndex
  	<inline: false>
  	| topReg assocReg association |
  	"The only reason we assert needsFrame here is that in a frameless method
  	 ReceiverResultReg must and does contain only self, but the ceStoreCheck
  	 trampoline expects the target of the store to be in ReceiverResultReg.  So
  	 in a frameless method we would have a conflict between the receiver and
  	 the literal store, unless we we smart enough to realise that ReceiverResultReg
  	 was unused after the literal variable store, unlikely given that methods
  	 return self by default."
  	self assert: needsFrame.
  	"N.B.  No need to check the stack for references because we generate code for
  	 literal variable loads that stores the result in a register, deferring only the register push."
  	association := self getLiteral: litVarIndex.
  	
  	"Avoid store check for immediate values"
  	(objectRepresentation isUnannotatableConstant: self ssTop) ifTrue:
+ 			[ assocReg := self allocateRegNotConflictingWith: 0.
- 			[ assocReg := self allocateAnyReg.
  			self genMoveConstant: association R: assocReg.
  			 objectRepresentation
  				genEnsureObjInRegNotForwarded: assocReg
  				scratchReg: TempReg.
  			self ssStorePop: popBoolean toReg: TempReg.
  			 traceStores > 0 ifTrue:
  				[ assocReg = ReceiverResultReg ifFalse: 
  					[ self ssAllocateRequiredReg: ReceiverResultReg.
  					optStatus isReceiverResultRegLive: false.
  					self MoveR: assocReg R: ReceiverResultReg ].
  				self CallRT: ceTraceStoreTrampoline].
  			 ^objectRepresentation
  				genStoreImmediateInSourceReg: TempReg
  				slotIndex: ValueIndex
  				destReg: assocReg ].
  		
+ 	topReg := self allocateRegForStackEntryAt: 0 notConflictingWith: (self registerMaskFor: ReceiverResultReg).
- 	topReg := self allocateRegForStackTopEntryNotConflictingWith: (self registerMaskFor: ReceiverResultReg).
  	self ssStorePop: popBoolean toReg: topReg.
  	optStatus isReceiverResultRegLive: false.
  	self ssAllocateRequiredReg: ReceiverResultReg. "for ceStoreCheck call in genStoreSourceReg: has to be ReceiverResultReg"
  	self genMoveConstant: association R: ReceiverResultReg.
  	objectRepresentation genEnsureObjInRegNotForwarded: ReceiverResultReg scratchReg: TempReg.
  	traceStores > 0 ifTrue:
  		[self MoveR: topReg R: TempReg.
  		 self CallRT: ceTraceStoreTrampoline].
  	^objectRepresentation
  		genStoreSourceReg: topReg
  		slotIndex: ValueIndex
  		destReg: ReceiverResultReg
  		scratchReg: TempReg
  		inFrame: needsFrame!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genStorePop:ReceiverVariable:traceBlock:inFrame: (in category 'bytecode generator support') -----
  genStorePop: popBoolean ReceiverVariable: slotIndex traceBlock: block inFrame: inFrame
  	<inline: true>
  	| topReg |
  	self ssFlushUpThroughReceiverVariable: slotIndex.
  	"Avoid store check for immediate values"
  	(objectRepresentation isUnannotatableConstant: self ssTop) ifTrue:
  		[self ensureReceiverResultRegContainsSelf.
  		 self ssStorePop: popBoolean toReg: TempReg.
  		 traceStores > 0 ifTrue: [block value].
  		 ^objectRepresentation
  			genStoreImmediateInSourceReg: TempReg
  			slotIndex: slotIndex
  			destReg: ReceiverResultReg].
+ 	topReg := self allocateRegForStackEntryAt: 0 notConflictingWith: (self registerMaskFor: ReceiverResultReg).
- 	topReg := self allocateRegForStackTopEntryNotConflictingWith: (self registerMaskFor: ReceiverResultReg).
  	self ssStorePop: popBoolean toReg: topReg.
  	"Note that ReceiverResultReg remains live after ceStoreCheckTrampoline."
  	self ensureReceiverResultRegContainsSelf.
  	 traceStores > 0 ifTrue:
  		[self MoveR: topReg R: TempReg.
  		 block value].
  	^objectRepresentation
  		genStoreSourceReg: topReg
  		slotIndex: slotIndex
  		destReg: ReceiverResultReg
  		scratchReg: TempReg
  		inFrame: inFrame!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genStorePop:RemoteTemp:At: (in category 'bytecode generator support') -----
  genStorePop: popBoolean RemoteTemp: slotIndex At: remoteTempIndex
  	<inline: false>
  	| topReg topSpilled tempVectReg |
  	"The only reason we assert needsFrame here is that in a frameless method
  	 ReceiverResultReg must and does contain only self, but the ceStoreCheck
  	 trampoline expects the target of the store to be in ReceiverResultReg.  So
  	 in a frameless method we would have a conflict between the receiver and
  	 the temote temp store, unless we we smart enough to realise that
  	 ReceiverResultReg was unused after the literal variable store, unlikely given
  	 that methods return self by default."
  	self assert: needsFrame.
  	"N.B.  No need to check the stack for references because we generate code for
  	 remote temp loads that stores the result in a register, deferring only the register push."
  	"Avoid store check for immediate values"
  	(objectRepresentation isUnannotatableConstant: self ssTop) ifTrue:
+ 		[ tempVectReg := self allocateRegNotConflictingWith: 0.
- 		[ tempVectReg := self allocateAnyReg.
  		 self MoveMw: (self frameOffsetOfTemporary: remoteTempIndex) r: FPReg R: tempVectReg.
  		 self ssStorePop: popBoolean toReg: TempReg.
  		 traceStores > 0 ifTrue:
  			[ tempVectReg = ReceiverResultReg ifFalse: 
  					[ self ssAllocateRequiredReg: ReceiverResultReg.
  					optStatus isReceiverResultRegLive: false.
  					self MoveR: tempVectReg R: ReceiverResultReg ].
  			self CallRT: ceTraceStoreTrampoline].
  		 ^objectRepresentation
  			genStoreImmediateInSourceReg: TempReg
  			slotIndex: slotIndex
  			destReg: tempVectReg].
+ 	topReg := self allocateRegForStackEntryAt: 0 notConflictingWith: (self registerMaskFor: ReceiverResultReg).
- 	topReg := self allocateRegForStackTopEntryNotConflictingWith: (self registerMaskFor: ReceiverResultReg).
  	topSpilled := self ssTop spilled.
  	self ssStorePop: (popBoolean or: [topSpilled]) toReg: topReg.
  	popBoolean ifFalse:
  		[topSpilled ifFalse: [self ssPop: 1].
  		 self ssPushRegister: topReg].
  	self ssAllocateRequiredReg: ReceiverResultReg.
  	optStatus isReceiverResultRegLive: false.
  	self MoveMw: (self frameOffsetOfTemporary: remoteTempIndex) r: FPReg R: ReceiverResultReg.
  	 traceStores > 0 ifTrue:
  		[self MoveR: topReg R: TempReg.
  		 self CallRT: ceTraceStoreTrampoline].
  	^objectRepresentation
  		genStoreSourceReg: topReg
  		slotIndex: slotIndex
  		destReg: ReceiverResultReg
  		scratchReg: TempReg
  		inFrame: needsFrame!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genUnaryInlinePrimitive: (in category 'inline primitive generators') -----
  genUnaryInlinePrimitive: prim
  	"Unary inline primitives."
  	"SistaV1: 248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
  	 See EncoderForSistaV1's class comment and StackInterpreter>>#unaryInlinePrimitive:"
  	| rcvrReg resultReg |
+ 	rcvrReg := self allocateRegForStackEntryAt: 0.
- 	rcvrReg := self allocateRegForStackTopEntry.
  	resultReg := self allocateRegNotConflictingWith: (self registerMaskFor: rcvrReg).
  	self ssTop popToReg: rcvrReg.
  	self ssPop: 1.
  	prim
  		caseOf: {
  					"00		unchecked class"
  			[1] ->	"01		unchecked pointer numSlots"
  				[objectRepresentation
  					genGetNumSlotsOf: rcvrReg into: resultReg;
  					genConvertIntegerToSmallIntegerInReg: resultReg].
  					"02		unchecked pointer basicSize"
  			[3] ->	"03		unchecked byte numBytes"
  				[objectRepresentation
  					genGetNumBytesOf: rcvrReg into: resultReg;
  					genConvertIntegerToSmallIntegerInReg: resultReg].
  					"04		unchecked short16Type format numShorts"
  					"05		unchecked word32Type format numWords"
  					"06		unchecked doubleWord64Type format numDoubleWords"
  				  }
  		otherwise:
  			[^EncounteredUnknownBytecode]..
  	self ssPushRegister: resultReg.
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>returnRegForStoreCheck (in category 'trampolines') -----
  returnRegForStoreCheck
  	"We must ensure the ReceiverResultReg is live across the store check so that
  	 we can store into receiver inst vars in a frameless method since self exists
  	 only in ReceiverResultReg in a frameless method.  So if ReceiverResultReg is
  	 caller-saved we use the fact that ceStoreCheck: answers its argument to
  	 reload ReceiverResultReg cheaply.  Otherwise we don't care about the result
  	 and use the cResultRegister, effectively a no-op (see compileTrampoline...)"
  
+ 	^(self register: ReceiverResultReg isInMask: callerSavedRegMask)
- 	^((self registerMaskFor: ReceiverResultReg) anyMask: callerSavedRegMask)
  		ifTrue: [ReceiverResultReg]
  		ifFalse: [backEnd cResultRegister]!



More information about the Vm-dev mailing list