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

commits at source.squeak.org commits at source.squeak.org
Wed Jan 18 21:00:05 UTC 2017


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

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

Name: VMMaker.oscogSPC-eem.2101
Author: eem
Time: 18 January 2017, 12:59:05.972427 pm
UUID: 2e73a018-4f46-4cf1-9856-fef1c80ba592
Ancestors: VMMaker.oscogSPC-eem.2100

Temporary branch for SpurPlanningCompactor as default compactor.  Otherwise the same as VMMaker.oscog-eem.2101.

Fix the RegisterAllocatingCogit in the face of the new follow jump code.  Merge code for conditional branches must only be generated along the path that takes the jump.

Remove some dead code (genExtJumpIfNotInstanceOfBehaviorsOrPopBytecode) and "fix" SistaCogit>>genExtJumpIfNotInstanceOfBehaviorsBytecode (Clément, please review; my "fix" might be wrong).

Add deadCode to descriptor printing, and eliminate flag overlap for the map.

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

Item was added:
+ ----- Method: CogRASSBytecodeFixup>>hasMergeSimStack (in category 'debug printing') -----
+ hasMergeSimStack
+ 	^self needsFixup and: [mergeSimStack notNil]!

Item was changed:
  ----- Method: Cogit>>addToMap:instruction:byte:at:for: (in category 'method map') -----
  addToMap: annotation instruction: instruction byte: byte at: address for: mcpc
  	<inline: true>
  	objectMemory byteAt: address put: byte.
  	self cCode: [] inSmalltalk:
  		[| s bytecode |
+ 		(compilationTrace anyMask: 64) ifTrue:
- 		(compilationTrace anyMask: 16) ifTrue:
  			[(s := coInterpreter transcript)
  				ensureCr;
  				print: annotation; nextPut: $/; nextPutAll: byte hex; space;
  				nextPutAll: address hex; space; nextPutAll: mcpc hex; space;
  				nextPutAll: (AnnotationConstantNames detect: [:name| (Cogit classPool at: name ifAbsent: []) = annotation]); cr; flush.
+ 			 (instruction notNil
+ 			  and: [instruction bcpc isInteger]) ifTrue:
- 			(instruction notNil
- 			 and: [instruction bcpc isInteger]) ifTrue:
  				[s tab; print: instruction bcpc; nextPut: $/.
  				 instruction bcpc printOn: s base: 16.
  				 s space.
  				 instruction printStateOn: s.
  				 s space.
  				 bytecode := objectMemory fetchByte: instruction bcpc ofObject: methodObj.
+ 				 bytecode := bytecode + (self bytecodeSetOffsetForHeader: methodHeader).
- 				 bytecode := bytecode + (self bytecodeSetOffsetForHeader: (methodHeader)).
  				 (self generatorAt: bytecode) printStateOn: s.
  				 s cr; flush]]]!

Item was changed:
  ----- Method: Cogit>>compilationTrace: (in category 'simulation only') -----
  compilationTrace: anInteger
  	"  1 = method/block compilation
  	   2 = bytecode descriptor.
  	   4 = simStack & optStatus
  	   8 = spill
  	 16 = merge
+ 	 32 = fixup
+ 	 64 = map"
- 	 32 = fixup"
  	compilationTrace := anInteger!

Item was added:
+ ----- Method: RegisterAllocatingCogit>>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 |
+ 	
+ 	reg := self allocateRegForStackEntryAt: 0.
+ 	self ssTop popToReg: reg.
+ 	
+ 	literal := self getLiteral: (extA * 256 + byte1).
+ 	extA := 0.
+ 	distance := extB * 256 + byte2.
+ 	extB := 0.
+ 	numExtB := 0.
+ 
+ 	"Because ensureFixupAt: will generate code to merge with the target simStack when required, it is
+ 	 necessary to tease apart the jump and the merge so that the merge code is only executed if the
+ 	 branch is taken.  i.e. if merge code is required we generate
+ 			jump not cond Lcontinue
+ 			... merge code ...
+ 			jump Ltarget
+ 		Lcontinue:
+ 	 instead of the incorrect
+ 			... merge code ...
+ 			jump cond Ltarget"
+ 	(self mergeRequiredForJumpTo: bytecodePC + 3 + distance - initialPC) ifTrue:
+ 		[self shouldBeImplemented].
+ 
+ 	targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance - initialPC) to: #'AbstractInstruction *'.
+ 		
+ 	(objectMemory isArrayNonImm: literal)
+ 		ifTrue: [objectRepresentation branchIf: reg notInstanceOfBehaviors: literal target: targetFixUp]
+ 		ifFalse: [objectRepresentation branchIf: reg notInstanceOfBehavior: literal target: targetFixUp].
+ 						
+ 	self ssPop: 1.
+ 	
+ 	^0!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>genForwardersInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
  genForwardersInlinedIdenticalOrNotIf: orNot
  	| nextPC branchDescriptor unforwardRcvr argReg targetBytecodePC
  	unforwardArg  rcvrReg postBranchPC label fixup |
  	<var: #branchDescriptor type: #'BytecodeDescriptor *'>
  	<var: #label type: #'AbstractInstruction *'>
  	
  	self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target | 
  		branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := 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].
  	
  	label := self Label.
  	self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not 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 - initialPC) notAFixup
  		ifTrue: "The next instruction is dead.  we can skip it."
  			[deadCode := true.
  		 	 self ensureFixupAt: targetBytecodePC - initialPC.
  			 self ensureFixupAt: postBranchPC - initialPC]
  		ifFalse:
  			[self deny: deadCode]. "push dummy value below"
  
  	self assert: (unforwardArg or: [unforwardRcvr]).
  	orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
  		ifFalse: "branchDescriptor is branchFalse"
  			[ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.
  			self JumpZero:  (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]
  		ifTrue:
  			[ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
  			self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ].
  
  	deadCode ifFalse:
  		[self ssPushConstant: objectMemory trueObject]. "dummy value"
  	"The forwarders checks need to jump back to the comparison (label) if a forwarder is found, else 
  	jump forward either to the next forwarder check or to the postBranch or branch target (fixup)."
  	unforwardArg ifTrue: 
  		[ unforwardRcvr
  			ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg jumpBackTo: label ]
  			ifFalse: [ objectRepresentation 
  				genEnsureOopInRegNotForwarded: argReg 
  				scratchReg: TempReg 
  				ifForwarder: label
  				ifNotForwarder: fixup ] ].
  	unforwardRcvr ifTrue: 
  		[ objectRepresentation 
  			genEnsureOopInRegNotForwarded: rcvrReg 
  			scratchReg: TempReg 
  			ifForwarder: label
  			ifNotForwarder: fixup ].
  		
  	"Not reached, execution flow have jumped to fixup"
  	
  	^0!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>genJumpIf:to: (in category 'bytecode generator support') -----
  genJumpIf: boolean to: targetBytecodePC
  	<inline: false>
+ 	| eventualTarget desc reg fixup ok mbb noMustBeBoolean |
- 	| eventualTarget desc reg fixup ok |
- 	<var: #desc type: #'CogSimStackEntry *'>
  	<var: #fixup type: #'BytecodeFixup *'>
  	<var: #ok type: #'AbstractInstruction *'>
+ 	<var: #desc type: #'CogSimStackEntry *'>
+ 	<var: #mbb type: #'AbstractInstruction *'>
  	eventualTarget := self eventualTargetOf: targetBytecodePC.
  	desc := self ssTop.
  	self ssPop: 1.
+ 
+ 	noMustBeBoolean := self extASpecifiesNoMustBeBoolean.
+ 	extA := 0.
+ 
  	(desc type == SSConstant
  	 and: [desc constant = objectMemory trueObject or: [desc constant = objectMemory falseObject]]) ifTrue:
+ 		["Must annotate the bytecode for correct pc mapping."
+ 		 desc constant = boolean
+ 			ifTrue:
+ 				[deadCode := true. "Can't fall through."
+ 				 fixup := self ensureFixupAt: eventualTarget - initialPC.
+ 				 self annotateBytecode: (self Jump: fixup)]
+ 		 	ifFalse:
+ 				[self annotateBytecode: (self prevInstIsPCAnnotated
- 		["Must arrange there's a fixup at the target whether it is jumped to or
- 		  not so that the simStackPtr can be kept correct."
- 		 fixup := self ensureFixupAt: eventualTarget - initialPC.
- 		 "Must annotate the bytecode for correct pc mapping."
- 		 self annotateBytecode: (desc constant = boolean
- 									ifTrue: [self Jump: fixup]
- 									ifFalse: [self prevInstIsPCAnnotated
  												ifTrue: [self Nop]
+ 												ifFalse: [self Label])].
- 												ifFalse: [self Label]]).
- 		 extA := 0.
  		 ^0].
+ 
+ 	"try and use the top entry's register if any, but only if it can be destroyed."
- 	"try and use the top entry's register if anty, but only if it can be destroyed."
  	reg := (desc type ~= SSRegister
  			or: [(self anyReferencesToRegister: desc register inAllButTopNItems: 0)
  			or: [(desc register = ReceiverResultReg and: [optStatus isReceiverResultRegLive])]])
  				ifTrue: [TempReg]
  				ifFalse: [desc register].
  	desc popToReg: reg.
  	"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.
+ 
+ 	"Merge required; must not generate merge code along untaken branch, so flip the order."
+ 	(self mergeRequiredForJumpTo: eventualTarget)
+ 		ifTrue:
+ 			[self genSubConstant: (boolean = objectMemory trueObject
+ 										ifTrue: [objectMemory falseObject]
+ 										ifFalse: [objectMemory trueObject])
+ 				R: reg.
+ 			 ok := self JumpZero: 0.
+ 			 self CmpCq: (boolean = objectMemory trueObject
+ 							ifTrue: [objectMemory trueObject - objectMemory falseObject]
+ 							ifFalse: [objectMemory falseObject - objectMemory trueObject])
+ 				R: reg.
+ 			 noMustBeBoolean ifTrue: 
+ 				[self JumpZero: (self ensureFixupAt: eventualTarget - initialPC). "generates merge code"
+ 				 ok jmpTarget: (self annotateBytecode: self lastOpcode).
+ 				 ^0].
+ 			 mbb := self JumpNonZero: 0.
+ 			 self Jump: (self ensureFixupAt: eventualTarget - initialPC). "generates merge code"
+ 			 mbb jmpTarget: self Label]
+ 		ifFalse:
+ 			[self genSubConstant: boolean R: reg.
+ 			 self JumpZero: (self ensureFixupAt: eventualTarget - initialPC).
+ 			 noMustBeBoolean ifTrue: 
+ 				[self annotateBytecode: self lastOpcode.
+ 				 ^0].
+ 			 self CmpCq: (boolean = objectMemory falseObject
+ 							ifTrue: [objectMemory trueObject - objectMemory falseObject]
+ 							ifFalse: [objectMemory falseObject - objectMemory trueObject])
+ 				R: reg.
+ 			 ok := self JumpZero: 0].
+ 
- 	self genSubConstant: boolean R: reg.
- 	self JumpZero: (self ensureFixupAt: eventualTarget - initialPC).
- 	
- 	self extASpecifiesNoMustBeBoolean ifTrue: 
- 		[extA := 0. 
- 		 self annotateBytecode: self lastOpcode.
- 		 ^0].
- 	extA := 0.
- 	
- .	self CmpCq: (boolean = objectMemory falseObject
- 					ifTrue: [objectMemory trueObject - objectMemory falseObject]
- 					ifFalse: [objectMemory falseObject - objectMemory trueObject])
- 		R: reg.
- 	ok := self JumpZero: 0.
  	reg ~= TempReg ifTrue:
  		[self MoveR: reg R: TempReg].
  	self copySimStackToScratch: simSpillBase.
  	self ssFlushTo: simStackPtr.
  	self genCallMustBeBooleanFor: boolean.
  	"NOTREACHED"
  	ok jmpTarget: (self annotateBytecode: self Label).
  	self restoreSimStackFromScratch.
  	^0!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>genSpecialSelectorComparison (in category 'bytecode generators') -----
  genSpecialSelectorComparison
  	| nextPC postBranchPC targetBytecodePC primDescriptor branchDescriptor
  	  rcvrIsInt argIsInt argInt jumpNotSmallInts inlineCAB index rcvrReg argReg |
  	<var: #primDescriptor type: #'BytecodeDescriptor *'>
  	<var: #branchDescriptor type: #'BytecodeDescriptor *'>
  	<var: #jumpNotSmallInts type: #'AbstractInstruction *'>
  	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: (self ssValue: 1) constant].
  
  	(argIsInt and: [rcvrIsInt]) ifTrue:
+ 		[^self genStaticallyResolvedSpecialSelectorComparison].
- 		[^ self genStaticallyResolvedSpecialSelectorComparison].
  
  	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].
  
  	"In-line the comparison and the jump, but if the types are not SmallInteger then we will need
  	 to do a send and fall through to the following conditional branch.  Since we're allocating values
  	 in registers we would like to keep those registers live on the inlined path and reload registers
  	 along the non-inlined send path.  The merge logic at the branch destinations handles this."
  	argIsInt
  		ifTrue:
  			[rcvrReg := self allocateRegForStackEntryAt: 1.
  			 (self ssValue: 1) popToReg: rcvrReg.
  			 self MoveR: rcvrReg R: TempReg]
  		ifFalse:
  			[self allocateRegForStackTopTwoEntriesInto: [:rTop :rNext| argReg := rTop. rcvrReg := rNext].
  			 rcvrReg = Arg0Reg ifTrue:
  				[rcvrReg := argReg. argReg := Arg0Reg].
  			 self ssTop popToReg: argReg.
  			 (self ssValue: 1) popToReg: rcvrReg.
  			 self MoveR: argReg R: TempReg].
  	self ssPop: 2.
  	jumpNotSmallInts := (argIsInt or: [rcvrIsInt])
  							ifTrue: [objectRepresentation genJumpNotSmallIntegerInScratchReg: TempReg]
  							ifFalse: [objectRepresentation genJumpNotSmallIntegersIn: rcvrReg andScratch: TempReg scratch: ClassReg].
  	argIsInt
  		ifTrue: [self CmpCq: argInt R: rcvrReg]
  		ifFalse: [self CmpR: argReg R: rcvrReg].
+ 
+ 	"For now just deny we're in the situation we have yet to implement ;-)"
+ 	self deny: (self mergeRequiredForJumpTo: targetBytecodePC).
+ 	self deny: (self mergeRequiredForJumpTo: postBranchPC).
+ 
  	"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 genConditionalBranch: (branchDescriptor isBranchTrue
  				ifTrue: [primDescriptor opcode]
  				ifFalse: [self inverseBranchFor: primDescriptor opcode])
  		operand: (self ensureFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
  	self Jump: (self ensureFixupAt: postBranchPC - initialPC).
  	jumpNotSmallInts jmpTarget: self Label.
  	self ssFlushTo: simStackPtr.
  	self deny: rcvrReg = Arg0Reg.
  	argIsInt
  		ifTrue: [self MoveCq: argInt R: Arg0Reg]
  		ifFalse: [argReg ~= Arg0Reg ifTrue: [self MoveR: argReg R: Arg0Reg]].
  	rcvrReg ~= ReceiverResultReg ifTrue: [self MoveR: rcvrReg R: ReceiverResultReg].
  	index := byte0 - self firstSpecialSelectorBytecodeOffset.
  	^self genMarshalledSend: index negated - 1 numArgs: 1 sendTable: ordinarySendTrampolines!

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 - initialPC) notAFixup
  		ifTrue: "The next instruction is dead.  we can skip it."
  			[deadCode := true.
  		 	 self ensureFixupAt: targetBytecodePC - initialPC.
  			 self ensureFixupAt: postBranchPC - initialPC]
  		ifFalse:
  			[self deny: deadCode]. "push dummy value below"
  		
  	self genConditionalBranch: (orNot == branchDescriptor isBranchTrue ifTrue: [JumpNonZero] ifFalse: [JumpZero])
  		operand: (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) 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 - initialPC).
  		 self ssPushConstant: objectMemory trueObject]. "dummy value"
  	^0!

Item was added:
+ ----- Method: RegisterAllocatingCogit>>mergeRequiredForJumpTo: (in category 'bytecode generator support') -----
+ mergeRequiredForJumpTo: target
+ 	"While this is a multi-pass compiler, no intermediate control-flow graph is built from bytecode and
+ 	 there is a monotonically increasing one-to-one relationship between bytecode pcs and machine
+ 	 code pcs that map to one another.  Therefore, when jumping forward, any required code to merge
+ 	 the state of the current simStack with that at the target must be generated before the jump
+ 	 (because at the target the simStack state will be whatever falls through). If only one forward jump
+ 	 to the target exists then that jump can simply install its simStack as the required simStack at the
+ 	 target and the merge code wil be generated just before the target as control falls through.  But if
+ 	 there are two or more forward jumps to the target, a situation that occurs given that the
+ 	 StackToRegisterMappingCogit follows jump chains, then jumps other than the first must generate
+ 	 merge code before jumping.  This poses a problem for conditional branches.  The merge code must
+ 	 only be generated along the path that takes the jump  Therefore this must *not* be generated:
+ 
+ 			... merge code ...
+ 			jump cond Ltarget
+ 
+ 	 which incorrectly executes the merge code along both the taken and untaken paths.  Instead
+ 	 this must be generated so that the merge code is only executed if the branch is taken.
+ 
+ 			jump not cond Lcontinue
+ 			... merge code ...
+ 			jump Ltarget
+ 		Lcontinue:
+ 
+ 	 Note that no merge code is required for code such as self at: (expr ifTrue: [1] ifFalse: [2])
+ 		17 <70> self
+ 		18 <71> pushConstant: true
+ 		19 <99> jumpFalse: 22
+ 		20 <76> pushConstant: 1
+ 		21 <90> jumpTo: 23
+ 		22 <77> pushConstant: 2
+ 		23 <C0> send: at:
+ 	 provided that 1 and 2 are assigned to the same target register."
+ 
+ 	self flag: 'be lazy for now; this needs more work to ignore compatible sim stacks'.
+ 	^(self fixupAt: target - initialPC) hasMergeSimStack!

Item was changed:
  ----- Method: SistaCogit>>genExtJumpIfNotInstanceOfBehaviorsBytecode (in category 'bytecode generators') -----
  genExtJumpIfNotInstanceOfBehaviorsBytecode
  	"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 inverse |
+ 
+ 	"We lose 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...."
- 	
- 	"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 allocateRegForStackEntryAt: 0.
  	self ssTop popToReg: reg.
  	self ssFlushTo: simStackPtr. "flushed but the value is still in reg"
+ 	self ssPop: 1.
+ 
- 	
- 	self genPopStackBytecode.
- 	
  	literal := self getLiteral: (extA * 256 + byte1).
+ 	(inverse := extB < 0) ifTrue:
+ 		[extB := extB + 128].
- 	extA := 0.
- 	extB < 0 
- 		ifTrue: [extB := extB + 128. inverse := true]
- 		ifFalse: [inverse := false].
  	distance := extB * 256 + byte2.
+ 	extA := extB := numExtB := 0.
+ 
- 	extB := 0.
- 	numExtB := 0.
- 	
  	targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance - initialPC) to: #'AbstractInstruction *'.
  	inverse
  		ifFalse: 
  			[(objectMemory isArrayNonImm: literal)
  				ifTrue: [objectRepresentation branchIf: reg notInstanceOfBehaviors: literal target: targetFixUp]
  				ifFalse: [objectRepresentation branchIf: reg notInstanceOfBehavior: literal target: targetFixUp] ]
  		ifTrue:
  			[(objectMemory isArrayNonImm: literal)
  				ifTrue: [objectRepresentation branchIf: reg instanceOfBehaviors: literal target: targetFixUp]
  				ifFalse: [objectRepresentation branchIf: reg instanceOfBehavior: literal target: targetFixUp]].
  
- 			
- 	
  	^0!

Item was changed:
  ----- Method: SistaCogitClone>>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:"
  	<option: #SistaVM>
  	| ra val untaggedVal adjust |
  	ra := self allocateRegForStackEntryAt: 0.
  	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 genShiftAwaySmallIntegerTagsInScratchReg: ra.
  				 self MoveCq: untaggedVal R: TempReg.
  				 self MulR: TempReg R: ra.
  				 objectRepresentation genSetSmallIntegerTagsIn: ra].
  
+ 		"2016 through 2020, bitAnd:, bitOr:, bitXor, bitShiftLeft:, bitShiftRight:, SmallInteger op SmallInteger => SmallInteger, no overflow"
- 		"2016 through 2019, bitAnd:, bitOr:, bitXor, bitShift:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  		[16] -> [ self AndCq: val R: ra ].
  		[17] -> [ self OrCq: val R: ra ].
  		[18] -> [ self XorCw: untaggedVal R: ra. ].
+ 		[19] -> [ objectRepresentation genConvertSmallIntegerToIntegerInReg: ra.
+ 				 self MoveCq: untaggedVal R: TempReg.
+ 				 self LogicalShiftLeftR: ra R: TempReg.
+ 				 objectRepresentation genAddSmallIntegerTagsTo: TempReg.
+ 				 self MoveR: TempReg R: ra].
+ 		[20] ->	[objectRepresentation genConvertSmallIntegerToIntegerInReg: ra.
+ 				 self MoveCq: untaggedVal R: TempReg.
+ 				 self ArithmeticShiftRightR: ra R: TempReg.
+ 				 objectRepresentation genClearAndSetSmallIntegerTagsIn: TempReg.
+ 				 self MoveR: TempReg R: ra].
  
  		"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: SistaCogitClone>>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:"
  	<option: #SistaVM>
  	| rr val untaggedVal |
  	val := self ssTop constant.
  	self ssPop: 1.
  	rr := self allocateRegForStackEntryAt: 0.
  	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: untaggedVal R: TempReg.
  				 self MulR: TempReg R: rr.
  				 objectRepresentation genSetSmallIntegerTagsIn: rr].
  
+ 		"2016 through 2020, bitAnd:, bitOr:, bitXor, bitShiftLeft:, bitShiftRight:, SmallInteger op SmallInteger => SmallInteger, no overflow"
- 		"2016 through 2019, bitAnd:, bitOr:, bitXor, bitShift:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  		[16] -> [ self AndCq: val R: rr ].
  		[17] -> [ self OrCq: val R: rr ].
  		[18] -> [ self flag: 'could use XorCq:'.
  				self XorCw: untaggedVal R: rr. ].
+ 		[19] -> [ objectRepresentation genRemoveSmallIntegerTagsInScratchReg: rr.
+ 				 self LogicalShiftLeftCq: (objectMemory integerValueOf: val) R: rr.
+ 				 objectRepresentation genAddSmallIntegerTagsTo: rr ].
+ 		[20] ->	[self ArithmeticShiftRightCq: (objectMemory integerValueOf: val) R: rr.
+ 				 objectRepresentation genClearAndSetSmallIntegerTagsIn: rr].
  
  		"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: SistaCogitClone>>genBinaryVarOpVarInlinePrimitive: (in category 'inline primitive generators') -----
  genBinaryVarOpVarInlinePrimitive: prim
  	"Var 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:"
  	<option: #SistaVM>
  	| ra rr adjust |
  	self allocateRegForStackTopTwoEntriesInto: [:rTop :rNext | ra := rTop. rr := rNext ].
  	self ssTop popToReg: ra.
  	self ssPop: 1.
  	self ssTop popToReg: rr.
  	self ssPop: 1.
  	prim caseOf: {
  		"0 through 6, +, -, *, /, //, \\, quo:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  		[0]	->	[objectRepresentation genRemoveSmallIntegerTagsInScratchReg: ra.
  				 self AddR: ra R: rr].
  		[1]	->	[self SubR: ra R: rr.
  				 objectRepresentation genAddSmallIntegerTagsTo: rr].
  		[2]	->	[self genShiftAwaySmallIntegerTagsInScratchReg: rr.
  				 self genRemoveSmallIntegerTagsInScratchReg: ra.
  				 self MulR: ra R: rr.
  				 self genSetSmallIntegerTagsIn: rr].
  
+ 		"2016 through 2020, bitAnd:, bitOr:, bitXor, bitShiftLeft:, bitShiftRight:, SmallInteger op SmallInteger => SmallInteger, no overflow"
- 		"2016 through 2019, bitAnd:, bitOr:, bitXor, bitShift:, SmallInteger op SmallInteger => SmallInteger, no overflow"
  		[16] -> [ self AndR: ra R: rr ].
  		[17] -> [ self OrR: ra R: rr ].
  		[18] -> [objectRepresentation genRemoveSmallIntegerTagsInScratchReg: ra. 
  				self XorR: ra R: rr. ].
+ 		[19] -> [ objectRepresentation genConvertSmallIntegerToIntegerInReg: ra.
+ 				 objectRepresentation genRemoveSmallIntegerTagsInScratchReg: rr.
+ 				 self LogicalShiftLeftR: ra R: rr.
+ 				 objectRepresentation genAddSmallIntegerTagsTo: rr].
+ 		[20] ->	[objectRepresentation genConvertSmallIntegerToIntegerInReg: ra.
+ 				 self ArithmeticShiftRightR: ra R: rr.
+ 				 objectRepresentation genClearAndSetSmallIntegerTagsIn: rr.].
  
  
  		"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 CmpR: ra R: rr.
  				self genBinaryInlineComparison: JumpGreater opFalse: JumpLessOrEqual destReg: rr ].
  		[33] -> [ self CmpR: ra R: rr.
  				self genBinaryInlineComparison: JumpLess opFalse: JumpGreaterOrEqual destReg: rr ].
  		[34] -> [ self CmpR: ra R: rr.
  				self genBinaryInlineComparison: JumpGreaterOrEqual opFalse: JumpLess destReg: rr ].
  		[35] -> [ self CmpR: ra R: rr.
  				self genBinaryInlineComparison: JumpLessOrEqual opFalse: JumpGreater destReg: rr ].
  		[36] -> [ self CmpR: ra R: rr.
  				self genBinaryInlineComparison: JumpZero opFalse: JumpNonZero destReg: rr ].
  		[37] -> [ self CmpR: ra 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 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 MoveXwr: ra R: rr R: rr ].
  		[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 MoveXbr: ra R: rr R: rr.
  				objectRepresentation genConvertIntegerToSmallIntegerInReg: rr]
  
  	}
  	otherwise: [^EncounteredUnknownBytecode].
  	self ssPushRegister: rr.
  	^0!

Item was changed:
  ----- Method: SistaCogitClone>>genExtJumpIfNotInstanceOfBehaviorsBytecode (in category 'bytecode generators') -----
  genExtJumpIfNotInstanceOfBehaviorsBytecode
  	"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 inverse |
+ 
+ 	"We lose 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...."
- 	
- 	"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 allocateRegForStackEntryAt: 0.
  	self ssTop popToReg: reg.
  	self ssFlushTo: simStackPtr. "flushed but the value is still in reg"
+ 	self ssPop: 1.
+ 
- 	
- 	self genPopStackBytecode.
- 	
  	literal := self getLiteral: (extA * 256 + byte1).
+ 	(inverse := extB < 0) ifTrue:
+ 		[extB := extB + 128].
- 	extA := 0.
- 	extB < 0 
- 		ifTrue: [extB := extB + 128. inverse := true]
- 		ifFalse: [inverse := false].
  	distance := extB * 256 + byte2.
+ 	extA := extB := numExtB := 0.
+ 
- 	extB := 0.
- 	numExtB := 0.
- 	
  	targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance - initialPC) to: #'AbstractInstruction *'.
  	inverse
  		ifFalse: 
  			[(objectMemory isArrayNonImm: literal)
  				ifTrue: [objectRepresentation branchIf: reg notInstanceOfBehaviors: literal target: targetFixUp]
  				ifFalse: [objectRepresentation branchIf: reg notInstanceOfBehavior: literal target: targetFixUp] ]
  		ifTrue:
  			[(objectMemory isArrayNonImm: literal)
  				ifTrue: [objectRepresentation branchIf: reg instanceOfBehaviors: literal target: targetFixUp]
  				ifFalse: [objectRepresentation branchIf: reg instanceOfBehavior: literal target: targetFixUp]].
  
- 			
- 	
  	^0!

Item was removed:
- ----- Method: SistaCogitClone>>genForwardersInlinedIdenticalOrNotIf: (in category 'bytecode generators') -----
- genForwardersInlinedIdenticalOrNotIf: orNot
- 	"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 counterReg fixup jumpEqual jumpNotEqual
- 	  counterAddress countTripped unforwardArg unforwardRcvr argReg rcvrReg regMask |
- 	<var: #fixup type: #'BytecodeFixup *'>
- 	<var: #countTripped type: #'AbstractInstruction *'>
- 	<var: #label type: #'AbstractInstruction *'>
- 	<var: #branchDescriptor type: #'BytecodeDescriptor *'>
- 	<var: #jumpEqual type: #'AbstractInstruction *'>
- 	<var: #jumpNotEqual type: #'AbstractInstruction *'>
- 
- 	((coInterpreter isOptimizedMethod: methodObj) or: [needsFrame not]) ifTrue:
- 		[^super genForwardersInlinedIdenticalOrNotIf: orNot].
- 
- 	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)."
- 	rcvrReg:= argReg := NoReg.
- 	self 
- 		allocateEqualsEqualsRegistersArgNeedsReg: unforwardArg 
- 		rcvrNeedsReg: unforwardRcvr 
- 		into: [ :rcvr :arg | rcvrReg:= rcvr. argReg := arg ].
- 		
- 	argReg ~= NoReg ifTrue: [ regMask := self registerMaskFor: argReg ].
- 	rcvrReg ~= NoReg ifTrue: [ regMask := regMask bitOr: (self registerMaskFor: rcvrReg) ].
- 	
- 	"Only interested in inlining if followed by a conditional branch."
- 	(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse]) ifFalse:
- 		[^ self 
- 			genIdenticalNoBranchArgIsConstant: unforwardArg not
- 			rcvrIsConstant: unforwardRcvr not
- 			argReg: argReg 
- 			rcvrReg: rcvrReg 
- 			orNotIf: orNot].
- 	
- 	"If branching the stack must be flushed for the merge"
- 	self ssFlushTo: simStackPtr - 2.
- 	
- 	unforwardArg ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: argReg scratchReg: TempReg ].
- 	unforwardRcvr ifTrue: [ objectRepresentation genEnsureOopInRegNotForwarded: rcvrReg scratchReg: TempReg ].
- 	
- 	counterReg := self allocateRegNotConflictingWith: regMask.
- 	self 
- 		genExecutionCountLogicInto: [ :cAddress :countTripBranch | 
- 			counterAddress := cAddress. 
- 			countTripped := countTripBranch ] 
- 		counterReg: counterReg.
- 	
- 	self assert: (unforwardArg or: [ unforwardRcvr ]).
- 	self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
- 	self ssPop: 2.
- 	
- 	"We could use (branchDescriptor isBranchTrue xor: orNot) to simplify this."
- 	orNot 
- 		ifFalse: [branchDescriptor isBranchTrue
- 					ifTrue: 
- 						[ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.
- 						self JumpZero:  (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]
- 					ifFalse: "branchDescriptor is branchFalse"
- 						[ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
- 						self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ]]
- 		ifTrue: [branchDescriptor isBranchTrue
- 					ifFalse: "branchDescriptor is branchFalse"
- 						[ fixup := (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger.
- 						self JumpZero:  (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger ]
- 					ifTrue:
- 						[ fixup := (self ensureNonMergeFixupAt: targetBytecodePC - initialPC) asUnsignedInteger.
- 						self JumpZero: (self ensureNonMergeFixupAt: postBranchPC - initialPC) asUnsignedInteger ]].
- 	
- 	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 ssPop: -2. 
- 	self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
- 	self ssPop: 2. 
- 	
- 	"This code necessarily directly falls through the jumpIf: code which pops the top of the stack into TempReg. 
- 	We therefore directly assign the result to TempReg to save one move instruction"
- 	jumpEqual := orNot ifFalse: [self JumpZero: 0] ifTrue: [self JumpNonZero: 0].
- 	self genMoveFalseR: TempReg.
- 	jumpNotEqual := self Jump: 0.
- 	jumpEqual jmpTarget: (self genMoveTrueR: TempReg).
- 	jumpNotEqual jmpTarget: self Label.
- 	self ssPushRegister: TempReg.
- 	
- 	(self fixupAt: nextPC - initialPC) notAFixup ifTrue: [ branchReachedOnlyForCounterTrip := true ].
- 	
- 	^ 0!

Item was changed:
  ----- Method: SistaCogitClone>>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.
  	resultReg := self allocateRegNotConflictingWith: (self registerMaskFor: rcvrReg).
  	prim
  		caseOf: {
  					"00		unchecked class"
  			[1] ->	"01		unchecked pointer numSlots"
  				[self ssTop popToReg: rcvrReg.
  				 self ssPop: 1.
  				 objectRepresentation
  					genGetNumSlotsOf: rcvrReg into: resultReg;
  					genConvertIntegerToSmallIntegerInReg: resultReg].
  					"02		unchecked pointer basicSize"
  			[3] ->	"03		unchecked byte numBytes"
  				[self ssTop popToReg: rcvrReg.
  				 self ssPop: 1.
  				 objectRepresentation
  					genGetNumBytesOf: rcvrReg into: resultReg;
  					genConvertIntegerToSmallIntegerInReg: resultReg].
  					"04		unchecked short16Type format numShorts"
  					"05		unchecked word32Type format numWords"
  					"06		unchecked doubleWord64Type format numDoubleWords"
  			[11] ->	"11		unchecked fixed pointer basicNew"
  				[self ssTop type ~= SSConstant ifTrue:
  					[^EncounteredUnknownBytecode].
  				 (objectRepresentation
  					genGetInstanceOf: self ssTop constant
  						into: resultReg
  							initializingIf: self extBSpecifiesInitializeInstance) ~= 0 ifTrue:
  					[^ShouldNotJIT]. "e.g. bad class"
+ 				 self ssPop: 1] .
+ 			[20] ->	"20 	identityHash"
+ 				[self ssTop popToReg: rcvrReg.
+ 				 objectRepresentation genGetHashFieldNonImmOf: rcvrReg asSmallIntegerInto: resultReg.
+ 				 self ssPop: 1] .
+ 					"21		identityHash (SmallInteger)"
+ 					"22		identityHash (Character)"
+ 					"23		identityHash (SmallFloat64)"
+ 					"24		identityHash (Behavior)"
+ 					"30 	immediateAsInteger (Character)
+ 					 31 	immediateAsInteger (SmallFloat64)"
+ 			[30] -> 
+ 				[self ssTop popToReg: rcvrReg.
+ 				 objectRepresentation genConvertCharacterToSmallIntegerInReg: rcvrReg.
  				 self ssPop: 1]
  				  }
+ 				
  		otherwise:
  			[^EncounteredUnknownBytecode].
  	extB := 0.
  	numExtB := 0.
  	self ssPushRegister: resultReg.
  	^0!

Item was added:
+ ----- Method: SistaRegisterAllocatingCogit>>genExtJumpIfNotInstanceOfBehaviorsBytecode (in category 'bytecode generators') -----
+ genExtJumpIfNotInstanceOfBehaviorsBytecode
+ 	"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 inverse |
+ 
+ 	"We lose 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 allocateRegForStackEntryAt: 0.
+ 	self ssTop popToReg: reg.
+ 	self ssPop: 1.
+ 
+ 	literal := self getLiteral: (extA * 256 + byte1).
+ 	(inverse := extB < 0) ifTrue:
+ 		[extB := extB + 128].
+ 	distance := extB * 256 + byte2.
+ 	extA := extB := numExtB := 0.
+ 
+ 	"For now just deny we're in the situation we have yet to implement ;-)"
+ 	self deny: (self mergeRequiredForJumpTo: bytecodePC + 3 + distance).
+ 
+ 	targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance - initialPC) to: #'AbstractInstruction *'.
+ 	inverse
+ 		ifFalse: 
+ 			[(objectMemory isArrayNonImm: literal)
+ 				ifTrue: [objectRepresentation branchIf: reg notInstanceOfBehaviors: literal target: targetFixUp]
+ 				ifFalse: [objectRepresentation branchIf: reg notInstanceOfBehavior: literal target: targetFixUp] ]
+ 		ifTrue:
+ 			[(objectMemory isArrayNonImm: literal)
+ 				ifTrue: [objectRepresentation branchIf: reg instanceOfBehaviors: literal target: targetFixUp]
+ 				ifFalse: [objectRepresentation branchIf: reg instanceOfBehavior: literal target: targetFixUp]].
+ 
+ 	^0!

Item was changed:
  ----- Method: SistaRegisterAllocatingCogit>>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>
  	| ok counterAddress countTripped retry nextPC nextDescriptor desc eventualTarget reg |
  	<var: #ok type: #'AbstractInstruction *'>
  	<var: #desc type: #'CogSimStackEntry *'>
  	<var: #retry type: #'AbstractInstruction *'>
  	<var: #countTripped type: #'AbstractInstruction *'>
  	<var: #nextDescriptor type: #'BytecodeDescriptor *'>
  
  	"In optimized code we don't generate counters to improve performance"
  	(coInterpreter isOptimizedMethod: methodObj) ifTrue:
  		[^super genJumpIf: boolean to: targetBytecodePC].
  	
  	"If the branch is reached only for the counter trip trampoline 
  	(typically, var1 == var2 ifTrue: falls through to the branch only for the trampoline)
  	we generate a specific path to drastically reduce the number of machine instructions"
  	branchReachedOnlyForCounterTrip ifTrue: 
  		[branchReachedOnlyForCounterTrip := false.
  		 ^self genCounterTripOnlyJumpIf: boolean to: targetBytecodePC].
  
  	"We detect and: / or:, if found, we don't generate the counters to avoid pathological counter slow down"
  	boolean = objectMemory falseObject ifTrue:
  		[ nextPC := bytecodePC + (self generatorAt: byte0) numBytes.
  		  nextDescriptor := self generatorAt: (objectMemory fetchByte: nextPC ofObject: methodObj) + bytecodeSetOffset.
  		  nextDescriptor generator ==  #genPushConstantTrueBytecode ifTrue: [ ^ super genJumpIf: boolean to: targetBytecodePC ].
  		  nextDescriptor := self generatorAt: (objectMemory fetchByte: targetBytecodePC ofObject: methodObj) + bytecodeSetOffset.
  		  nextDescriptor generator == #genPushConstantFalseBytecode ifTrue: [ ^ super genJumpIf: boolean to: targetBytecodePC ]. ].
  
  	extA := 0. "We ignore the noMustBeBoolean flag. It should not be present in methods with counters, and if it is we don't care."
  
  	"We don't generate counters on branches on true/false, the basicblock usage can be inferred"
  	desc := self ssTop.
  	(desc type == SSConstant
  	 and: [desc constant = objectMemory trueObject or: [desc constant = objectMemory falseObject]]) ifTrue:
  		[ ^ super genJumpIf: boolean to: targetBytecodePC ].
  
  	eventualTarget := self eventualTargetOf: targetBytecodePC.
  
  	self flag: 'Because of the restriction on x64 that absolute loads must target %rax, it would perhaps be a better choice to use TempReg (%rax) for the counter reg and SendNumArgsReg for the boolean.'.
+ 	"try and use the top entry's register if any, but only if it can be destroyed."
- 	"try and use the top entry's register if ant, but only if it can be destroyed."
  	reg := (desc type ~= SSRegister
  			or: [(self anyReferencesToRegister: desc register inAllButTopNItems: 0)
  			or: [(desc register = ReceiverResultReg and: [optStatus isReceiverResultRegLive])]])
  				ifTrue: [TempReg]
  				ifFalse: [desc register].
  	desc popToReg: reg.
  	self ssPop: 1.
  
  	"We need SendNumArgsReg because of the mustBeBooleanTrampoline"
  	self ssAllocateRequiredReg: SendNumArgsReg.
  
  	retry := self Label.
  	self 
  		genExecutionCountLogicInto: [ :cAddress :countTripBranch | 
  			counterAddress := cAddress. 
  			countTripped := countTripBranch ] 
  		counterReg: SendNumArgsReg.
  	counterIndex := counterIndex + 1.
  
  	"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 genSubConstant: boolean R: reg.
  	self JumpZero: (self ensureFixupAt: eventualTarget - initialPC).
  
  	self genFallsThroughCountLogicCounterReg: SendNumArgsReg counterAddress: counterAddress.
  
  	self CmpCq: (boolean = objectMemory falseObject
  					ifTrue: [objectMemory trueObject - objectMemory falseObject]
  					ifFalse: [objectMemory falseObject - objectMemory trueObject])
  		R: reg.
  	ok := self JumpZero: 0.
  	self MoveCq: 0 R: SendNumArgsReg. "if counterReg is 0 this is a mustBeBoolean, not a counter trip."
  	reg ~= TempReg ifTrue:
  		[self MoveR: reg R: TempReg].
  	countTripped jmpTarget: self Label.
  	self copySimStackToScratch: simSpillBase.
  	self ssFlushTo: simStackPtr.
  	self genCallMustBeBooleanFor: boolean.
  						
  	"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 preserves register state when taking the ceCounterTripped: path."
  	"Clément: For some reason if I write self annotateBytecode: (self Jump: retry) the annotation is not at the correct place."
  	"Eliot: Annotations apply the the address following an instruction, and the annotation must be for the return address
  	 of the call (since this is the address the run-time sees), so it must be on a label before the jump, not after the jump."
  	self annotateBytecode: self Label.
  	simSpillBase ~= scratchSpillBase ifTrue:
  		[self assert: simSpillBase > scratchSpillBase.
  		 self AddCq: simSpillBase - scratchSpillBase * objectMemory wordSize R: SPReg].
  	self Jump: retry.
  
  	ok jmpTarget: self Label.
  	self restoreSimStackFromScratch.
  	^0!

Item was removed:
- ----- Method: StackToRegisterMappingCogit>>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 allocateRegForStackEntryAt: 0.
- 	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.
- 	numExtB := 0.
- 	
- 	targetFixUp := self cCoerceSimple: (self ensureFixupAt: bytecodePC + 3 + distance - initialPC) to: #'AbstractInstruction *'.
- 		
- 	(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: StackToRegisterMappingCogit>>ssFlushTo:nativeFlushTo: (in category 'simulation stack') -----
  ssFlushTo: index nativeFlushTo: nativeIndex
  	LowcodeVM ifTrue:
  		[self ssNativeFlushTo: nativeIndex].
  	0 to: methodOrBlockNumTemps - 1 do:
  		[:i| self assert: ((self simStackAt: i) type = SSBaseOffset
  						or: [self maybeCompilingFirstPassOfBlockWithInitialPushNil])].
+ 	methodOrBlockNumTemps to: simSpillBase - 1 do: "simSpillBase and simStackPtr are 0-relative"
- 	methodOrBlockNumTemps to: simSpillBase - 1 do:
  		[:i| self assert: (self simStackAt: i) spilled].
  	simSpillBase <= index ifTrue:
  		[(simSpillBase max: methodOrBlockNumTemps) to: index do:
  			[:i|
  			self assert: needsFrame.
  			(self simStackAt: i)
  				ensureSpilledAt: (self frameOffsetOfTemporary: i)
  				from: FPReg].
  		 simSpillBase := index + 1]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>traceDescriptor: (in category 'simulation only') -----
  traceDescriptor: descriptor
  	<cmacro: '(ign) 0'>
  	(compilationTrace anyMask: 2) ifTrue:
+ 		[coInterpreter transcript cr; print: bytecodePC; space; nextPutAll: descriptor generator.
+ 		 deadCode ifTrue: [coInterpreter transcript nextPutAll: ' => deadCode'].
+ 		 coInterpreter flush]!
- 		[coInterpreter transcript cr; print: bytecodePC; space; nextPutAll: descriptor generator; flush]!



More information about the Vm-dev mailing list