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

commits at source.squeak.org commits at source.squeak.org
Thu Feb 9 18:06:54 UTC 2017


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

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

Name: VMMaker.oscog-eem.2126
Author: eem
Time: 9 February 2017, 10:05:18.350707 am
UUID: b4988a08-e56d-4b09-935e-631c2ae081cd
Ancestors: VMMaker.oscog-eem.2124, VMMaker.oscogSPC-eem.2126

Merge with VMMaker.oscogSPC-eem.2125 & VMMaker.oscogSPC-eem.2126

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

Item was changed:
  CogClass subclass: #Cogit
  	instanceVariableNames: 'coInterpreter objectMemory objectRepresentation processor threadManager methodZone methodZoneBase codeBase minValidCallAddress lastNInstructions simulatedAddresses simulatedTrampolines simulatedVariableGetters simulatedVariableSetters printRegisters printInstructions compilationTrace clickConfirm breakPC breakBlock singleStep guardPageSize traceFlags traceStores breakMethod methodObj enumeratingCogMethod methodHeader initialPC endPC methodOrBlockNumArgs inBlock needsFrame hasYoungReferent primitiveIndex backEnd literalsManager postCompileHook methodLabel stackCheckLabel blockEntryLabel blockEntryNoContextSwitch blockNoContextSwitchOffset stackOverflowCall sendMiss missOffset entryPointMask checkedEntryAlignment uncheckedEntryAlignment cmEntryOffset entry cmNoCheckEntryOffset noCheckEntry fullBlockEntry cbEntryOffset fullBlockNoContextSwitchEntry cbNoSwitchEntryOffset picMNUAbort picInterpretAbort endCPICCase0 endCPICCase1 firstCPICCaseOffset cPICCaseSize cP
 ICEndSize closedPICSize openPICSize fixups abstractOpcodes generatorTable byte0 byte1 byte2 byte3 bytecodePC bytecodeSetOffset opcodeIndex numAbstractOpcodes blockStarts blockCount labelCounter cStackAlignment expectedSPAlignment expectedFPAlignment codeModified maxLitIndex ceMethodAbortTrampoline cePICAbortTrampoline ceCheckForInterruptTrampoline ceCPICMissTrampoline ceReturnToInterpreterTrampoline ceBaseFrameReturnTrampoline ceSendMustBeBooleanAddTrueTrampoline ceSendMustBeBooleanAddFalseTrampoline ceCannotResumeTrampoline ceEnterCogCodePopReceiverReg ceCallCogCodePopReceiverReg ceCallCogCodePopReceiverAndClassRegs cePrimReturnEnterCogCode cePrimReturnEnterCogCodeProfiling ceNonLocalReturnTrampoline ceFetchContextInstVarTrampoline ceStoreContextInstVarTrampoline ceEnclosingObjectTrampoline ceFlushICache ceCheckFeaturesFunction ceTraceLinkedSendTrampoline ceTraceBlockActivationTrampoline ceTraceStoreTrampoline ceGetFP ceGetSP ceCaptureCStackPointers ordinarySendTrampolines superSen
 dTrampolines directedSuperSendTrampolines dynamicSuperSendTrampolines outerSendTrampolines selfSendTrampolines firstSend lastSend realCEEnterCogCodePopReceiverReg realCECallCogCodePopReceiverReg realCECallCogCodePopReceiverAndClassRegs trampolineTableIndex trampolineAddresses objectReferencesInRuntime runtimeObjectRefIndex cFramePointerInUse debugPrimCallStackOffset ceTryLockVMOwner ceUnlockVMOwner extA extB numExtB tempOop numIRCs indexOfIRC theIRCs implicitReceiverSendTrampolines cogMethodSurrogateClass cogBlockMethodSurrogateClass nsSendCacheSurrogateClass CStackPointer CFramePointer cPICPrototype cPICEndOfCodeOffset cPICEndOfCodeLabel maxCPICCases debugBytecodePointers debugOpcodeIndices disassemblingMethod ceMallocTrampoline ceFreeTrampoline ceFFICalloutTrampoline'
  	classVariableNames: 'AltBlockCreationBytecodeSize AltFirstSpecialSelector AltNSSendIsPCAnnotated AltNumSpecialSelectors AnnotationConstantNames AnnotationShift AnnotationsWithBytecodePCs BlockCreationBytecodeSize Debug DisplacementMask DisplacementX2N EagerInstructionDecoration FirstAnnotation FirstSpecialSelector HasBytecodePC IsAbsPCReference IsAnnotationExtension IsDirectedSuperSend IsDisplacementX2N IsNSDynamicSuperSend IsNSImplicitReceiverSend IsNSSelfSend IsNSSendCall IsObjectReference IsRelativeCall IsSendCall IsSuperSend MapEnd MaxCPICCases MaxCompiledPrimitiveIndex MaxStackAllocSize MaxX2NDisplacement NSCClassTagIndex NSCEnclosingObjectIndex NSCNumArgsIndex NSCSelectorIndex NSCTargetIndex NSSendIsPCAnnotated NeedsFixupFlag NumObjRefsInRuntime NumOopsPerNSC NumSpecialSelectors NumTrampolines ProcessorClass RRRName'
  	poolDictionaries: 'CogAbstractRegisters CogCompilationConstants CogMethodConstants CogRTLOpcodes VMBasicConstants VMBytecodeConstants VMObjectIndices VMStackFrameOffsets'
  	category: 'VMMaker-JIT'!
  Cogit class
  	instanceVariableNames: 'generatorTable primitiveTable'!
  
+ !Cogit commentStamp: 'eem 2/9/2017 10:01' prior: 0!
- !Cogit commentStamp: 'eem 4/6/2015 15:56' prior: 0!
  I am the code generator for the Cog VM.  My job is to produce machine code versions of methods for faster execution and to manage inline caches for faster send performance.  I can be tested in the current image using my class-side in-image compilation facilities.  e.g. try
  
  	StackToRegisterMappingCogit genAndDis: (Integer >> #benchFib)
  
  I have concrete subclasses that implement different levels of optimization:
  	SimpleStackBasedCogit is the simplest code generator.
  
  	StackToRegisterMappingCogit is the current production code generator  It defers pushing operands
  	to the stack until necessary and implements a register-based calling convention for low-arity sends.
  
  	StackToRegisterMappingCogit is an experimental code generator with support for counting
  	conditional branches, intended to support adaptive optimization.
  
  coInterpreter <CoInterpreterSimulator>
  	the VM's interpreter with which I cooperate
  methodZoneManager <CogMethodZoneManager>
  	the manager of the machine code zone
  objectRepresentation <CogObjectRepresentation>
  	the object used to generate object accesses
  processor <BochsIA32Alien|?>
  	the simulator that executes the IA32/x86 machine code I generate when simulating execution in Smalltalk
  simulatedTrampolines <Dictionary of Integer -> MessageSend>
  	the dictionary mapping trap jump addresses to run-time routines used to warp from simulated machine code in to the Smalltalk run-time.
  simulatedVariableGetters <Dictionary of Integer -> MessageSend>
  	the dictionary mapping trap read addresses to variables in run-time objects used to allow simulated machine code to read variables in the Smalltalk run-time.
  simulatedVariableSetters <Dictionary of Integer -> MessageSend>
  	the dictionary mapping trap write addresses to variables in run-time objects used to allow simulated machine code to write variables in the Smalltalk run-time.
  printRegisters printInstructions clickConfirm <Boolean>
  	flags controlling debug printing and code simulation
  breakPC <Integer>
  	machine code pc breakpoint
  cFramePointer cStackPointer <Integer>
  	the variables representing the C stack & frame pointers, which must change on FFI callback and return
  selectorOop <sqInt>
  	the oop of the methodObj being compiled
  methodObj <sqInt>
  	the bytecode method being compiled
  initialPC endPC <Integer>
  	the start and end pcs of the methodObj being compiled
  methodOrBlockNumArgs <Integer>
  	argument count of current method or block being compiled
  needsFrame <Boolean>
  	whether methodObj or block needs a frame to execute
  primitiveIndex <Integer>
  	primitive index of current method being compiled
  methodLabel <CogAbstractOpcode>
  	label for the method header
  blockEntryLabel <CogAbstractOpcode>
  	label for the start of the block dispatch code
  stackOverflowCall <CogAbstractOpcode>
  	label for the call of ceStackOverflow in the method prolog
  sendMissCall <CogAbstractOpcode>
  	label for the call of ceSICMiss in the method prolog
  entryOffset <Integer>
  	offset of method entry code from start (header) of method
  entry <CogAbstractOpcode>
  	label for the first instruction of the method entry code
  noCheckEntryOffset <Integer>
  	offset of the start of a method proper (after the method entry code) from start (header) of method
  noCheckEntry <CogAbstractOpcode>
  	label for the first instruction of start of a method proper
  fixups <Array of <AbstractOpcode Label | nil>>
+ 	the labels for forward jumps that will be fixed up when reaching the relevant bytecode.  fixups has one element per byte in methodObj's bytecode; initialPC maps to fixups[0].
- 	the labels for forward jumps that will be fixed up when reaching the relevant bytecode.  fixup shas one element per byte in methodObj's bytecode
  abstractOpcodes <Array of <AbstractOpcode>>
  	the code generated when compiling methodObj
  byte0 byte1 byte2 byte3 <Integer>
  	individual bytes of current bytecode being compiled in methodObj
  bytecodePointer <Integer>
  	bytecode pc (same as Smalltalk) of the current bytecode being compiled
  opcodeIndex <Integer>
  	the index of the next free entry in abstractOpcodes (this code is translated into C where OrderedCollection et al do not exist)
  numAbstractOpcodes <Integer>
  	the number of elements in abstractOpcocdes
  blockStarts <Array of <BlockStart>>
  	the starts of blocks in the current method
  blockCount
  	the index into blockStarts as they are being noted, and hence eventually the total number of blocks in the current method
  labelCounter <Integer>
  	a nicety for numbering labels not needed in the production system but probably not expensive enough to worry about
  ceStackOverflowTrampoline <Integer>
  ceSend0ArgsTrampoline <Integer>
  ceSend1ArgsTrampoline <Integer>
  ceSend2ArgsTrampoline <Integer>
  ceSendNArgsTrampoline <Integer>
  ceSendSuper0ArgsTrampoline <Integer>
  ceSendSuper1ArgsTrampoline <Integer>
  ceSendSuper2ArgsTrampoline <Integer>
  ceSendSuperNArgsTrampoline <Integer>
  ceSICMissTrampoline <Integer>
  ceCPICMissTrampoline <Integer>
  ceStoreCheckTrampoline <Integer>
  ceReturnToInterpreterTrampoline <Integer>
  ceBaseFrameReturnTrampoline <Integer>
  ceSendMustBeBooleanTrampoline <Integer>
  ceClosureCopyTrampoline <Integer>
  	the various trampolines (system-call-like jumps from machine code to the run-time).
  	See Cogit>>generateTrampolines for the mapping from trampoline to run-time
  	routine and then read the run-time routine for a funcitonal description.
  ceEnterCogCodePopReceiverReg <Integer>
  	the enilopmart (jump from run-time to machine-code)
  methodZoneBase <Integer>
  !
  Cogit class
  	instanceVariableNames: 'generatorTable primitiveTable'!

Item was changed:
  ----- Method: Cogit>>compileAbstractInstructionsFrom:through: (in category 'compile abstract instructions') -----
  compileAbstractInstructionsFrom: start through: end
  	"Loop over bytecodes, dispatching to the generator for each bytecode, handling fixups in due course."
  	| nextOpcodeIndex descriptor fixup result nExts |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	<var: #fixup type: #'BytecodeFixup *'>
  	bytecodePC := start.
  	nExts := result := 0.
  	descriptor := nil.
  	[self maybeHaltIfDebugPC.
  	 descriptor := self loadBytesAndGetDescriptor.
  	 nextOpcodeIndex := opcodeIndex.
  	 result := self perform: descriptor generator.
  	 self assertExtsAreConsumed: descriptor.
+ 	 fixup := self fixupAt: bytecodePC.
- 	 fixup := self fixupAt: bytecodePC - initialPC.
  	 self patchFixupTargetIfNeeded: fixup nextOpcodeIndex: nextOpcodeIndex.
  	 self maybeDumpLiterals: descriptor.
  	 bytecodePC := self nextBytecodePCFor: descriptor exts: nExts.
  	 result = 0 and: [bytecodePC <= end]]
  		whileTrue:
  			[nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
  	self checkEnoughOpcodes.
  	^result!

Item was changed:
  ----- Method: Cogit>>ensureFixupAt: (in category 'compile abstract instructions') -----
  ensureFixupAt: targetPC
  	"Make sure there's a flagged fixup at the target pc in fixups.
  	 Initially a fixup's target is just a flag.  Later on it is replaced with a proper instruction."
  	<returnTypeC: #'BytecodeFixup *'>
  	| fixup |
  	<var: #fixup type: #'BytecodeFixup *'>
+ 	fixup := self fixupAt: targetPC.
- 	fixup := self fixupAt: targetPC - initialPC.
  	fixup notAFixup ifTrue:
  		[fixup becomeFixup].
  	fixup recordBcpc: bytecodePC.
  	^fixup!

Item was changed:
  ----- Method: Cogit>>fixupAt: (in category 'compile abstract instructions') -----
+ fixupAt: fixupPC
+ 	<inline: true>
+ 	^self fixupAtIndex: fixupPC - initialPC!
- fixupAt: index
- 	<cmacro: '(index) (&fixups[index])'>
- 	<returnTypeC: #'BytecodeFixup *'>
- 	^self addressOf: (fixups at: index)!

Item was added:
+ ----- Method: Cogit>>fixupAtIndex: (in category 'compile abstract instructions') -----
+ fixupAtIndex: index
+ 	"The fixups Array maps to bytecode pcs such that initialPC maps to index 0.
+ 	 fixupAt: does the conversion."
+ 	<cmacro: '(index) (&fixups[index])'>
+ 	<returnTypeC: #'BytecodeFixup *'>
+ 	^self addressOf: (fixups at: index)!

Item was changed:
  ----- Method: Cogit>>generateInstructionsAt: (in category 'generate machine code') -----
  generateInstructionsAt: eventualAbsoluteAddress
  	"Size pc-dependent instructions and assign eventual addresses to all instructions.
  	 Answer the size of the code.
  	 Compute forward branches based on virtual address (abstract code starts at 0),
  	 assuming that any branches branched over are long.
  	 Compute backward branches based on actual address.
  	 Reuse the fixups array to record the pc-dependent instructions that need to have
  	 their code generation postponed until after the others."
  	| absoluteAddress pcDependentIndex abstractInstruction fixup |
  	<var: #abstractInstruction type: #'AbstractInstruction *'>
  	<var: #fixup type: #'BytecodeFixup *'>
  	absoluteAddress := eventualAbsoluteAddress.
  	pcDependentIndex := 0.
  	0 to: opcodeIndex - 1 do:
  		[:i|
  		self maybeBreakGeneratingAt: absoluteAddress.
  		abstractInstruction := self abstractInstructionAt: i.
  		abstractInstruction isPCDependent
  			ifTrue:
  				[abstractInstruction sizePCDependentInstructionAt: absoluteAddress.
+ 				 fixup := self fixupAtIndex: pcDependentIndex.
- 				 fixup := self fixupAt: pcDependentIndex.
  				 pcDependentIndex := pcDependentIndex + 1.
  				 fixup instructionIndex: i.
  				 absoluteAddress := absoluteAddress + abstractInstruction machineCodeSize]
  			ifFalse:
  				[absoluteAddress := abstractInstruction concretizeAt: absoluteAddress]].
  	0 to: pcDependentIndex - 1 do:
  		[:j|
+ 		fixup := self fixupAtIndex: j.
- 		fixup := self fixupAt: j.
  		abstractInstruction := self abstractInstructionAt: fixup instructionIndex.
  		self maybeBreakGeneratingAt: abstractInstruction address.
  		abstractInstruction concretizeAt: abstractInstruction address].
  	^absoluteAddress - eventualAbsoluteAddress!

Item was changed:
  ----- Method: Cogit>>initializeFixupAt: (in category 'compile abstract instructions') -----
+ initializeFixupAt: targetPC
+ 	"Make sure there's a flagged fixup at the targetPC in fixups.
- initializeFixupAt: targetIndex
- 	"Make sure there's a flagged fixup at the targetIndex (pc relative to first pc) in fixups.
  	 Initially a fixup's target is just a flag.  Later on it is replaced with a proper instruction."
  	<returnTypeC: #'BytecodeFixup *'>
+ 	(self fixupAt: targetPC) becomeFixup!
- 	(self fixupAt: targetIndex) becomeFixup!

Item was changed:
  ----- Method: Cogit>>scanMethod (in category 'compile abstract instructions') -----
  scanMethod
  	"Scan the method (and all embedded blocks) to determine
  		- what the last bytecode is; extra bytes at the end of a method are used to encode things like source pointers or temp names
  		- if the method needs a frame or not
  		- what are the targets of any backward branches.
  		- how many blocks it creates
  		- if it contans an unknown bytecode
  	 Answer the block count or on error a negative error code"
  	| latestContinuation nExts descriptor pc numBlocks distance targetPC framelessStackDelta |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	needsFrame := false.
  	NewspeakVM ifTrue:
  		[numIRCs := 0].
  	(primitiveIndex > 0
  	 and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
  		[^0].
  	pc := latestContinuation := initialPC.
  	numBlocks := framelessStackDelta := nExts := extA := numExtB := extB := 0.
  	[pc <= endPC] whileTrue:
  		[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
  		 descriptor := self generatorAt: byte0.
  		 descriptor isExtension ifTrue:
  			[descriptor opcode = Nop ifTrue: "unknown bytecode tag; see Cogit class>>#generatorTableFrom:"
  				[^EncounteredUnknownBytecode].
  			 self loadSubsequentBytesForDescriptor: descriptor at: pc.
  			 self perform: descriptor generator].
  		 (descriptor isReturn
  		  and: [pc >= latestContinuation]) ifTrue:
  			[endPC := pc].
  		 needsFrame ifFalse:
  			[(descriptor needsFrameFunction isNil
  			  or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
  				ifTrue: [needsFrame := true]
  				ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]].
  		 descriptor isBranch ifTrue:
  			[distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  			 targetPC := pc + descriptor numBytes + distance.
  			 (self isBackwardBranch: descriptor at: pc exts: nExts in: methodObj)
+ 				ifTrue: [self initializeFixupAt: targetPC]
- 				ifTrue: [self initializeFixupAt: targetPC - initialPC]
  				ifFalse: [latestContinuation := latestContinuation max: targetPC]].
  		 descriptor isBlockCreation ifTrue:
  			[numBlocks := numBlocks + 1.
  			 distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  			 targetPC := pc + descriptor numBytes + distance.
  			 latestContinuation := latestContinuation max: targetPC].
  		 NewspeakVM ifTrue:
  			[descriptor hasIRC ifTrue:
  				[numIRCs := numIRCs + 1]].
  		 pc := pc + descriptor numBytes.
  		 descriptor isExtension
  			ifTrue: [nExts := nExts + 1]
  			ifFalse: [nExts := extA := numExtB := extB := 0]].
  	^numBlocks!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>ensureFixupAt: (in category 'bytecode generator support') -----
  ensureFixupAt: targetPC
  	"Make sure there's a flagged fixup at the target pc in fixups.
  	 Initially a fixup's target is just a flag.  Later on it is replaced with a proper instruction.
  	 Override to enerate stack merging code if required."
  	| fixup |	
  	<var: #fixup type: #'BytecodeFixup *'>
+ 	fixup := self fixupAt:  targetPC.
- 	fixup := self fixupAt:  targetPC - initialPC.
  	fixup needsFixup 
  		ifTrue:
  			[fixup mergeSimStack
  				ifNil: [self setMergeSimStackOf: fixup]
  				ifNotNil: [self mergeCurrentSimStackWith: fixup]]
  		ifFalse: 
  			[self assert: fixup mergeSimStack isNil.
  			 self moveVolatileSimStackEntriesToRegisters.
  			 self setMergeSimStackOf: fixup].
  	^super ensureFixupAt: targetPC!

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 printSimStack; printSimStack: (self fixupAt: postBranchPC) mergeSimStack"
- 	 self printSimStack; printSimStack: (self fixupAt: postBranchPC - initialPC) mergeSimStack"
  	self deny: (self mergeRequiredForJumpTo: targetBytecodePC).
  	self deny: (self mergeRequiredForJumpTo: postBranchPC).
  
  	"Further since there is a following conditional jump bytecode, define
  	 non-merge fixups and leave the cond bytecode to set the mergeness."
+ 	(self fixupAt: nextPC) notAFixup
- 	(self fixupAt: nextPC - initialPC) notAFixup
  		ifTrue: "The next instruction is dead.  we can skip it."
  			[deadCode := true.
  		 	 self ensureFixupAt: targetBytecodePC.
  			 self ensureFixupAt: postBranchPC]
  		ifFalse:
  			[self deny: deadCode]. "push dummy value below"
  
  	self assert: (unforwardArg or: [unforwardRcvr]).
  	orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
  		ifFalse: "branchDescriptor is branchFalse"
  			[ fixup := (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger.
  			self JumpZero:  (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger ]
  		ifTrue:
  			[ fixup := (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
  			self JumpZero: (self ensureNonMergeFixupAt: postBranchPC) 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>>genJumpBackTo: (in category 'bytecode generator support') -----
  genJumpBackTo: targetBytecodePC
  	| nothingToFlush label |
  	<var: #label type: #'AbstractInstruction *'>
  	"If there's nothing to flush then the stack state at this point is the same as that after
  	 the check for interrups and we can avoid generating the register reload code twice."
  	(nothingToFlush := simStackPtr < 0 or: [self ssTop spilled]) ifTrue:
  		[label := self Label].
+ 	self reconcileRegisterStateForBackwardJoin: (self fixupAt: targetBytecodePC).
- 	self reconcileRegisterStateForBackwardJoin: (self fixupAt: targetBytecodePC - initialPC).
  	self MoveAw: coInterpreter stackLimitAddress R: TempReg.
  	self CmpR: TempReg R: SPReg. "N.B. FLAGS := SPReg - TempReg"
+ 	self JumpAboveOrEqual: (self fixupAt: targetBytecodePC).
- 	self JumpAboveOrEqual: (self fixupAt: targetBytecodePC - initialPC).
  
  	self ssFlushTo: simStackPtr.
  	self CallRT: ceCheckForInterruptTrampoline.
  	self annotateBytecode: self Label.
  	nothingToFlush
  		ifTrue:
  			[self Jump: label]
  		ifFalse:
+ 			[self reconcileRegisterStateForBackwardJoin: (self fixupAt: targetBytecodePC).
+ 			 self Jump: (self fixupAt: targetBytecodePC)].
- 			[self reconcileRegisterStateForBackwardJoin: (self fixupAt: targetBytecodePC - initialPC).
- 			 self Jump: (self fixupAt: targetBytecodePC - initialPC)].
  	deadCode := true. "can't fall through"
  	^0!

Item was changed:
  ----- Method: RegisterAllocatingCogit>>genStorePop:TemporaryVariable: (in category 'bytecode generator support') -----
  genStorePop: popBoolean TemporaryVariable: tempIndex
  	<inline: false>
  	| srcRegOrNone destReg |
  	self ssFlushUpThroughTemporaryVariable: tempIndex.
  	"To avoid a stall writing through destReg, remember srcReg before the potential ssPop: 1 in ssStorePop:toReg:"
  	srcRegOrNone := self ssTop registerOrNone.
  	"ssStorePop:toPreferredReg: will allocate a register, and indeed may allocate ReceiverResultReg
  	 if, for example, the ssEntry to be popped is already in ReceiverResultReg (as the result of a send).
  	 ReceiverResultReg is not a good choice for a temporary variable; it has other uses.  So if the ssEntry
  	 at top of stack has ReceiverResultReg as its live variable, try and allocate an alternative."
+ 	((self ssTop type = SSConstant
+ 	  or: [self ssTop registerMaskOrNone anyMask: self registerMaskUndesirableForTempVars])
- 	((self ssTop registerMaskOrNone anyMask: self registerMaskUndesirableForTempVars)
  	 and: [(destReg := self availableRegOrNoneNotConflictingWith: (self registerMaskUndesirableForTempVars bitOr: self liveRegisters)) ~= NoReg])
  		ifTrue: [self ssStorePop: popBoolean toReg: destReg]
  		ifFalse: [destReg := self ssStorePop: popBoolean toPreferredReg: TempReg].
  	self MoveR: (srcRegOrNone ~= NoReg ifTrue: [srcRegOrNone] ifFalse: [destReg])
  		Mw: (self frameOffsetOfTemporary: tempIndex)
  		r: FPReg.
  	destReg ~= TempReg ifTrue:
  		[(self simStackAt: tempIndex) liveRegister: destReg.
  		 self copyLiveRegisterToCopiesOf: (self simStackAt: tempIndex)].
  	^0!

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

Item was changed:
  ----- Method: RegisterAllocatingCogit>>mergeRequiredForJumpTo: (in category 'bytecode generator support') -----
  mergeRequiredForJumpTo: targetPC
  	"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: targetPC) hasMergeSimStack!
- 	^(self fixupAt: targetPC - initialPC) hasMergeSimStack!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genJumpBackTo: (in category 'bytecode generator support') -----
  genJumpBackTo: targetBytecodePC
  	self MoveAw: coInterpreter stackLimitAddress R: TempReg.
  	self CmpR: TempReg R: SPReg. "N.B. FLAGS := SPReg - TempReg"
+ 	self JumpAboveOrEqual: (self fixupAt: targetBytecodePC).
- 	self JumpAboveOrEqual: (self fixupAt: targetBytecodePC - initialPC).
  	self CallRT: ceCheckForInterruptTrampoline.
  	self annotateBytecode: self Label.
+ 	self Jump: (self fixupAt: targetBytecodePC).
- 	self Jump: (self fixupAt: targetBytecodePC - initialPC).
  	^0!

Item was changed:
  ----- Method: SistaCogit>>genBinaryInlineComparison:opFalse:destReg: (in category 'inline primitive generators') -----
  genBinaryInlineComparison: opTrue opFalse: opFalse destReg: destReg
  	"Inlined comparison. opTrue = jump for true and opFalse = jump for false"
  	<var: #branchDescriptor type: #'BytecodeDescriptor *'>
  	| nextPC branchDescriptor targetBytecodePC postBranchPC |	
  		
  	self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target | 
  		branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
  
  	(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse])
  		ifTrue: "This is the path where the inlined comparison is followed immediately by a branch"
+ 			[ (self fixupAt: nextPC) notAFixup
- 			[ (self fixupAt: nextPC - initialPC) notAFixup
  				ifTrue: "The next instruction is dead.  we can skip it."
  					[deadCode := true.
  				 	 self ensureFixupAt: targetBytecodePC.
  					 self ensureFixupAt: postBranchPC ]
  				ifFalse:
  					[self ssPushConstant: objectMemory trueObject]. "dummy value"
  			self genConditionalBranch: (branchDescriptor isBranchTrue ifTrue: [opTrue] ifFalse: [opFalse])
  				operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
  			"We can only elide the jump if the pc after nextPC is the same as postBranchPC.
  			 Branch following means it may not be."
  			self nextDescriptorExtensionsAndNextPCInto:
  				[:iguana1 :iguana2 :iguana3 :followingPC| nextPC := followingPC].
  			(deadCode and: [nextPC = postBranchPC]) ifFalse:
  				[ self Jump: (self ensureNonMergeFixupAt: postBranchPC) ] ]
  		ifFalse: "This is the path where the inlined comparison is *not* followed immediately by a branch"
  			[| condJump jump |
  			condJump := self genConditionalBranch: opTrue operand: 0.
  			self genMoveFalseR: destReg.
  	 		jump := self Jump: 0.
  			condJump jmpTarget: (self genMoveTrueR: destReg).
  			jump jmpTarget: self Label].
  	^ 0!

Item was changed:
  ----- Method: SistaCogit>>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.
  	
  	orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
  		ifFalse:
  			[ fixup := (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger.
  			self JumpZero:  (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger ]
  		ifTrue:
  			[ fixup := (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
  			self JumpZero: (self ensureNonMergeFixupAt: postBranchPC) 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) notAFixup ifTrue: [ branchReachedOnlyForCounterTrip := true ].
- 	(self fixupAt: nextPC - initialPC) notAFixup ifTrue: [ branchReachedOnlyForCounterTrip := true ].
  	
  	^ 0!

Item was changed:
  ----- Method: SistaCogitClone>>genBinaryInlineComparison:opFalse:destReg: (in category 'inline primitive generators') -----
  genBinaryInlineComparison: opTrue opFalse: opFalse destReg: destReg
  	"Inlined comparison. opTrue = jump for true and opFalse = jump for false"
  	<var: #branchDescriptor type: #'BytecodeDescriptor *'>
  	| nextPC branchDescriptor targetBytecodePC postBranchPC |	
  		
  	self extractMaybeBranchDescriptorInto: [ :descr :next :postBranch :target | 
  		branchDescriptor := descr. nextPC := next. postBranchPC := postBranch. targetBytecodePC := target ].
  	
  	(branchDescriptor isBranchTrue or: [branchDescriptor isBranchFalse])
  		ifTrue: "This is the path where the inlined comparison is followed immediately by a branch"
+ 			[ (self fixupAt: nextPC) notAFixup
- 			[ (self fixupAt: nextPC - initialPC) notAFixup
  				ifTrue: "The next instruction is dead.  we can skip it."
  					[deadCode := true.
  				 	 self ensureFixupAt: targetBytecodePC.
  					 self ensureFixupAt: postBranchPC ]
  				ifFalse:
  					[self ssPushConstant: objectMemory trueObject]. "dummy value"
  			self genConditionalBranch: (branchDescriptor isBranchTrue ifTrue: [opTrue] ifFalse: [opFalse])
  				operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger. 
  			deadCode ifFalse: [ self Jump: (self ensureNonMergeFixupAt: postBranchPC) ] ]
  		ifFalse: "This is the path where the inlined comparison is *not* followed immediately by a branch"
  			[| condJump jump |
  			condJump := self genConditionalBranch: opTrue operand: 0.
  			self genMoveFalseR: destReg.
  	 		jump := self Jump: 0.
  			condJump jmpTarget: (self genMoveTrueR: destReg).
  			jump jmpTarget: self Label].
  	^ 0!

Item was changed:
  ----- Method: SistaRegisterAllocatingCogit>>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].
  	
  	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.
  	
  	orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
  		ifFalse:
  			[ fixup := (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger.
  			self JumpZero:  (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger ]
  		ifTrue:
  			[ fixup := (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
  			self JumpZero: (self ensureNonMergeFixupAt: postBranchPC) 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) notAFixup ifTrue: [ branchReachedOnlyForCounterTrip := true ].
- 	(self fixupAt: nextPC - initialPC) notAFixup ifTrue: [ branchReachedOnlyForCounterTrip := true ].
  	
  	^ 0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>compileAbstractInstructionsFrom:through: (in category 'compile abstract instructions') -----
  compileAbstractInstructionsFrom: start through: end
  	"Loop over bytecodes, dispatching to the generator for each bytecode, handling fixups in due course."
  	| nextOpcodeIndex descriptor nExts fixup result |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	<var: #fixup type: #'BytecodeFixup *'>
  	self traceSimStack.
  	bytecodePC := start.
  	nExts := result := 0.
  	descriptor := nil.
  	deadCode := false.
  	[self maybeHaltIfDebugPC.
+ 	 fixup := self fixupAt: bytecodePC.
- 	 fixup := self fixupAt: bytecodePC - initialPC.
  	 self mergeWithFixupIfRequired: fixup.
  	 self assertCorrectSimStackPtr.
  	 descriptor := self loadBytesAndGetDescriptor.
  	 nextOpcodeIndex := opcodeIndex.
  	 result := deadCode
  				ifTrue: [self mapDeadDescriptorIfNeeded: descriptor]
  				ifFalse: [self perform: descriptor generator].
  	 self assertExtsAreConsumed: descriptor.
  	 self traceDescriptor: descriptor; traceSimStack.
  	 self patchFixupTargetIfNeeded: fixup nextOpcodeIndex: nextOpcodeIndex.
  	 self maybeDumpLiterals: descriptor.
  	 bytecodePC := self nextBytecodePCFor: descriptor exts: nExts.
  	 result = 0 and: [bytecodePC <= end]] whileTrue:
  		[nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
  	self checkEnoughOpcodes.
  	^result!

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

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

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>eventualTargetOf: (in category 'peephole optimizations') -----
  eventualTargetOf: targetBytecodePC
  	"Attempt to follow a branch to a pc.  Handle branches to unconditional jumps
  	 and branches to push: aBoolean; conditional branch pairs.  If the branch cannot
  	 be followed answer targetBytecodePC."
  
  	| currentTarget nextPC nExts descriptor span cond |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	nextPC := currentTarget := targetBytecodePC.
  	[ nExts := 0.
  	 [descriptor := self generatorAt: bytecodeSetOffset
  								+ (objectMemory fetchByte: nextPC ofObject: methodObj).
  	  descriptor isReturn ifTrue: [^currentTarget]. "avoid stepping off the end of methods"
  	  descriptor isExtension]
  		whileTrue:
  			[nExts := nExts + 1.
  			 nextPC := nextPC + descriptor numBytes].
  	 descriptor isUnconditionalBranch
  		ifTrue:
  			[span := self spanFor: descriptor at: nextPC exts: nExts in: methodObj.
  			 span < 0 ifTrue: "Do *not* follow backward branches; these are interrupt points and should not be elided."
  				[^currentTarget].
  			 nextPC := nextPC + descriptor numBytes + span]
  		ifFalse:
  			[descriptor generator == #genPushConstantTrueBytecode ifTrue: [ cond := true ]
+ 			 ifFalse: [ descriptor generator == #genPushConstantFalseBytecode ifTrue: [ cond := false ]
+ 			 ifFalse: [ ^currentTarget ] ].
- 			 ifFalse: [ descriptor generator == #genPushConstantFalseBytecode ifTrue: [ cond := false ] 							ifFalse: [ ^currentTarget ] ].
  			 "Don't step into loops across a pushTrue; jump:if: boundary, so as not to confuse stack depth fixup."
+ 			 (self fixupAt: nextPC) isBackwardBranchFixup ifTrue:
- 			 (fixups at: nextPC - initialPC) isBackwardBranchFixup ifTrue:
  				[^currentTarget].
  			 nextPC := self eventualTargetOf: nextPC + descriptor numBytes.
  			 nExts := 0.
  			 [descriptor := self generatorAt: bytecodeSetOffset
  								+ (objectMemory fetchByte: nextPC ofObject: methodObj).
  			  descriptor isReturn ifTrue: [^currentTarget]. "avoid stepping off the end of methods"
  			  descriptor isExtension]
  				whileTrue:
  					[nExts := nExts + 1.
  					 nextPC := nextPC + descriptor numBytes].
  			 descriptor isBranch ifFalse:
  				[^currentTarget].
  			 descriptor isUnconditionalBranch ifTrue:
  				[^currentTarget].
  			 nextPC := cond == descriptor isBranchTrue
  									ifTrue: [nextPC
  											+ descriptor numBytes
  											+ (self spanFor: descriptor at: nextPC exts: nExts in: methodObj)]
  									ifFalse: [nextPC + descriptor numBytes]].
  	 currentTarget := nextPC]
  		repeat!

Item was removed:
- ----- Method: StackToRegisterMappingCogit>>fixupAt: (in category 'compile abstract instructions') -----
- fixupAt: index
- 	<cmacro: '(index) (&fixups[index])'>
- 	<returnTypeC: #'BytecodeFixup *'>
- 	((debugFixupBreaks includes: index)
- 	 and: [breakMethod isNil or: [methodObj = breakMethod]]) ifTrue:
- 		[self halt].
- 	^self addressOf: (fixups at: index)!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>fixupAtIndex: (in category 'compile abstract instructions') -----
+ fixupAtIndex: index
+ 	"The fixups Array maps to bytecode pcs such that initialPC maps to index 0.
+ 	 fixupAt: does the conversion.  Override to add breakpointing for fixups of bytecode PCs."
+ 	<cmacro: '(index) (&fixups[index])'>
+ 	<returnTypeC: #'BytecodeFixup *'>
+ 	((debugFixupBreaks includes: index + initialPC)
+ 	 and: [breakMethod isNil or: [methodObj = breakMethod]]) ifTrue:
+ 		[self halt].
+ 	^self addressOf: (fixups at: index)!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>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].
  	
  	"If branching the stack must be flushed for the merge"
  	self ssFlushTo: simStackPtr - 2.
  	
  	label := self Label.
  	self genCmpArgIsConstant: unforwardArg not rcvrIsConstant: unforwardRcvr not argReg: argReg rcvrReg: rcvrReg.
  	self ssPop: 2.
  
  	"Further since there is a following conditional jump bytecode, define
  	 non-merge fixups and leave the cond bytecode to set the mergeness."
+ 	(self fixupAt: nextPC) notAFixup
- 	(self fixupAt: nextPC - initialPC) notAFixup
  		ifTrue: "The next instruction is dead.  we can skip it."
  			[deadCode := true.
  		 	 self ensureFixupAt: targetBytecodePC.
  			 self ensureFixupAt: postBranchPC]
  		ifFalse:
  			[self deny: deadCode]. "push dummy value below"
  
  	self assert: (unforwardArg or: [unforwardRcvr]).
  	orNot == branchDescriptor isBranchTrue "orNot is true for ~~"
  		ifFalse:
  			[ fixup := (self ensureNonMergeFixupAt: postBranchPC) asUnsignedInteger.
  			self JumpZero:  (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger ]
  		ifTrue:
  			[ fixup := (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
  			self JumpZero: (self ensureNonMergeFixupAt: postBranchPC) 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: StackToRegisterMappingCogit>>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].
  	
  	"If branching the stack must be flushed for the merge"
  	self ssFlushTo: simStackPtr - 2.
  	
  	self genCmpArgIsConstant: argIsConstant rcvrIsConstant: rcvrIsConstant argReg: argReg rcvrReg: rcvrReg.
  	self ssPop: 2.
  
  	"Further since there is a following conditional jump bytecode, define
  	 non-merge fixups and leave the cond bytecode to set the mergeness."
+ 	(self fixupAt: nextPC) notAFixup
- 	(self fixupAt: nextPC - initialPC) notAFixup
  		ifTrue: "The next instruction is dead.  we can skip it."
  			[deadCode := true.
  		 	 self ensureFixupAt: targetBytecodePC.
  			 self ensureFixupAt: postBranchPC]
  		ifFalse:
  			[self deny: deadCode]. "push dummy value below"
  		
  	self genConditionalBranch: (orNot == branchDescriptor isBranchTrue ifTrue: [JumpNonZero] ifFalse: [JumpZero])
  		operand: (self ensureNonMergeFixupAt: targetBytecodePC) asUnsignedInteger.
  
  	"If the branch is dead, then we can just fall through postBranchPC (only a nop in-between), else 
  	we need to jump over the code of the branch"
  	deadCode ifFalse:
  		[self Jump: (self ensureNonMergeFixupAt: postBranchPC).
  		 self ssPushConstant: objectMemory trueObject]. "dummy value"
  	^0!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>generateInstructionsAt: (in category 'generate machine code') -----
  generateInstructionsAt: eventualAbsoluteAddress
  	"Size pc-dependent instructions and assign eventual addresses to all instructions.
  	 Answer the size of the code.
  	 Compute forward branches based on virtual address (abstract code starts at 0),
  	 assuming that any branches branched over are long.
  	 Compute backward branches based on actual address.
  	 Reuse the fixups array to record the pc-dependent instructions that need to have
  	 their code generation postponed until after the others.
  
  	 Override to andd handling for null branches (branches to the immediately following
  	 instruction) occasioned by StackToRegisterMapping's following of jumps."
  	| absoluteAddress pcDependentIndex abstractInstruction fixup |
  	<var: #abstractInstruction type: #'AbstractInstruction *'>
  	<var: #fixup type: #'BytecodeFixup *'>
  	absoluteAddress := eventualAbsoluteAddress.
  	pcDependentIndex := 0.
  	0 to: opcodeIndex - 1 do:
  		[:i|
  		self maybeBreakGeneratingAt: absoluteAddress.
  		abstractInstruction := self abstractInstructionAt: i.
  		abstractInstruction isPCDependent
  			ifTrue:
  				[abstractInstruction sizePCDependentInstructionAt: absoluteAddress.
  				 (abstractInstruction isJump
  				  and: [i + 1 < opcodeIndex
  				  and: [abstractInstruction getJmpTarget == (self abstractInstructionAt: i + 1)]])
  					ifTrue:
  						[abstractInstruction
  							opcode: Nop;
  							concretizeAt: absoluteAddress]
  					ifFalse:
+ 						[fixup := self fixupAtIndex: pcDependentIndex.
- 						[fixup := self fixupAt: pcDependentIndex.
  						 pcDependentIndex := pcDependentIndex + 1.
  						 fixup instructionIndex: i].
  				 absoluteAddress := absoluteAddress + abstractInstruction machineCodeSize]
  			ifFalse:
  				[absoluteAddress := abstractInstruction concretizeAt: absoluteAddress]].
  	0 to: pcDependentIndex - 1 do:
  		[:j|
+ 		fixup := self fixupAtIndex: j.
- 		fixup := self fixupAt: j.
  		abstractInstruction := self abstractInstructionAt: fixup instructionIndex.
  		self maybeBreakGeneratingAt: abstractInstruction address.
  		abstractInstruction concretizeAt: abstractInstruction address].
  	^absoluteAddress - eventualAbsoluteAddress!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>initializeFixupAt: (in category 'compile abstract instructions') -----
+ initializeFixupAt: targetPC
+ 	"Make sure there's a flagged fixup at the targetPC in fixups.
- initializeFixupAt: targetIndex
- 	"Make sure there's a flagged fixup at the targetIndex (pc relative to first pc) in fixups.
  	 These are the targets  of backward branches.  A backward branch fixup's simStackPtr
+ 	 needs to be set when generating the code for the bytecode at the targetPC.
- 	 needs to be set when generating the code for the bytecode at the targetIndex.
  	 Initially a fixup's target is just a flag.  Later on it is replaced with a proper instruction."
  	<returnTypeC: #'BytecodeFixup *'>
  	| fixup |
  	<var: #fixup type: #'BytecodeFixup *'>
+ 	fixup := self fixupAt: targetPC.
- 	fixup := self fixupAt: targetIndex.
  	fixup
  		becomeMergeFixup;
  		setIsBackwardBranchFixup.
  	^fixup!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>reinitializeFixupsFrom:through: (in category 'compile abstract instructions') -----
  reinitializeFixupsFrom: start through: end
  	"When a block must be recompiled due to overestimating the
  	 numInitialNils fixups must be restored, which means rescannning
  	 since backward branches need their targets initialized."
  	| descriptor nExts pc distance targetPC |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	pc := start.
  	nExts := 0.
  	[pc <= end] whileTrue:
+ 		[(self fixupAt: pc) reinitialize.
- 		[(self fixupAt: pc - initialPC) reinitialize.
  		 byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
  		 descriptor := self generatorAt: byte0.
  		 (descriptor isBranch
  		  and: [self isBackwardBranch: descriptor at: pc exts: nExts in: methodObj]) ifTrue:
  			[distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  			 targetPC := pc + descriptor numBytes + distance.
+ 			 self initializeFixupAt: targetPC].
- 			 self initializeFixupAt: targetPC - initialPC].
  		 descriptor isBlockCreation
  			ifTrue:
  				[distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  				 pc := pc + descriptor numBytes + distance]
  			ifFalse: [pc := pc + descriptor numBytes].
  		 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>scanMethod (in category 'compile abstract instructions') -----
  scanMethod
  	"Scan the method (and all embedded blocks) to determine
  		- what the last bytecode is; extra bytes at the end of a method are used to encode things like source pointers or temp names
  		- if the method needs a frame or not
  		- what are the targets of any backward branches.
  		- how many blocks it creates
  	 Answer the block count or on error a negative error code"
  	| latestContinuation nExts descriptor pc numBlocks distance targetPC framelessStackDelta seenInstVarStore |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	needsFrame := useTwoPaths := seenInstVarStore := false.
  	LowcodeVM ifTrue: [ hasNativeFrame := false ].
  	self maybeInitNumFixups.
  	self maybeInitNumCounters.
  	prevBCDescriptor := nil.
  	NewspeakVM ifTrue:
  		[numIRCs := 0].
  	(primitiveIndex > 0
  	 and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
  		[^0].
  	pc := latestContinuation := initialPC.
  	numBlocks := framelessStackDelta := nExts := extA := numExtB := extB := 0.
  	[pc <= endPC] whileTrue:
  		[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
  		 descriptor := self generatorAt: byte0.
  		 descriptor isExtension ifTrue:
  			[descriptor opcode = Nop ifTrue: "unknown bytecode tag; see Cogit class>>#generatorTableFrom:"
  				[^EncounteredUnknownBytecode].
  			 self loadSubsequentBytesForDescriptor: descriptor at: pc.
  			 self perform: descriptor generator].
  		 (descriptor isReturn
  		  and: [pc >= latestContinuation]) ifTrue:
  			[endPC := pc].
  
  		  needsFrame ifFalse:
  			[(descriptor needsFrameFunction isNil
  			  or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
  					ifTrue:
  						["With immutability we win simply by avoiding a frame build if the receiver is young and not immutable."
  						 self cppIf: IMMUTABILITY
  							ifTrue: [descriptor is1ByteInstVarStore
  									ifTrue: [useTwoPaths := true]
  									ifFalse: [needsFrame := true. useTwoPaths := false]]
  							ifFalse: [needsFrame := true. useTwoPaths := false]]
  					ifFalse:
  						[framelessStackDelta := framelessStackDelta + descriptor stackDelta.
  						 "Without immutability we win if there are two or more stores and the receiver is new."
  						 self cppIf: IMMUTABILITY
  							ifTrue: []
  							ifFalse:
  								[descriptor is1ByteInstVarStore ifTrue:
  									[seenInstVarStore
  										ifTrue: [useTwoPaths := true]
  										ifFalse: [seenInstVarStore := true]]]]].
  
  		 descriptor isBranch ifTrue:
  			[distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  			 targetPC := pc + descriptor numBytes + distance.
  			 self maybeCountFixup: descriptor.
  			 (self isBackwardBranch: descriptor at: pc exts: nExts in: methodObj)
+ 				ifTrue: [self initializeFixupAt: targetPC]
- 				ifTrue: [self initializeFixupAt: targetPC - initialPC]
  				ifFalse:
  					[latestContinuation := latestContinuation max: targetPC.
  					 self maybeCountCounter]].
  		 descriptor isBlockCreation ifTrue:
  			[numBlocks := numBlocks + 1.
  			 distance := self spanFor: descriptor at: pc exts: nExts in: methodObj.
  			 targetPC := pc + descriptor numBytes + distance.
  			 latestContinuation := latestContinuation max: targetPC.
  			 self maybeCountFixup: descriptor].
  
  		 NewspeakVM ifTrue:
  			[descriptor hasIRC ifTrue: [numIRCs := numIRCs + 1]].
  		 pc := pc + descriptor numBytes.
  		 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [extA := numExtB := extB := 0].
  		 prevBCDescriptor := descriptor].
  	^numBlocks!



More information about the Vm-dev mailing list