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

commits at source.squeak.org commits at source.squeak.org
Tue Sep 30 01:12:19 UTC 2014


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

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

Name: VMMaker.oscog-eem.887
Author: eem
Time: 29 September 2014, 6:09:33.297 pm
UUID: f980d45a-5622-46f6-95d9-ac8d00a34e81
Ancestors: VMMaker.oscog-eem.885

Install the callPrimitiveBytecode in the Interpreter's
bytecodeDispatchTable on Spur.

Modify callPrimitiveBytecode to not invoke
unknownBytecode processing if at the first bytecode
of a primitive method.

Correct sign comparison of instructionPointer in
justActivateNewMethod.

Relax the validInstructionPointer:inMethod:framePointer:
assert to accept any pc in initialPC to self size range
now that callPrimitiveBytecode is more forgiving.

Speed up primitiveMarkUnwindMethod &
primitiveMarkHandlerMethod in the StackInterpreter by
setting them to 0 in the primitive table.

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

Item was changed:
  ----- Method: CoInterpreter>>callbackEnter: (in category 'callback support') -----
  callbackEnter: callbackID
  	"Re-enter the interpreter for executing a callback"
  	| currentCStackPointer currentCFramePointer savedReenterInterpreter
  	  wasInMachineCode calledFromMachineCode |
  	<volatile>
  	<export: true>
  	<var: #currentCStackPointer type: #'void *'>
  	<var: #currentCFramePointer type: #'void *'>
  	<var: #callbackID type: #'sqInt *'>
  	<var: #savedReenterInterpreter type: #'jmp_buf'>
  
  	"For now, do not allow a callback unless we're in a primitiveResponse"
  	(self asserta: primitiveFunctionPointer ~= 0) ifFalse:
  		[^false].
  
  	self assert: primFailCode = 0.
  
  	"Check if we've exceeded the callback depth"
  	(self asserta: jmpDepth < MaxJumpBuf) ifFalse:
  		[^false].
  	jmpDepth := jmpDepth + 1.
  
  	wasInMachineCode := self isMachineCodeFrame: framePointer.
  	calledFromMachineCode := instructionPointer <= objectMemory startOfMemory.
  
  	"Suspend the currently active process"
  	suspendedCallbacks at: jmpDepth put: self activeProcess.
  	"We need to preserve newMethod explicitly since it is not activated yet
  	and therefore no context has been created for it. If the caller primitive
  	for any reason decides to fail we need to make sure we execute the correct
  	method and not the one 'last used' in the call back"
  	suspendedMethods at: jmpDepth put: newMethod.
  	self flag: 'need to debug this properly.  Conceptually it is the right thing to do but it crashes in practice'.
  	false
  		ifTrue:
  			["Signal external semaphores since a signalSemaphoreWithIndex: request may
  			  have been issued immediately prior to this callback before the VM has any
  			  chance to do a signalExternalSemaphores in checkForEventsMayContextSwitch:"
  			 self signalExternalSemaphores.
  			 "If no process is awakened by signalExternalSemaphores then transfer
  			  to the highest priority runnable one."
  			 (suspendedCallbacks at: jmpDepth) == self activeProcess ifTrue:
  				[self transferTo: self wakeHighestPriority from: CSCallbackLeave]]
  		ifFalse:
  			[self transferTo: self wakeHighestPriority from: CSCallbackLeave].
  
  	"Typically, invoking the callback means that some semaphore has been 
  	signaled to indicate the callback. Force an interrupt check as soon as possible."
  	self forceInterruptCheck.
  
  	"Save the previous CStackPointers and interpreter entry jmp_buf."
  	currentCStackPointer := cogit getCStackPointer.
  	currentCFramePointer := cogit getCFramePointer.
  	self mem: savedReenterInterpreter asVoidPointer
  		cp: reenterInterpreter
  		y: (self sizeof: #'jmp_buf').
  	cogit assertCStackWellAligned.
  	(self setjmp: (jmpBuf at: jmpDepth)) == 0 ifTrue: "Fill in callbackID"
  		[callbackID at: 0 put: jmpDepth.
  		 self enterSmalltalkExecutive.
  		 self assert: false "NOTREACHED"].
  
  	"Restore the previous CStackPointers and interpreter entry jmp_buf."
  	cogit setCStackPointer: currentCStackPointer.
  	cogit setCFramePointer: currentCFramePointer.
  	self mem: reenterInterpreter
  		cp: (self cCoerceSimple: savedReenterInterpreter to: #'void *')
  		y: (self sizeof: #'jmp_buf').
  
  	"Transfer back to the previous process so that caller can push result"
  	self putToSleep: self activeProcess yieldingIf: preemptionYields.
  	self transferTo: (suspendedCallbacks at: jmpDepth) from: CSCallbackLeave.
  	newMethod := suspendedMethods at: jmpDepth.	"see comment above"
  	argumentCount := self argumentCountOf: newMethod.
  	self assert: wasInMachineCode = (self isMachineCodeFrame: framePointer).
  	calledFromMachineCode
  		ifTrue:
+ 			[instructionPointer asUnsignedInteger >= objectMemory startOfMemory ifTrue:
- 			[instructionPointer >= objectMemory startOfMemory ifTrue:
  				[self iframeSavedIP: framePointer put: instructionPointer.
  				 instructionPointer := cogit ceReturnToInterpreterPC]]
  		ifFalse:
  			["Even if the context was flushed to the heap and rebuilt in transferTo:from:
  			  above it will remain an interpreted frame because the context's pc would
  			  remain a bytecode pc.  So the instructionPointer must also be a bytecode pc."
  			 self assert: (self isMachineCodeFrame: framePointer) not.
  			 self assert: instructionPointer > objectMemory startOfMemory].
  	self assert: primFailCode = 0.
  	jmpDepth := jmpDepth-1.
  	^true!

Item was changed:
  ----- Method: CoInterpreter>>justActivateNewMethod (in category 'message sending') -----
  justActivateNewMethod
  	| methodHeader activateCogMethod cogMethod numArgs numTemps rcvr errorCode initialIP |
  	<var: #cogMethod type: #'CogMethod *'>
  	<var: #initialIP type: #usqInt>
  	<inline: true>
  	methodHeader := self rawHeaderOf: newMethod.
  	(activateCogMethod := self isCogMethodReference: methodHeader) ifTrue:
  		[cogMethod := self cCoerceSimple: methodHeader to: #'CogMethod *'.
  		 methodHeader := cogMethod methodHeader].
  	numTemps := self temporaryCountOfMethodHeader: methodHeader.
  	numArgs := self argumentCountOfMethodHeader: methodHeader.
  
  	rcvr := self stackValue: numArgs. "could new rcvr be set at point of send?"
  	self assert: (objectMemory isOopForwarded: rcvr) not.
  
  	(activateCogMethod
+ 	and: [instructionPointer asUnsignedInteger >= objectMemory startOfMemory]) ifTrue:
- 	and: [instructionPointer >= objectMemory startOfMemory]) ifTrue:
  		[self iframeSavedIP: framePointer put: instructionPointer.
  		 instructionPointer := cogit ceReturnToInterpreterPC].
  	self push: instructionPointer.
  	self push: framePointer.
  	framePointer := stackPointer.
  	initialIP := self initialPCForHeader: methodHeader method: newMethod.
  	activateCogMethod
  		ifTrue:
  			[self push: cogMethod asUnsignedInteger.
  			 self push: objectMemory nilObject. "FoxThisContext field"
  			 instructionPointer := cogMethod asUnsignedInteger + cogMethod stackCheckOffset]
  		ifFalse:
  			[self push: newMethod.
  			 self setMethod: newMethod methodHeader: methodHeader.
  			 self push: objectMemory nilObject. "FoxThisContext field"
  			 self push: (self encodeFrameFieldHasContext: false isBlock: false numArgs: numArgs).
  			 self push: 0. "FoxIFSavedIP"
  			 instructionPointer := initialIP - 1].
  	self push: rcvr.
  
  	"clear remaining temps to nil"
  	numArgs+1 to: numTemps do:
  		[:i | self push: objectMemory nilObject].
  
  	(self methodHeaderHasPrimitive: methodHeader) ifTrue:
  		["Skip the CallPrimitive bytecode, if it's there, and store the error code if the method starts
  		  with a long store temp.  Strictly no need to skip the store because it's effectively a noop."
  		 initialIP := initialIP + (self sizeOfCallPrimitiveBytecode: methodHeader).
  		activateCogMethod ifFalse:
  			[instructionPointer := initialIP].
  		 primFailCode ~= 0 ifTrue:
  			[(objectMemory byteAt: initialIP + 1)
  			  = (self longStoreBytecodeForHeader: methodHeader) ifTrue:
  				[errorCode := self getErrorObjectFromPrimFailCode.
  				 self stackTopPut: errorCode "nil if primFailCode == 1, or primFailCode"].
  			 primFailCode := 0]].
  
  	^methodHeader!

Item was changed:
  ----- Method: StackInterpreter class>>initializeBytecodeTableForNewspeakV3PlusClosures (in category 'initialization') -----
  initializeBytecodeTableForNewspeakV3PlusClosures
  	"StackInterpreter initializeBytecodeTableForNewspeakV3PlusClosures"
  	"Note: This table will be used to generate a C switch statement."
  
  	BytecodeTable := Array new: 256.
  	BytecodeEncoderClassName := #EncoderForNewsqueakV3.
  	LongStoreBytecode := 129.
  	self table: BytecodeTable from:
  	#(
  		(  0  15 pushReceiverVariableBytecode)
  		( 16  31 pushTemporaryVariableBytecode)
  		( 32  63 pushLiteralConstantBytecode)
  		( 64  95 pushLiteralVariableBytecode)
  		( 96 103 storeAndPopReceiverVariableBytecode)
  		(104 111 storeAndPopTemporaryVariableBytecode)
  		(112 pushReceiverBytecode)
  		(113 pushConstantTrueBytecode)
  		(114 pushConstantFalseBytecode)
  		(115 pushConstantNilBytecode)
  		(116 pushConstantMinusOneBytecode)
  		(117 pushConstantZeroBytecode)
  		(118 pushConstantOneBytecode)
  		(119 pushConstantTwoBytecode)
  		(120 returnReceiver)
  		(121 returnTrue)
  		(122 returnFalse)
  		(123 returnNil)
  		(124 returnTopFromMethod)
  		(125 returnTopFromBlock)
  
  		"2 of the 3 Newspeak bytecodes"
  		(126 dynamicSuperSendBytecode)
  		(127 pushImplicitReceiverBytecode)
  
  		(128 extendedPushBytecode)
  		(129 extendedStoreBytecode)
  		(130 extendedStoreAndPopBytecode)
  		(131 singleExtendedSendBytecode)
  		(132 doubleExtendedDoAnythingBytecode)
  		(133 singleExtendedSuperBytecode)
  		(134 secondExtendedSendBytecode)
  		(135 popStackBytecode)
  		(136 duplicateTopBytecode)
  
  		(137 pushActiveContextBytecode)
+ 		(138 pushNewArrayBytecode)),
- 		(138 pushNewArrayBytecode)
  
+ 	((initializationOptions at: #SpurObjectMemory ifAbsent: [false])
+ 		ifTrue: [#((139 callPrimitiveBytecode))]					"V3PlusClosures on Spur"
+ 		ifFalse: [#((139 pushExplicitOuterReceiverBytecode))]),	"Newspeak on V3"
- 		"The last of 3 Newspeak bytecodes"
- 		(139 pushExplicitOuterReceiverBytecode)
  
+ 	  #(
  		(140 pushRemoteTempLongBytecode)
  		(141 storeRemoteTempLongBytecode)
  		(142 storeAndPopRemoteTempLongBytecode)
  		(143 pushClosureCopyCopiedValuesBytecode)
  
  		(144 151 shortUnconditionalJump)
  		(152 159 shortConditionalJumpFalse)
  		(160 167 longUnconditionalJump)
  		(168 171 longJumpIfTrue)
  		(172 175 longJumpIfFalse)
  
  		"176-191 were sendArithmeticSelectorBytecode"
  		(176 bytecodePrimAdd)
  		(177 bytecodePrimSubtract)
  		(178 bytecodePrimLessThan)
  		(179 bytecodePrimGreaterThan)
  		(180 bytecodePrimLessOrEqual)
  		(181 bytecodePrimGreaterOrEqual)
  		(182 bytecodePrimEqual)
  		(183 bytecodePrimNotEqual)
  		(184 bytecodePrimMultiply)
  		(185 bytecodePrimDivide)
  		(186 bytecodePrimMod)
  		(187 bytecodePrimMakePoint)
  		(188 bytecodePrimBitShift)
  		(189 bytecodePrimDiv)
  		(190 bytecodePrimBitAnd)
  		(191 bytecodePrimBitOr)
  
  		"192-207 were sendCommonSelectorBytecode"
  		(192 bytecodePrimAt)
  		(193 bytecodePrimAtPut)
  		(194 bytecodePrimSize)
  		(195 bytecodePrimNext)
  		(196 bytecodePrimNextPut)
  		(197 bytecodePrimAtEnd)
  		(198 bytecodePrimIdentical)
  		(199 bytecodePrimClass)
  		(200 bytecodePrimSpecialSelector24)
  		(201 bytecodePrimValue)
  		(202 bytecodePrimValueWithArg)
  		(203 bytecodePrimDo)
  		(204 bytecodePrimNew)
  		(205 bytecodePrimNewWithArg)
  		(206 bytecodePrimPointX)
  		(207 bytecodePrimPointY)
  
  		(208 223 sendLiteralSelector0ArgsBytecode)
  		(224 239 sendLiteralSelector1ArgBytecode)
  		(240 255 sendLiteralSelector2ArgsBytecode)
  	)!

Item was changed:
  ----- Method: StackInterpreter class>>initializeBytecodeTableForSqueakV3PlusClosures (in category 'initialization') -----
  initializeBytecodeTableForSqueakV3PlusClosures
  	"StackInterpreter initializeBytecodeTableForSqueakV3PlusClosures"
  	"Note: This table will be used to generate a C switch statement."
  
  	BytecodeTable := Array new: 256.
  	BytecodeEncoderClassName := #EncoderForV3PlusClosures.
  	LongStoreBytecode := 129.
  	self table: BytecodeTable from:
  	#(
  		(  0  15 pushReceiverVariableBytecode)
  		( 16  31 pushTemporaryVariableBytecode)
  		( 32  63 pushLiteralConstantBytecode)
  		( 64  95 pushLiteralVariableBytecode)
  		( 96 103 storeAndPopReceiverVariableBytecode)
  		(104 111 storeAndPopTemporaryVariableBytecode)
  		(112 pushReceiverBytecode)
  		(113 pushConstantTrueBytecode)
  		(114 pushConstantFalseBytecode)
  		(115 pushConstantNilBytecode)
  		(116 pushConstantMinusOneBytecode)
  		(117 pushConstantZeroBytecode)
  		(118 pushConstantOneBytecode)
  		(119 pushConstantTwoBytecode)
  		(120 returnReceiver)
  		(121 returnTrue)
  		(122 returnFalse)
  		(123 returnNil)
  		(124 returnTopFromMethod)
  		(125 returnTopFromBlock)
  
  		(126 127 unknownBytecode)
  
  		(128 extendedPushBytecode)
  		(129 extendedStoreBytecode)
  		(130 extendedStoreAndPopBytecode)
  		(131 singleExtendedSendBytecode)
  		(132 doubleExtendedDoAnythingBytecode)
  		(133 singleExtendedSuperBytecode)
  		(134 secondExtendedSendBytecode)
  		(135 popStackBytecode)
  		(136 duplicateTopBytecode)
  
  		(137 pushActiveContextBytecode)
+ 		(138 pushNewArrayBytecode)),
+ 
+ 	((initializationOptions at: #SpurObjectMemory ifAbsent: [false])
+ 		ifTrue: [#((139 callPrimitiveBytecode))]	"V3PlusClosures on Spur"
+ 		ifFalse: [#((139 unknownBytecode))]),	"V3PlusClosures on V3"
+ 
+ 	  #(
- 		(138 pushNewArrayBytecode)
- 		(139 unknownBytecode)
  		(140 pushRemoteTempLongBytecode)
  		(141 storeRemoteTempLongBytecode)
  		(142 storeAndPopRemoteTempLongBytecode)
  		(143 pushClosureCopyCopiedValuesBytecode)
  
  		(144 151 shortUnconditionalJump)
  		(152 159 shortConditionalJumpFalse)
  		(160 167 longUnconditionalJump)
  		(168 171 longJumpIfTrue)
  		(172 175 longJumpIfFalse)
  
  		"176-191 were sendArithmeticSelectorBytecode"
  		(176 bytecodePrimAdd)
  		(177 bytecodePrimSubtract)
  		(178 bytecodePrimLessThan)
  		(179 bytecodePrimGreaterThan)
  		(180 bytecodePrimLessOrEqual)
  		(181 bytecodePrimGreaterOrEqual)
  		(182 bytecodePrimEqual)
  		(183 bytecodePrimNotEqual)
  		(184 bytecodePrimMultiply)
  		(185 bytecodePrimDivide)
  		(186 bytecodePrimMod)
  		(187 bytecodePrimMakePoint)
  		(188 bytecodePrimBitShift)
  		(189 bytecodePrimDiv)
  		(190 bytecodePrimBitAnd)
  		(191 bytecodePrimBitOr)
  
  		"192-207 were sendCommonSelectorBytecode"
  		(192 bytecodePrimAt)
  		(193 bytecodePrimAtPut)
  		(194 bytecodePrimSize)
  		(195 bytecodePrimNext)
  		(196 bytecodePrimNextPut)
  		(197 bytecodePrimAtEnd)
  		(198 bytecodePrimIdentical)
  		(199 bytecodePrimClass)
  		(200 bytecodePrimSpecialSelector24)
  		(201 bytecodePrimValue)
  		(202 bytecodePrimValueWithArg)
  		(203 bytecodePrimDo)
  		(204 bytecodePrimNew)
  		(205 bytecodePrimNewWithArg)
  		(206 bytecodePrimPointX)
  		(207 bytecodePrimPointY)
  
  		(208 223 sendLiteralSelector0ArgsBytecode)
  		(224 239 sendLiteralSelector1ArgBytecode)
  		(240 255 sendLiteralSelector2ArgsBytecode)
  	)!

Item was changed:
  ----- Method: StackInterpreter class>>initializePrimitiveTable (in category 'initialization') -----
(excessive size, no diff calculated)

Item was changed:
  ----- Method: StackInterpreter>>callPrimitiveBytecode (in category 'miscellaneous bytecodes') -----
  callPrimitiveBytecode
  	"V4:			249		11111001	i i i i i i i i	jjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjjj * 256)
+ 	 SistaV1:	248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution.
+ 	 V3/Spur:	139		10001011	i i i i i i i i	jjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjjj * 256)"
+ 	"Note that we simply skip a callPrimitiveBytecode at the start of a method
+ 	 that contains a primitive.  This because methods like Context(Part)>>reset
+ 	 have to be updated to skip the callPrimtiive bytecode otherwise."
- 	 SistaV1:	248		11111000 	iiiiiiii		mjjjjjjj		Call Primitive #iiiiiiii + (jjjjjjj * 256) m=1 means inlined primitive, no hard return after execution."
  	self cppIf: SistaVM
  		ifTrue:
+ 			[| byte1 byte2 prim header |
- 			[| byte1 byte2 prim |
  			 byte1 := self fetchByte.
  			 byte2 := self fetchByte.
  			 self fetchNextBytecode.
  			 byte2 < 128 ifTrue:
+ 				[header := self methodHeaderOf: method.
+ 				 ((self methodHeaderHasPrimitive: header)
+ 				  and: [localIP = (self initialPCForHeader: header method: method) + (self sizeOfCallPrimitiveBytecode: header)]) ifTrue:
+ 					[^self].
+ 				 localIP := localIP - 3.
- 				[localIP := localIP - 3.
  				 ^self respondToUnknownBytecode].
  			 prim := byte2 - 128 << 8 + byte1.
  			 prim < 1000 ifTrue:
  				[^self nullaryInlinePrimitive: prim].
  
  			 prim < 2000 ifTrue:
  				[^self unaryInlinePrimitive: prim - 1000].
  				
  			 prim < 3000 ifTrue:
  				[^self binaryInlinePrimitive: prim - 2000].
  
  			 prim < 4000 ifTrue:
  				[^self trinaryInlinePrimitive: prim - 3000].
  
  			 localIP := localIP - 3.
  			 ^self respondToUnknownBytecode]
  		ifFalse:
+ 			[| header |
+ 			 header := self methodHeaderOf: method.
+ 			 ((self methodHeaderHasPrimitive: header)
+ 			  and: [localIP = (self initialPCForHeader: header method: method)])
+ 				ifTrue:
+ 					[localIP := localIP + (self sizeOfCallPrimitiveBytecode: header).
+ 					 ^self fetchNextBytecode]
+ 				ifFalse:
+ 					[^self respondToUnknownBytecode]]!
- 			[self error: 'callPrimitiveBytecode should not be evaluated. method activation should step beyond this bytecode.']
- 
- 	"We could make it a noop and not skip it in {foo}ActivateMethod, as in:
- 
- 	localIP := localIP + 3.
- 	self fetchNextBytecode
- 
- 	 But for now, having {foo}ActivateMethod skip it makes it available for invoking embedded primitives."!

Item was changed:
  ----- Method: StackInterpreter>>validInstructionPointer:inFrame: (in category 'debug support') -----
  validInstructionPointer: anInstrPointer inFrame: fp
  	<var: #anInstrPointer type: #usqInt>
  	<var: #fp type: #'char *'>
  	<inline: false>
+ 	"Note that we accept anInstrPointer pointing to a callPrimitiveBytecode
+ 	 at the start of a method that contains a primitive.  This because methods like
+ 	 Context(Part)>>reset have to be updated to skip the callPrimtiive bytecode otherwise."
  	^self validInstructionPointer: anInstrPointer inMethod: (self frameMethodObject: fp) framePointer: fp!

Item was changed:
  ----- Method: StackInterpreter>>validInstructionPointer:inMethod:framePointer: (in category 'debug support') -----
  validInstructionPointer: theInstrPointer inMethod: aMethod framePointer: fp
  	<var: #theInstrPointer type: #usqInt>
  	<var: #aMethod type: #usqInt>
  	<var: #fp type: #'char *'>
+ 	"Note that we accept anInstrPointer pointing to a callPrimitiveBytecode
+ 	 at the start of a method that contains a primitive.  This because methods like
+ 	 Context(Part)>>reset have to be updated to skip the callPrimtiive bytecode otherwise."
- 	| methodHeader |
- 	objectMemory hasSpurMemoryManagerAPI ifTrue:
- 		[methodHeader := self noAssertHeaderOf: aMethod. "-1 for pre-increment in fetchNextBytecode"
- 		 ^theInstrPointer >= (aMethod + (objectMemory lastPointerOf: aMethod) + BytesPerOop - 1)
- 		   and: [theInstrPointer < (aMethod + (objectMemory numBytesOf: aMethod) + BaseHeaderSize - 1)
- 		   and: ["If the method starts with a CallPrimitive opcode the instruction pointer should be past it."
- 			((self alternateHeaderHasPrimitiveFlag: methodHeader)
- 			 and: [theInstrPointer < (aMethod
- 									+ BytesPerOop - 1
- 									+ (objectMemory lastPointerOf: aMethod)
- 									+ (self sizeOfCallPrimitiveBytecode: methodHeader))])
- 				not]]].
- 	MULTIPLEBYTECODESETS ifTrue:
- 		[methodHeader := self noAssertHeaderOf: aMethod. "-1 for pre-increment in fetchNextBytecode"
- 		 ^theInstrPointer >= (aMethod + (objectMemory lastPointerOf: aMethod) + BytesPerOop - 1)
- 		   and: [theInstrPointer < (aMethod + (objectMemory numBytesOf: aMethod) + BaseHeaderSize - 1)
- 		   and: ["If the method starts with a CallPrimitive opcode the instruction pointer should be past it."
- 			((self headerIndicatesAlternateBytecodeSet: methodHeader)
- 			  and: [(self alternateHeaderHasPrimitiveFlag: methodHeader)
- 			  and: [theInstrPointer < (aMethod
- 									+ BytesPerOop - 1
- 									+ (objectMemory lastPointerOf: aMethod)
- 									+ (self sizeOfCallPrimitiveBytecode: methodHeader))]])
- 				not]]].
  	"-1 for pre-increment in fetchNextBytecode"
  	^theInstrPointer >= (aMethod + (objectMemory lastPointerOf: aMethod) + objectMemory bytesPerOop - 1)
  	  and: [theInstrPointer < (aMethod + (objectMemory numBytesOf: aMethod) + objectMemory baseHeaderSize - 1)]!



More information about the Vm-dev mailing list