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

commits at source.squeak.org commits at source.squeak.org
Wed Oct 8 18:47:50 UTC 2014


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

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

Name: VMMaker.oscog-eem.895
Author: eem
Time: 8 October 2014, 11:43:36.404 am
UUID: 2c674935-8b94-45ff-b8fc-59fb78830eb3
Ancestors: VMMaker.oscog-eem.894

Compile the NewspeakV4 bytecode
extPushPseudoVariableOrOuter frameless when
pushing nil, true, false.  This means the scanMethod
and scanBlock: implementations must maintain extA
and extB.

Provide a simulation-only allCogMethodsFor: that
yields block methods within a Cog method, for testing.

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

Item was added:
+ ----- Method: Cogit>>allCogMethodsFor: (in category 'disassembly') -----
+ allCogMethodsFor: cogMethod
+ 	<doNotGenerate>
+ 	| blockEntry end methods pc |
+ 	cogMethod isInteger ifTrue: [^self allCogMethodsFor: (self cogMethodSurrogateAt: cogMethod)].
+ 	cogMethod cmType = CMBlock ifTrue:
+ 		[^self allCogMethodsFor: cogMethod cmHomeMethod].
+ 	(cogMethod cmType ~= CMMethod
+ 	 or: [cogMethod blockEntryOffset = 0]) ifTrue:
+ 		[^{cogMethod}].
+ 
+ 	methods := OrderedCollection with: cogMethod.
+ 	pc := blockEntry := cogMethod blockEntryOffset + cogMethod asInteger.
+ 	end := (self mapEndFor: cogMethod) - 1.
+ 	[pc < end] whileTrue:
+ 		[| targetpc |
+ 		 targetpc := blockEntry.
+ 		 (backEnd isJumpAt: pc) ifTrue:
+ 			[targetpc := backEnd jumpTargetPCAt: pc.
+ 			 targetpc < blockEntry ifTrue:
+ 				[methods add: (self cCoerceSimple: targetpc - (self sizeof: CogBlockMethod) to: #'CogBlockMethod *')]].
+ 		 pc := pc + (backEnd instructionSizeAt: pc)].
+ 	^methods sort!

Item was changed:
  ----- Method: Cogit>>cog:selector: (in category 'jit - api') -----
  cog: aMethodObj selector: aSelectorOop
  	"Attempt to produce a machine code method for the bytecode method
  	 object aMethodObj.  N.B. If there is no code memory available do *NOT*
  	 attempt to reclaim the method zone.  Certain clients (e.g. ceSICMiss:)
  	 depend on the zone remaining constant across method generation."
  	<api>
  	<returnTypeC: #'CogMethod *'>
  	| cogMethod |
  	<var: #cogMethod type: #'CogMethod *'>
  	self assert: ((coInterpreter methodHasCogMethod: aMethodObj) not
  				or: [(self noAssertMethodClassAssociationOf: aMethodObj) = objectMemory nilObject]).
  	"coInterpreter stringOf: aSelectorOop"
  	coInterpreter
  		compilationBreak: aSelectorOop
  		point: (objectMemory lengthOf: aSelectorOop).
  	aMethodObj = breakMethod ifTrue: [self halt: 'Compilation of breakMethod'].
  	self cppIf: NewspeakVM
  		ifTrue: [cogMethod := methodZone findPreviouslyCompiledVersionOf: aMethodObj with: aSelectorOop.
  				cogMethod ifNotNil:
  					[(coInterpreter methodHasCogMethod: aMethodObj) not ifTrue:
  						[self assert: (coInterpreter rawHeaderOf: aMethodObj) = cogMethod methodHeader.
  						 cogMethod methodObject: aMethodObj.
  						 coInterpreter rawHeaderOf: aMethodObj put: cogMethod asInteger].
  					^cogMethod]].
  	"If the generators for the alternate bytecode set are missing then interpret."
  	(coInterpreter methodUsesAlternateBytecodeSet: aMethodObj)
  		ifTrue:
  			[(self numElementsIn: generatorTable) <= 256 ifTrue:
  				[^nil].
  			 bytecodeSetOffset := 256]
  		ifFalse:
  			[bytecodeSetOffset := 0].
- 	extA := extB := 0.
  	objectRepresentation ensureNoForwardedLiteralsIn: aMethodObj.
  	methodObj := aMethodObj.
  	cogMethod := self compileCogMethod: aSelectorOop.
  	(cogMethod asInteger between: MaxNegativeErrorCode and: -1) ifTrue:
  		[cogMethod asInteger = InsufficientCodeSpace ifTrue:
  			[coInterpreter callForCogCompiledCodeCompaction].
  		 self maybeFreeCounters.
  		 "Right now no errors should be reported, so nothing more to do."
  		 "self reportError: (self cCoerceSimple: cogMethod to: #sqInt)."
  		 ^nil].
  	"self cCode: ''
  		inSmalltalk:
  			[coInterpreter printCogMethod: cogMethod.
  			 ""coInterpreter symbolicMethod: aMethodObj.""
  			 self assertValidMethodMap: cogMethod."
  			 "self disassembleMethod: cogMethod."
  			 "printInstructions := clickConfirm := true""]."
  	^cogMethod!

Item was added:
+ ----- Method: Cogit>>generatorTable (in category 'accessing') -----
+ generatorTable
+ 	<doNotGenerate>
+ 	^generatorTable!

Item was changed:
  ----- Method: Cogit>>scanBlock: (in category 'compile abstract instructions') -----
  scanBlock: blockStart
  	"Scan the block to determine if the block needs a frame or not"
  	| descriptor pc end framelessStackDelta nExts |
  	<var: #blockStart type: #'BlockStart *'>
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	needsFrame := false.
  	methodOrBlockNumArgs := blockStart numArgs.
  	inBlock := true.
  	pc := blockStart startpc.
  	end := blockStart startpc + blockStart span.
+ 	framelessStackDelta := nExts := extA := extB := 0.
- 	framelessStackDelta := nExts := 0.
  	[pc < end] whileTrue:
  		[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
  		 descriptor := self generatorAt: byte0.
+ 		 descriptor isExtension ifTrue:
+ 			[self loadSubsequentBytesForDescriptor: descriptor at: pc.
+ 			 self perform: descriptor generator].
  		 needsFrame ifFalse:
  			[(descriptor needsFrameFunction isNil
  			  or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
  				ifTrue: [needsFrame := true]
  				ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]].
  		 pc := self nextBytecodePCFor: descriptor at: pc exts: nExts in: methodObj.
+ 		 descriptor isExtension
+ 			ifTrue: [nExts := nExts + 1]
+ 			ifFalse: [nExts := extA := extB := 0]].
- 		 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
  	needsFrame ifFalse:
  		[framelessStackDelta < 0 ifTrue:
  			[self error: 'negative stack delta in block; block contains bogus code or internal error'].
  		 [framelessStackDelta > 0] whileTrue:
  			[descriptor := self generatorAt: (objectMemory fetchByte: blockStart startpc ofObject: methodObj) + bytecodeSetOffset.
  			 descriptor generator ~~ #genPushConstantNilBytecode ifTrue:
  				[self error: 'frameless block doesn''t start with enough pushNils'].
  			 blockStart
  				startpc: blockStart startpc + descriptor numBytes;
  				span: blockStart span - descriptor numBytes.
  			 framelessStackDelta := framelessStackDelta - 1]]!

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
  	 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.
  	inBlock := false.
  	self cppIf: #NewspeakVM ifTrue:
  		[numIRCs := 0].
  	(primitiveIndex > 0
  	 and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
  		[^0].
  	pc := latestContinuation := initialPC.
+ 	numBlocks := framelessStackDelta := nExts := extA := extB := 0.
- 	numBlocks := framelessStackDelta := nExts := 0.
  	[pc <= endPC] whileTrue:
  		[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
+ 		 descriptor := self generatorAt: byte0.
+ 		 descriptor isExtension ifTrue:
+ 			[self loadSubsequentBytesForDescriptor: descriptor at: pc.
+ 			 self perform: descriptor generator].
+ 		 (descriptor isReturn
+ 		  and: [pc >= latestContinuation]) ifTrue:
- 		descriptor := self generatorAt: byte0.
- 		(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:
- 		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:
- 		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 cppIf: #NewspeakVM ifTrue:
- 		self cppIf: #NewspeakVM ifTrue:
  			[descriptor hasIRC ifTrue:
  				[numIRCs := numIRCs + 1]].
+ 		 pc := pc + descriptor numBytes.
+ 		 descriptor isExtension
+ 			ifTrue: [nExts := nExts + 1]
+ 			ifFalse: [nExts := extA := extB := 0]].
- 		pc := pc + descriptor numBytes.
- 		nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0]].
  	^numBlocks!

Item was changed:
  ----- Method: SistaStackToRegisterMappingCogit>>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 |
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	needsFrame := false.
  	inBlock := false.
  	prevBCDescriptor := nil.
  	numCounters := 0.
  	self cppIf: #NewspeakVM ifTrue:
  		[numIRCs := 0].
  	(primitiveIndex > 0
  	 and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
  		[^0].
  	pc := latestContinuation := initialPC.
+ 	numBlocks := framelessStackDelta := nExts := extA := extB := 0.
- 	numBlocks := framelessStackDelta := nExts := 0.
  	[pc <= endPC] whileTrue:
  		[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
+ 		 descriptor := self generatorAt: byte0.
+ 		 descriptor isExtension ifTrue:
+ 			[self loadSubsequentBytesForDescriptor: descriptor at: pc.
+ 			 self perform: descriptor generator].
+ 		 (descriptor isReturn
+ 		  and: [pc >= latestContinuation]) ifTrue:
- 		descriptor := self generatorAt: byte0.
- 		(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:
- 		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 isBranchTrue or: [descriptor isBranchFalse]) ifTrue:
  						[numCounters := numCounters + 1]]].
+ 		 descriptor isBlockCreation ifTrue:
- 		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 cppIf: #NewspeakVM ifTrue:
- 		self cppIf: #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].
- 		pc := pc + descriptor numBytes.
- 		nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0].
- 		prevBCDescriptor := descriptor].
  	^numBlocks!

Item was changed:
  ----- Method: StackToRegisterMappingCogit class>>initializeBytecodeTableForNewspeakV4 (in category 'class initialization') -----
  initializeBytecodeTableForNewspeakV4
  	"StackToRegisterMappingCogit initializeBytecodeTableForNewspeakV4"
  
  	numPushNilsFunction := #v4:Num:Push:Nils:.
  	pushNilSizeFunction := #v4PushNilSize:.
  	NSSendIsPCAnnotated := false. "IsNSSendCall used by SendAbsentImplicit"
  	FirstSpecialSelector := 80.
  	self flag:
  'Special selector send class must be inlined to agree with the interpreter, which
   inlines class.  If class is sent to e.g. a general instance of ProtoObject then unless
   class is inlined there will be an MNU.  It must be that the Cointerpreter and Cogit
   have identical semantics.  We get away with not hardwiring the other special
   selectors either because in the Cointerpreter they are not inlined or because they
   are inlined only to instances of classes for which there will always be a method.'.
  	self generatorTableFrom: #(
  		"1 byte bytecodes"
  		(1    0   15 genPushReceiverVariableBytecode needsFrameNever: 1)
  		(1  16   31 genPushLiteralVariable16CasesBytecode needsFrameNever: 1)
  		(1  32   63 genPushLiteralConstantBytecode needsFrameNever: 1)
  		(1  64   75 genPushTemporaryVariableBytecode needsFrameIfMod16GENumArgs: 1)
  		(1  76   76 genPushReceiverBytecode needsFrameNever: 1)
+ 		(1  77   77 genExtPushPseudoVariableOrOuterBytecode needsFrameIfExtBGT2: 1)
- 		(1  77   77 genExtPushPseudoVariableOrOuterBytecode)
  		(1  78   78 genPushConstantZeroBytecode needsFrameNever: 1)
  		(1  79   79 genPushConstantOneBytecode needsFrameNever: 1)
  
  		(1   80   80 genSpecialSelectorArithmetic isMapped AddRR)
  		(1   81   81 genSpecialSelectorArithmetic isMapped SubRR)
  		(1   82   82 genSpecialSelectorComparison isMapped JumpLess)
  		(1   83   83 genSpecialSelectorComparison isMapped JumpGreater)
  		(1   84   84 genSpecialSelectorComparison isMapped JumpLessOrEqual)
  		(1   85   85 genSpecialSelectorComparison isMapped JumpGreaterOrEqual)
  		(1   86   86 genSpecialSelectorComparison isMapped JumpZero)
  		(1   87   87 genSpecialSelectorComparison isMapped JumpNonZero)
  		(1   88   93 genSpecialSelectorSend isMapped)	 " #* #/ #\\ #@ #bitShift: //"
  		(1   94   94 genSpecialSelectorArithmetic isMapped AndRR)
  		(1   95   95 genSpecialSelectorArithmetic isMapped OrRR)
  		(1   96 101 genSpecialSelectorSend isMapped) "#at: #at:put: #size #next #nextPut: #atEnd"
  		(1 102 102 genSpecialSelectorEqualsEquals needsFrameNever: notMapped -1) "not mapped because it is directly inlined (for now)"
  		(1 103 103 genSpecialSelectorClass needsFrameIfStackGreaterThanOne: notMapped 0) "not mapped because it is directly inlined (for now)"
  		(1 104 111 genSpecialSelectorSend isMapped) "#blockCopy: #value #value: #do: #new #new: #x #y"
  
  		(1 112 127 genSendLiteralSelector0ArgsBytecode isMapped)
  		(1 128 143 genSendLiteralSelector1ArgBytecode isMapped)
  		(1 144 159 genSendLiteralSelector2ArgsBytecode isMapped)
  		(1 160 175	genSendAbsentImplicit0ArgsBytecode isMapped hasIRC)
  
  		(1 176 183 genStoreAndPopReceiverVariableBytecode needsFrameNever: -1) "N.B. not frameless if immutability"
  		(1 184 191 genStoreAndPopTemporaryVariableBytecode)
  
  		(1 192 199 genShortUnconditionalJump	branch v3:ShortForward:Branch:Distance:)
  		(1 200 207 genShortJumpIfTrue			branch isBranchTrue isMapped "because of mustBeBoolean"
  													v3:ShortForward:Branch:Distance:)
  		(1 208 215 genShortJumpIfFalse			branch isBranchFalse isMapped "because of mustBeBoolean"
  													v3:ShortForward:Branch:Distance:)
  
  		(1 216 216 genReturnReceiver				return needsFrameIfInBlock: isMappedInBlock 0)
  		(1 217 217 genReturnTopFromMethod		return needsFrameIfInBlock: isMappedInBlock -1)
  		(1 218 218 genExtReturnTopFromBlock	return needsFrameNever: -1)
  
  		(1 219 219 duplicateTopBytecode			needsFrameNever: 1)
  		(1 220 220 genPopStackBytecode			needsFrameNever: -1)
  		(1 221 221 genExtNopBytecode			needsFrameNever: 0)
  		(1 222 223	unknownBytecode)
  
  		"2 byte bytecodes"
  		(2 224 224 extABytecode extension					needsFrameNever: 0)
  		(2 225 225 extBBytecode extension					needsFrameNever: 0)
  		(2 226 226 genExtPushReceiverVariableBytecode)
  		(2 227 227 genExtPushLiteralVariableBytecode		needsFrameNever: 1)
  		(2 228 228 genExtPushLiteralBytecode					needsFrameNever: 1)
  		(2 229 229 genExtPushIntegerBytecode				needsFrameNever: 1)
  		(2 230 230 genLongPushTemporaryVariableBytecode)
  		(2 231 231 genPushNewArrayBytecode)
  		(2 232 232 genExtStoreReceiverVariableBytecode)
  		(2 233 233 genExtStoreLiteralVariableBytecode)
  		(2 234 234 genLongStoreTemporaryVariableBytecode)
  		(2 235 235 genExtStoreAndPopReceiverVariableBytecode)
  		(2 236 236 genExtStoreAndPopLiteralVariableBytecode)
  		(2 237 237 genLongStoreAndPopTemporaryVariableBytecode)
  
  		(2 238 238 genExtSendBytecode isMapped)
  		(2 239 239 genExtSendSuperBytecode isMapped)
  		(2 240 240 genExtSendAbsentImplicitBytecode isMapped hasIRC)
  		(2 241 241 genExtSendAbsentDynamicSuperBytecode isMapped)
  
  		(2 242 242 genExtUnconditionalJump	branch isMapped "because of interrupt check" v4:Long:Branch:Distance:)
  		(2 243 243 genExtJumpIfTrue			branch isBranchTrue isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
  		(2 244 244 genExtJumpIfFalse			branch isBranchFalse isMapped "because of mustBeBoolean" v4:Long:Branch:Distance:)
  
  		(2 245 248	unknownBytecode)
  
  		"3 byte bytecodes"
  		(3 249 249 callPrimitiveBytecode)
  		(3 250 250 genPushRemoteTempLongBytecode)
  		(3 251 251 genStoreRemoteTempLongBytecode)
  		(3 252 252 genStoreAndPopRemoteTempLongBytecode)
  		(3 253 253 genExtPushClosureBytecode block v4:Block:Code:Size:)
  
  		(3 254 255	unknownBytecode))!

Item was added:
+ ----- Method: StackToRegisterMappingCogit>>needsFrameIfExtBGT2: (in category 'compile abstract instructions') -----
+ needsFrameIfExtBGT2: stackDelta
+ 	^extB < 0 or: [extB > 2]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>scanBlock: (in category 'compile abstract instructions') -----
  scanBlock: blockStart
  	"Scan the block to determine if the block needs a frame or not"
  	| descriptor pc end framelessStackDelta nExts pushingNils numPushNils |
  	<var: #blockStart type: #'BlockStart *'>
  	<var: #descriptor type: #'BytecodeDescriptor *'>
  	needsFrame := false.
  	prevBCDescriptor := nil.
  	methodOrBlockNumArgs := blockStart numArgs.
  	inBlock := true.
  	pc := blockStart startpc.
  	end := blockStart startpc + blockStart span.
+ 	framelessStackDelta := nExts := extA := extB := 0.
- 	framelessStackDelta := nExts := 0.
  	pushingNils := true.
  	[pc < end] whileTrue:
  		[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
  		 descriptor := self generatorAt: byte0.
+ 		 descriptor isExtension ifTrue:
+ 			[self loadSubsequentBytesForDescriptor: descriptor at: pc.
+ 			 self perform: descriptor generator].
  		 needsFrame ifFalse:
  			[(descriptor needsFrameFunction isNil
  			  or: [self perform: descriptor needsFrameFunction with: framelessStackDelta])
  				ifTrue: [needsFrame := true]
  				ifFalse: [framelessStackDelta := framelessStackDelta + descriptor stackDelta]].
  		 (pushingNils
  		  and: [descriptor isExtension not]) ifTrue:
  			["Count the initial number of pushed nils acting as temp initializers.  We can't tell
  			  whether an initial pushNil is an operand reference or a temp initializer, except
  			  when the pushNil is a jump target (has a fixup), which never happens:
  					self systemNavigation browseAllSelect:
  						[:m| | ebc |
  						(ebc := m embeddedBlockClosures
  									select: [:ea| ea decompile statements first isMessage]
  									thenCollect: [:ea| ea decompile statements first selector]) notEmpty
  						and: [(#(whileTrue whileFalse whileTrue: whileFalse:) intersection: ebc) notEmpty]]
  			  or if the bytecode set has a push multiple nils bytecode.  We simply count initial nils.
  			  Rarely we may end up over-estimating.  We will correct by checking the stack depth
  			  at the end of the block in compileBlockBodies."
  			 (numPushNils := self numPushNils: descriptor pc: pc nExts: nExts method: methodObj) > 0
  				ifTrue:
  					[self assert: descriptor numBytes = 1. "see compileMethodBody"
  					 blockStart numInitialNils: blockStart numInitialNils + numPushNils]
  				ifFalse:
  					[pushingNils := false]].
  		 pc := self nextBytecodePCFor: descriptor at: pc exts: nExts in: methodObj.
+ 		 descriptor isExtension
+ 			ifTrue: [nExts := nExts + 1]
+ 			ifFalse: [nExts := extA := extB := 0].
- 		 nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0].
  		 prevBCDescriptor := descriptor].
  	"It would be nice of this wasn't necessary but alas we need to do the eager
  	 scan for frameless methods so that we don't end up popping too much off
  	 the simulated stack, e.g. for pushNil; returnTopFromBlock methods."
  	needsFrame ifFalse:
  		[self assert: (framelessStackDelta >= 0 and: [blockStart numInitialNils >= framelessStackDelta]).
  		 blockStart numInitialNils: blockStart numInitialNils - framelessStackDelta]!

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.
  	inBlock := false.
  	prevBCDescriptor := nil.
  	self cppIf: #NewspeakVM ifTrue:
  		[numIRCs := 0].
  	(primitiveIndex > 0
  	 and: [coInterpreter isQuickPrimitiveIndex: primitiveIndex]) ifTrue:
  		[^0].
  	pc := latestContinuation := initialPC.
+ 	numBlocks := framelessStackDelta := nExts := extA := extB := 0.
- 	numBlocks := framelessStackDelta := nExts := 0.
  	[pc <= endPC] whileTrue:
  		[byte0 := (objectMemory fetchByte: pc ofObject: methodObj) + bytecodeSetOffset.
+ 		 descriptor := self generatorAt: byte0.
+ 		 descriptor isExtension ifTrue:
+ 			[self loadSubsequentBytesForDescriptor: descriptor at: pc.
+ 			 self perform: descriptor generator].
+ 		 (descriptor isReturn
+ 		  and: [pc >= latestContinuation]) ifTrue:
- 		descriptor := self generatorAt: byte0.
- 		(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:
- 		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:
- 		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 cppIf: #NewspeakVM ifTrue:
- 		self cppIf: #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].
- 		pc := pc + descriptor numBytes.
- 		nExts := descriptor isExtension ifTrue: [nExts + 1] ifFalse: [0].
- 		prevBCDescriptor := descriptor].
  	^numBlocks!



More information about the Vm-dev mailing list