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

commits at source.squeak.org commits at source.squeak.org
Fri May 27 09:44:50 UTC 2016


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

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

Name: VMMaker.oscog-cb.1875
Author: cb
Time: 27 May 2016, 11:43:40.369719 am
UUID: 4da4e9c0-8ef3-4400-b610-73c7959006ce
Ancestors: VMMaker.oscog-eem.1874

Anti-slavery society forms (NY)...

When I benched Immutability/write barrier, games benchmarks had identical performance with and without it (the difference was within noise).

However I built a microbench doing only inst var stores:

Foo>>imm: imm nonImm: nonImm
	iv1 := 1.
	iv2 := #foo. 
	iv3 := imm.
	iv4 := nonImm.

| f |
f := Foo new.
[f imm: 2 nonImm: #bar ] bench   
	
And in this case there was 18.7% overhead with the write barrier. BinaryTree bench has a similar method, use it extensively and yet we can't see the overhead on the whole bench, so it's not that critical, but it's still something which could matter in specific cases.

In this commit I changed the JIT so that (with Immutability/Write barrier ON) methods with only frameless instance variable stores are compiled with two paths. The code first checks if the receiver is immutable/read-only, and takes the right path accordingly. The first path is frameless and does not include immutability/write barrier checks. The second one is frameful and does all the immutability/write barrier checks.

I didn't do it for blocks as I believe blocks with only instance variable store are not that common - I may be wrong, if you prove to me I am wrong on this with numbers, I will do it for blocks.

In the micro-bench shown, #imm:nonImm:, the overhead decreased from 18.7% to 2.6%.

I think this has an impact in general to setter methods.

I made that in a Pharo sprint (or what it matters).

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

Item was changed:
  ----- Method: RegisterAllocatingCogit>>scanMethod (in category 'compile abstract instructions') -----
  scanMethod
  	"Overrides to count the number of fixups."
  	"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 |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	needsFrame := false.
  	numFixups := 0.
  	prevBCDescriptor := nil.
+ 	self
+ 		cppIf: IMMUTABILITY
+ 		ifTrue: [needsTwoPath := false].
  	NewspeakVM ifTrue:
  		[numIRCs := 0].
  	(primitiveIndex > 0
  	 and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
  		[^0].
  	pc := latestContinuation := initialPC.
  	numBlocks := framelessStackDelta := nExts := extA := 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].
+ 		  self
+ 			cppIf: IMMUTABILITY
+ 			ifTrue: [(needsFrame and: [needsTwoPath not])
+ 					ifFalse: [(descriptor needsFrameFunction isNil
+ 								or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
+ 							ifTrue: [needsFrame := true.
+ 								needsTwoPath := descriptor generator == #genStoreAndPopReceiverVariableBytecode]
+ 							ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]]]
+ 			ifFalse: [needsFrame
+ 					ifFalse: [(descriptor needsFrameFunction isNil
+ 								or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
+ 							ifTrue: [needsFrame := true]
+ 							ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]]].
- 		 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 - initialPC]
  				ifFalse: 
  					[latestContinuation := latestContinuation max: targetPC.
  					numFixups := numFixups + 1]].
  		 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.
  			 numFixups := numFixups + 1].
  		 NewspeakVM ifTrue:
  			[descriptor hasIRC ifTrue:
  				[numIRCs := numIRCs + 1]].
  		 pc := pc + descriptor numBytes.
  		 descriptor isExtension
  			ifTrue: [nExts := nExts + 1]
  			ifFalse: [nExts := extA := extB := 0].
  		 prevBCDescriptor := descriptor].
  	^numBlocks!

Item was changed:
  ----- Method: SistaCogit>>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
  		- how many counters it needs/conditional branches it contains
  	 Answer the block count or on error a negative error code"
  	| latestContinuation nExts descriptor pc numBlocks distance targetPC framelessStackDelta numFixups |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	self flag: 'numFixup should be reverted to inst var when moving back sistaCogit as subclass of RegisterAllocatingCogit'.
  	needsFrame := false.
  	numFixups := 0.
  	prevBCDescriptor := nil.
  	numCounters := 0.
+ 	self
+ 		cppIf: IMMUTABILITY
+ 		ifTrue: [needsTwoPath := false].
  	NewspeakVM ifTrue:
  		[numIRCs := 0].
  	(primitiveIndex > 0
  	 and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
  		[^0].
  	pc := latestContinuation := initialPC.
  	numBlocks := framelessStackDelta := nExts := extA := 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].
+ 		 self
+ 			cppIf: IMMUTABILITY
+ 			ifTrue: [(needsFrame and: [needsTwoPath not])
+ 					ifFalse: [(descriptor needsFrameFunction isNil
+ 								or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
+ 							ifTrue: [needsFrame := true.
+ 								needsTwoPath := descriptor generator == #genStoreAndPopReceiverVariableBytecode]
+ 							ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]]]
+ 			ifFalse: [needsFrame
+ 					ifFalse: [(descriptor needsFrameFunction isNil
+ 								or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
+ 							ifTrue: [needsFrame := true]
+ 							ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]]].
- 		 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 - initialPC]
  				ifFalse:
  					[latestContinuation := latestContinuation max: targetPC.
  					numFixups := numFixups + 1.
  					 (descriptor isBranchTrue or: [descriptor isBranchFalse]) ifTrue:
  						[numCounters := numCounters + 1]]].
  		 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.
  			 numFixups := numFixups + 1].
  		 NewspeakVM ifTrue:
  			[descriptor hasIRC ifTrue:
  				[numIRCs := numIRCs + 1]].
  		 pc := pc + descriptor numBytes.
  		 descriptor isExtension
  			ifTrue: [nExts := nExts + 1]
  			ifFalse: [nExts := extA := extB := 0].
  		 prevBCDescriptor := descriptor].
  	^numBlocks!

Item was changed:
  SimpleStackBasedCogit subclass: #StackToRegisterMappingCogit
+ 	instanceVariableNames: 'prevBCDescriptor numPushNilsFunction pushNilSizeFunction methodOrBlockNumTemps regArgsHaveBeenPushed simSelf simStack simStackPtr simSpillBase optStatus ceCallCogCodePopReceiverArg0Regs ceCallCogCodePopReceiverArg1Arg0Regs methodAbortTrampolines picAbortTrampolines picMissTrampolines ceCall0ArgsPIC ceCall1ArgsPIC ceCall2ArgsPIC debugStackPointers debugFixupBreaks realCECallCogCodePopReceiverArg0Regs realCECallCogCodePopReceiverArg1Arg0Regs deadCode needsTwoPath'
- 	instanceVariableNames: 'prevBCDescriptor numPushNilsFunction pushNilSizeFunction methodOrBlockNumTemps regArgsHaveBeenPushed simSelf simStack simStackPtr simSpillBase optStatus ceCallCogCodePopReceiverArg0Regs ceCallCogCodePopReceiverArg1Arg0Regs methodAbortTrampolines picAbortTrampolines picMissTrampolines ceCall0ArgsPIC ceCall1ArgsPIC ceCall2ArgsPIC debugStackPointers debugFixupBreaks realCECallCogCodePopReceiverArg0Regs realCECallCogCodePopReceiverArg1Arg0Regs deadCode'
  	classVariableNames: 'NeedsMergeFixupFlag NeedsNonMergeFixupFlag'
  	poolDictionaries: 'CogCompilationConstants VMMethodCacheConstants VMObjectIndices VMStackFrameOffsets'
  	category: 'VMMaker-JIT'!
  StackToRegisterMappingCogit class
  	instanceVariableNames: 'numPushNilsFunction pushNilSizeFunction'!
  
  !StackToRegisterMappingCogit commentStamp: 'eem 12/19/2010 18:12' prior: 0!
  StackToRegisterMappingCogit is an optimizing code generator that eliminates a lot of stack operations and inlines some special selector arithmetic.  It does so by a simple stack-to-register mapping scheme based on deferring the generation of code to produce operands until operand-consuming operations.  The operations that consume operands are sends, stores and returns.
  
  See methods in the class-side documentation protocol for more detail.
  
  Instance Variables
  	callerSavedRegMask:							<Integer>
  	ceEnter0ArgsPIC:								<Integer>
  	ceEnter1ArgsPIC:								<Integer>
  	ceEnter2ArgsPIC:								<Integer>
  	ceEnterCogCodePopReceiverArg0Regs:		<Integer>
  	ceEnterCogCodePopReceiverArg1Arg0Regs:	<Integer>
  	debugBytecodePointers:						<Set of Integer>
  	debugFixupBreaks:								<Set of Integer>
  	debugStackPointers:							<CArrayAccessor of (Integer|nil)>
  	methodAbortTrampolines:						<CArrayAccessor of Integer>
  	methodOrBlockNumTemps:						<Integer>
  	optStatus:										<Integer>
  	picAbortTrampolines:							<CArrayAccessor of Integer>
  	picMissTrampolines:							<CArrayAccessor of Integer>
  	realCEEnterCogCodePopReceiverArg0Regs:		<Integer>
  	realCEEnterCogCodePopReceiverArg1Arg0Regs:	<Integer>
  	regArgsHaveBeenPushed:						<Boolean>
  	simSelf:											<CogSimStackEntry>
  	simSpillBase:									<Integer>
  	simStack:										<CArrayAccessor of CogSimStackEntry>
  	simStackPtr:									<Integer>
  	traceSimStack:									<Integer>
  
  callerSavedRegMask
  	- the bitmask of the ABI's caller-saved registers
  
  ceEnter0ArgsPIC ceEnter1ArgsPIC ceEnter2ArgsPIC
  	- the trampoline for entering an N-arg PIC
  
  ceEnterCogCodePopReceiverArg0Regs ceEnterCogCodePopReceiverArg1Arg0Regs
  	- teh trampoline for entering a method with N register args
  	
  debugBytecodePointers
  	- a Set of bytecode pcs for setting breakpoints (simulation only)
  
  debugFixupBreaks
  	- a Set of fixup indices for setting breakpoints (simulation only)
  
  debugStackPointers
  	- an Array of stack depths for each bytecode for code verification
  
  methodAbortTrampolines
  	- a CArrayAccessor of abort trampolines for 0, 1, 2 and N args
  
  methodOrBlockNumTemps
  	- the number of method or block temps (including args) in the current compilation unit (method or block)
  
  optStatus
  	- the variable used to track the status of ReceiverResultReg for avoiding reloading that register with self between adjacent inst var accesses
  
  picAbortTrampolines
  	- a CArrayAccessor of abort trampolines for 0, 1, 2 and N args
  
  picMissTrampolines
  	- a CArrayAccessor of abort trampolines for 0, 1, 2 and N args
  
  realCEEnterCogCodePopReceiverArg0Regs realCEEnterCogCodePopReceiverArg1Arg0Regs
  	- the real trampolines for ebtering machine code with N reg args when in the Debug regime
  
  regArgsHaveBeenPushed
  	- whether the register args have been pushed before frame build (e.g. when an interpreter primitive is called)
  
  simSelf
  	- the simulation stack entry representing self in the current compilation unit
  
  simSpillBase
  	- the variable tracking how much of the simulation stack has been spilled to the real stack
  
  simStack
  	- the simulation stack itself
  
  simStackPtr
  	- the pointer to the top of the simulation stack
  !
  StackToRegisterMappingCogit class
  	instanceVariableNames: 'numPushNilsFunction pushNilSizeFunction'!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>compileFrameBuild (in category 'compile abstract instructions') -----
  compileFrameBuild
  	"Build a frame for a CogMethod activation.  See CoInterpreter class>>initializeFrameIndices.
  	 Override to push the register receiver and register arguments, if any."
+ 	self cppIf: IMMUTABILITY ifTrue: 
+ 		[needsTwoPath ifTrue: 
+ 			[self compileTwoPathFrameBuild.
+ 		 	^self]].
  	needsFrame ifFalse:
  		[self initSimStackForFramelessMethod: initialPC.
  		 ^self].
  	self genPushRegisterArgs.
  	super compileFrameBuild.
  	self initSimStackForFramefulMethod: initialPC!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>compileTwoPathFrameBuild (in category 'compile abstract instructions') -----
+ compileTwoPathFrameBuild
+ 	<option: #IMMUTABILITY>
+ 	"We are in a method where the frame is needed *only* for instance variable store, typically a setter method.
+ 	This case has 20% overhead with Immutability compared to setter without immutability because of the stack
+ 	frame creation. We compile two path, one where the object is immutable, one where it isn't. At the beginning 
+ 	of the frame build, we take one path or the other depending on the receiver mutability.
+ 	
+ 	Note: this specific case happens only where there are only instance variabel stores. We could do something
+ 	similar for literal variable stores, but we don't as it's too uncommon."
+ 	|jumpImmutable|
+ 	self assert: needsFrame.
+ 	self assert: IMMUTABILITY.
+ 	self assert: needsTwoPath.
+ 	self assert: blockCount = 0.
+ 	jumpImmutable := objectRepresentation genJumpImmutable: ReceiverResultReg scratchReg: TempReg.
+ 	"first path. The receiver is mutable"
+ 	self initSimStackForFramelessMethod: initialPC.
+ 	self compileMethodBody.
+ 	"second path. The receiver is mutable"
+ 	needsTwoPath := false. "reset because it impact inst var store compilation"
+ 	jumpImmutable jmpTarget: self Label.
+ 	self genPushRegisterArgs.
+ 	super compileFrameBuild.
+ 	self initSimStackForFramefulMethod: initialPC!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genStorePop:slotIndex:destReg:needsStoreCheck:needsRestoreRcvr: (in category 'bytecode generator support') -----
  genStorePop: popBoolean slotIndex: slotIndex destReg: destReg needsStoreCheck: needsStoreCheck needsRestoreRcvr: needsRestoreReceiver
  	<inline: true>
  	"This method expects destReg to hold the object to store into. In practice, it is almost always RcvrResultReg because it is mandatory for the various store checks. We could put any register there if no store check is needed"
  	self 
  		cppIf: IMMUTABILITY
  		ifTrue: 
+ 			[needsTwoPath
+ 				ifTrue: 
+ 					[self  "first path, receiver is mutable"
+ 						genVanillaStorePop: popBoolean 
+ 						slotIndex: slotIndex 
+ 						destReg: destReg 
+ 						needsStoreCheck: needsStoreCheck]
+ 				ifFalse: 
+ 					[self 
+ 						genImmCheckStorePop: popBoolean 
+ 						slotIndex: slotIndex 
+ 						destReg: destReg 
+ 						needsStoreCheck: needsStoreCheck
+ 						needsRestoreRcvr: needsRestoreReceiver]]
- 			[ self 
- 				genImmCheckStorePop: popBoolean 
- 				slotIndex: slotIndex 
- 				destReg: destReg 
- 				needsStoreCheck: needsStoreCheck
- 				needsRestoreRcvr: needsRestoreReceiver ]
  		ifFalse: 
+ 			[self 
- 			[ self 
  				genVanillaStorePop: popBoolean 
  				slotIndex: slotIndex 
  				destReg: destReg 
+ 				needsStoreCheck: needsStoreCheck].
- 				needsStoreCheck: needsStoreCheck ].
  		!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>genUpArrowReturn (in category 'bytecode generators') -----
  genUpArrowReturn
  	"Generate a method return from within a method or a block.
  	 Frameless method activation looks like
  	 CISCs (x86):
  				receiver
  				args
  		sp->	ret pc.
  	 RISCs (ARM):
  				receiver
  				args
  				ret pc in LR.
  	 A fully framed activation is described in CoInterpreter class>initializeFrameIndices.
  	 Return pops receiver and arguments off the stack.  Callee pushes the result."
+ 	| framelessReturn |
  	deadCode := true. "can't fall through"
  	inBlock ifTrue:
  		[self assert: needsFrame. 
  		 self CallRT: ceNonLocalReturnTrampoline.
  		 self annotateBytecode: self Label.
  		 ^0].
+ 	self 
+ 		cppIf: IMMUTABILITY
+ 		ifTrue: [framelessReturn := needsFrame and: [needsTwoPath not]]
+ 		ifFalse: [framelessReturn := needsFrame].
+ 	framelessReturn
- 	needsFrame
  		ifTrue:
  			[self MoveR: FPReg R: SPReg.
  			 self PopR: FPReg.
  			 backEnd hasLinkRegister ifTrue:
  				[self PopR: LinkReg].
  			 self RetN: methodOrBlockNumArgs + 1 * objectMemory wordSize]
  		ifFalse:
  			[self RetN: ((methodOrBlockNumArgs > self numRegArgs
  						"A method with an interpreter prim will push its register args for the prim.  If the failure
  						 body is frameless the args must still be popped, see e.g. Behavior>>nextInstance."
  						or: [regArgsHaveBeenPushed])
  							ifTrue: [methodOrBlockNumArgs + 1 * objectMemory wordSize]
  							ifFalse: [0])].
  	^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 |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	needsFrame := false.
  	prevBCDescriptor := nil.
+ 	self cppIf: IMMUTABILITY ifTrue: [ needsTwoPath := false ].
  	NewspeakVM ifTrue:
  		[numIRCs := 0].
  	(primitiveIndex > 0
  	 and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
  		[^0].
  	pc := latestContinuation := initialPC.
  	numBlocks := framelessStackDelta := nExts := extA := 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].
+ 		self cppIf: IMMUTABILITY 
+ 			ifTrue: 
+ 				[(needsFrame and: [needsTwoPath not]) ifFalse:
+ 					[(descriptor needsFrameFunction isNil
+ 					  or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
+ 						ifTrue: 
+ 							[needsFrame := true.
+ 							 needsTwoPath := descriptor generator == #genStoreAndPopReceiverVariableBytecode ]
+ 						ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]]]
+ 			ifFalse: 
+ 				[needsFrame ifFalse:
+ 					[(descriptor needsFrameFunction isNil
+ 					  or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
+ 						ifTrue: [needsFrame := true]
+ 						ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]]].
+ 			
- 		 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 - 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 := extB := 0].
  		 prevBCDescriptor := descriptor].
  	^numBlocks!



More information about the Vm-dev mailing list