[Vm-dev] VM Maker: VMMaker.oscog-tfel.1863.mcz

commits at source.squeak.org commits at source.squeak.org
Fri May 20 11:53:30 UTC 2016


Tim Felgentreff uploaded a new version of VMMaker to project VM Maker:
http://source.squeak.org/VMMaker/VMMaker.oscog-tfel.1863.mcz

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

Name: VMMaker.oscog-tfel.1863
Author: tfel
Time: 20 May 2016, 1:52:06.566311 pm
UUID: 8e524803-55af-ec4b-aa97-9403376a9b13
Ancestors: VMMaker.oscog-tfel.1862, VMMaker.oscog-eem.1861

Fix Integer>>signedIntFromLong, this should really return a 32-bit signed integer, regardless of the platform's integer size.

=============== Diff against VMMaker.oscog-tfel.1862 ===============

Item was changed:
  ----- Method: CoInterpreter>>primitivePropertyFlagsForSpur: (in category 'cog jit support') -----
  primitivePropertyFlagsForSpur: primIndex
  	<inline: true>
  	"Answer any special requirements of the given primitive.  Spur always needs to set
  	 primitiveFunctionPointer and newMethod so primitives can retry on failure due to forwarders."
  	| baseFlags |
  	baseFlags := PrimCallNeedsPrimitiveFunction + PrimCallNeedsNewMethod.
  	profileSemaphore ~= objectMemory nilObject ifTrue:
  		[baseFlags := baseFlags bitOr: PrimCallCollectsProfileSamples].
  
  	self cCode: [] inSmalltalk: [#(primitiveExternalCall primitiveCalloutToFFI)]. "For senders..."
+ 		(primIndex = PrimNumberExternalCall "#primitiveExternalCall"
+ 	 or: [primIndex = PrimNumberFFICall "#primitiveCalloutToFFI"]) ifTrue: "For callbacks"
- 		(primIndex == 117 "#primitiveExternalCall"
- 	 or: [primIndex == 120 "#primitiveCalloutToFFI"]) ifTrue: "For callbacks"
  		[baseFlags := baseFlags bitOr: PrimCallMayCallBack.
  		 checkAllocFiller ifTrue:
  			[baseFlags := baseFlags bitOr: CheckAllocationFillerAfterPrimCall]].
  
  	^baseFlags!

Item was changed:
  ----- Method: CoInterpreter>>primitivePropertyFlagsForV3: (in category 'cog jit support') -----
  primitivePropertyFlagsForV3: primIndex
  	<inline: true>
  	"Answer any special requirements of the given primitive"
  	| baseFlags |
  	baseFlags := profileSemaphore ~= objectMemory nilObject
  					ifTrue: [PrimCallNeedsNewMethod + PrimCallCollectsProfileSamples]
  					ifFalse: [0].
  
  	longRunningPrimitiveCheckSemaphore ifNotNil:
  		[baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod].
  
  	self cCode: [] inSmalltalk: [#(primitiveExternalCall primitiveCalloutToFFI)]. "For senders..."
+ 		(primIndex = PrimNumberExternalCall "#primitiveExternalCall"
+ 	 or: [primIndex = PrimNumberFFICall "#primitiveCalloutToFFI"]) ifTrue: "For callbacks"
- 		(primIndex == 117 "#primitiveExternalCall"
- 	 or: [primIndex == 120 "#primitiveCalloutToFFI"]) ifTrue: "For callbacks"
  		[baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod + PrimCallNeedsPrimitiveFunction + PrimCallMayCallBack].
  
  	^baseFlags!

Item was changed:
  ----- Method: CoInterpreterMT>>markAndTraceInterpreterOops: (in category 'object memory support') -----
  markAndTraceInterpreterOops: fullGCFlag
  	"Mark and trace all oops in the interpreter's state."
  	"Assume: All traced variables contain valid oops.
  	 N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
  	 only during message lookup and because createActualMessageTo will not
  	 cause a GC these cannot change during message lookup."
  	| oop |
  	<var: #vmThread type: #'CogVMThread *'>
  	"Must mark stack pages first to initialize the per-page trace
  	 flags for full garbage collect before any subsequent tracing."
  	self markAndTraceStackPages: fullGCFlag.
  	self markAndTraceTraceLog.
  	self markAndTracePrimTraceLog.
  	objectMemory markAndTrace: objectMemory specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
  	(objectMemory isImmediate: newMethod) ifFalse:
  		[objectMemory markAndTrace: newMethod].
  	self traceProfileState.
  	tempOop = 0 ifFalse: [objectMemory markAndTrace: tempOop].
  	tempOop2 = 0 ifFalse: [objectMemory markAndTrace: tempOop2].
+ 	tempOop3 = 0 ifFalse: [objectMemory markAndTrace: tempOop3].
  
  	1 to: objectMemory remapBufferCount do:
  		[:i|
  		oop := objectMemory remapBuffer at: i.
  		(objectMemory isIntegerObject: oop) ifFalse:
  			[objectMemory markAndTrace: oop]].
  
  	"Callback support - trace suspended callback list - will be made per-thread soon"
  	1 to: jmpDepth do:
  		[:i|
  		oop := suspendedCallbacks at: i.
  		(objectMemory isIntegerObject: oop) ifFalse:
  			[objectMemory markAndTrace: oop].
  		oop := suspendedMethods at: i.
  		(objectMemory isIntegerObject: oop) ifFalse:
  			[objectMemory markAndTrace: oop]].
  
  	"Per-thread state; trace each thread's own newMethod and stack of awol processes."
  	1 to: cogThreadManager getNumThreads do:
  		[:i| | vmThread |
  		vmThread := cogThreadManager vmThreadAt: i.
  		vmThread state notNil ifTrue:
  			[vmThread newMethodOrNull notNil ifTrue:
  				[objectMemory markAndTrace: vmThread newMethodOrNull].
  			 0 to: vmThread awolProcIndex - 1 do:
  				[:j|
  				objectMemory markAndTrace: (vmThread awolProcesses at: j)]]]!

Item was changed:
  ----- Method: Integer>>asUnsignedInteger (in category '*VMMaker-interpreter simulator') -----
  asUnsignedInteger
+ 	"Since the simulator deals with positive integers most of the time we assert that the receiver is greater than zero.
+ 	 But one major exception is stack pointers in the StackInterpreterSimulator, which are negative.  So don't fail
+ 	 if the sender is a StackInterpreter and the receiver could be a stack pointer."
+ 	self >= 0 ifFalse:
+ 		[self assert: ((thisContext sender methodClass includesBehavior: StackInterpreter)
+ 					and: [thisContext sender receiver stackPages couldBeFramePointer: self])].
- 	self assert: self >= 0.
  	^self!

Item was changed:
  ----- Method: Integer>>signedIntFromLong (in category '*VMMaker-interpreter simulator') -----
  signedIntFromLong
  	"Self is a signed or unsigned 32-bit integer"
- 
  	| bits |
+ 	 "If it's already 32bits, avoid computation"
+ 	(self >= -16r80000000 and: [self <= 16r7FFFFFFF])
+ 		ifTrue: [^self].
- 	(self >= SmallInteger minVal and: [self <= SmallInteger maxVal]) ifTrue: "These are known to be SmallIntegers..."
- 		[^self].
  	bits := self bitAnd: 16rFFFFFFFF.
  	(bits digitAt: 4) <= 16r7F ifTrue: [^bits].
  	^bits - 16r100000000!

Item was removed:
- ----- Method: Spur32BitCoMemoryManager>>checkForLeaks (in category 'accessing') -----
- checkForLeaks
- 	^checkForLeaks!

Item was removed:
- ----- Method: Spur64BitCoMemoryManager>>checkForLeaks (in category 'accessing') -----
- checkForLeaks
- 	^checkForLeaks!

Item was added:
+ ----- Method: SpurGenerationScavenger>>printRememberedSet (in category 'debug support') -----
+ printRememberedSet
+ 	"Print the objects in the remembered set."
+ 	<api>
+ 	0 to: rememberedSetSize - 1 do:
+ 		[:i|
+ 		coInterpreter printNum: i; space; shortPrintOop: (rememberedSet at: i)]!

Item was changed:
  ----- Method: SpurGenerationScavenger>>referenceCountRememberedReferents: (in category 'remembered set') -----
  referenceCountRememberedReferents: population
  	"Both reference count young objects reachable from the RT,
  	 and count the populations of each ref count, in a single pass."
  	<var: 'population' declareC: 'long population[MaxRTRefCount + 1]'>
  	<inline: true>
  	0 to: rememberedSetSize - 1 do:
  		[:i| | elephant |
  		elephant := rememberedSet at: i.
+ 		(manager isForwarded: elephant) ifTrue:
+ 			[elephant := manager followForwarded: elephant.
+ 			 (manager isImmediate: elephant) ifTrue: "take care if elephant forwarded to an immediate"
+ 				[elephant := manager nilObject]].
  		0 to: (manager numPointerSlotsOf: elephant) - 1 do:
  			[:j| | referent refCount |
  			referent := manager fetchPointer: j ofObject: elephant.
  			(manager isReallyYoung: referent) ifTrue:
  				[refCount := manager rtRefCountOf: referent.
  				 refCount < MaxRTRefCount ifTrue:
  					[refCount > 0 ifTrue:
  						[population at: refCount put: (population at: refCount) - 1].
  					 refCount := refCount + 1.
  					 manager rtRefCountOf: referent put: refCount.
  					 population at: refCount put: (population at: refCount) + 1]]]].!

Item was added:
+ ----- Method: SpurMemoryManager>>checkForLeaks (in category 'accessing') -----
+ checkForLeaks
+ 	^checkForLeaks!

Item was changed:
  ----- Method: SpurMemoryManager>>doBecome:to:copyHash: (in category 'become implementation') -----
  doBecome: obj1 to: obj2 copyHash: copyHashFlag
  	"one-way become with or without copying obj1's hash into obj2.
  	 Straight-forward, even for classes.  With classes we end up with two entries
  	 for obj2.  Which is current depends on copyHashFlag.  If copyHashFlag is true
  	 then the entry at obj1's hash is valid, otherwise the the existing one at obj2's
  	 hash.  When all the instances with the old hash have been collected, the GC will
  	 discover this and expunge obj2 at the unused index (see markAndTraceClassOf:)."
  	self forward: obj1 to: obj2.
  	copyHashFlag ifTrue: [self setHashBitsOf: obj2 to: (self rawHashBitsOf: obj1)].
  	((self isOldObject: obj1)
+ 	 and: [self isYoung: obj2]) ifTrue:
- 	 and: [self isYoungObject: obj2]) ifTrue:
  		[becomeEffectsFlags := becomeEffectsFlags bitOr: OldBecameNewFlag].
+ 	self deny: (self isOopForwarded: obj2)!
- 	self deny: (self isForwarded: obj2)!

Item was changed:
  ----- Method: SpurMemoryManager>>innerBecomeObjectsIn:to:copyHash: (in category 'become implementation') -----
  innerBecomeObjectsIn: array1 to: array2 copyHash: copyHashFlag
  	"Inner loop of one-way become."
  	0 to: (self numSlotsOf: array1) - 1 do:
  		[:i| | obj1 obj2 |
  		"At first blush it would appear unnecessary to use followField: here since
  		 the validation in become:with:twoWay:copyHash: follows forwarders.  But
  		 there's nothing to ensure all elements of each array is unique and doesn't
  		 appear in the other array.  So the enumeration could encounter an object
  		 already becommed earlier in the same enumeration."
  		obj1 := self followField: i ofObject: array1.
  		obj2 := self followField: i ofObject: array2.
  		obj1 ~= obj2 ifTrue:
  			[self doBecome: obj1 to: obj2 copyHash: copyHashFlag.
  			 self followField: i ofObject: array1.
+ 			 self assert: (self isOopForwarded: obj2) not]]!
- 			 self assert: (self isForwarded: obj2) not]]!

Item was changed:
  InterpreterPrimitives subclass: #StackInterpreter
+ 	instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue localAbsentReceiver localAbsentReceiverOrZero extA extB primitiveFunctionPointer methodCache nsMethodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable primitiveAccessorDepthTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassNumSlots interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered checkAllocFiller tempOop tempOop2 tempOop3 theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex checkedPluginName statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals'
+ 	classVariableNames: 'AccessModifierPrivate AccessModifierProtected AccessModifierPublic AltBytecodeEncoderClassName AltLongStoreBytecode AlternateHeaderHasPrimFlag AlternateHeaderIsOptimizedFlag AlternateHeaderNumLiteralsMask AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeEncoderClassName BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex EnforceAccessControl FailImbalancedPrimitives LongStoreBytecode MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MethodHeaderArgCountShift MethodHeaderFlagBitPosition MethodHeaderTempCountShift MixinIndex PrimNumberDoExternalCall PrimNumberExternalCall PrimNumberFFICall PrimitiveExternalCallIndex PrimitiveTable StackPageReachedButUntraced StackPageTraceInvalid StackPageTraced StackPageUnreached V3PrimitiveBitsMask'
- 	instanceVariableNames: 'currentBytecode bytecodeSetSelector localFP localIP localSP stackLimit stackPage stackPages method instructionPointer stackPointer framePointer localReturnValue localAbsentReceiver localAbsentReceiverOrZero extA extB primitiveFunctionPointer methodCache nsMethodCache atCache lkupClassTag lkupClass methodDictLinearSearchLimit highestRunnableProcessPriority nextWakeupUsecs nextPollUsecs inIOProcessEvents interruptKeycode interruptPending savedWindowSize imageHeaderFlags fullScreenFlag deferDisplayUpdates pendingFinalizationSignals extraVMMemory interpreterProxy showSurfaceFn primitiveTable primitiveAccessorDepthTable externalPrimitiveTable externalPrimitiveTableFirstFreeIndex overflowedPage extraFramesToMoveOnOverflow globalSessionID jmpBuf jmpDepth suspendedCallbacks suspendedMethods numStackPages desiredNumStackPages desiredEdenBytes classNameIndex thisClassIndex metaclassNumSlots interruptCheckChain suppressHeartbeatFlag breakSelector breakSelectorLength longRunningPrimitiveCheckMethod longRunningPrimitiveCheckSemaphore longRunningPrimitiveStartUsecs longRunningPrimitiveStopUsecs longRunningPrimitiveGCUsecs longRunningPrimitiveCheckSequenceNumber longRunningPrimitiveSignalUndelivered checkAllocFiller tempOop tempOop2 theUnknownShort the2ndUnknownShort imageFloatsBigEndian maxExtSemTabSizeSet lastMethodCacheProbeWrite gcSemaphoreIndex classByteArrayCompactIndex statForceInterruptCheck statStackOverflow statStackPageDivorce statCheckForEvents statProcessSwitch statIOProcessEvents statPendingFinalizationSignals'
- 	classVariableNames: 'AccessModifierPrivate AccessModifierProtected AccessModifierPublic AltBytecodeEncoderClassName AltLongStoreBytecode AlternateHeaderHasPrimFlag AlternateHeaderIsOptimizedFlag AlternateHeaderNumLiteralsMask AtCacheFixedFields AtCacheFmt AtCacheMask AtCacheOop AtCacheSize AtCacheTotalSize AtPutBase BytecodeEncoderClassName BytecodeTable CacheProbeMax DirBadPath DirEntryFound DirNoMoreEntries DumpStackOnLowSpace EnclosingMixinIndex EnclosingObjectIndex EnforceAccessControl FailImbalancedPrimitives LongStoreBytecode MaxExternalPrimitiveTableSize MaxJumpBuf MaxPrimitiveIndex MaxQuickPrimitiveIndex MethodHeaderArgCountShift MethodHeaderFlagBitPosition MethodHeaderTempCountShift MixinIndex PrimitiveExternalCallIndex PrimitiveTable StackPageReachedButUntraced StackPageTraceInvalid StackPageTraced StackPageUnreached V3PrimitiveBitsMask'
  	poolDictionaries: 'VMBasicConstants VMBytecodeConstants VMMethodCacheConstants VMObjectIndices VMSpurObjectRepresentationConstants VMSqueakClassIndices VMStackFrameOffsets'
  	category: 'VMMaker-Interpreter'!
  
  !StackInterpreter commentStamp: 'eem 12/5/2014 11:32' prior: 0!
  This class is a complete implementation of the Smalltalk-80 virtual machine, derived originally from the Blue Book specification but quite different in some areas.  This VM supports Closures but *not* old-style BlockContexts.
  
  It has been modernized with 32-bit pointers, better management of Contexts (see next item), and attention to variable use that allows the CCodeGenerator (qv) to keep, eg, the instruction pointer and stack pointer in registers as well as keeping most simple variables in a global array that seems to improve performance for most platforms.
  
  The VM does not use Contexts directly.  Instead Contexts serve as proxies for a more conventional stack format that is invisible to the image.  There is considerable explanation at http://www.mirandabanda.org/cogblog/2009/01/14/under-cover-contexts-and-the-big-frame-up.  The VM maintains a fixed-size stack zone divided into pages, each page being capable of holding several method/block activations.  A send establishes a new frame in the current stack page, a return returns to the previous frame.  This eliminates allocation/deallocation of contexts and the moving of receiver and arguments from caller to callee on each send/return.  Contexts are created lazily when an activation needs a context (creating a block, explicit use of thisContext, access to sender when sender is a frame, or linking of stack pages together).  Contexts are either conventional and heap-resident ("single") or "married" and serve as proxies for their corresponding frame or "widowed", meaning that their spouse frame has been returned from (died).  A married context is specially marked (more details in the code) and refers to its frame.  Likewise a married frame is specially marked and refers to its context.
  
  In addition to SmallInteger arithmetic and Floats, the VM supports logic on 32-bit PositiveLargeIntegers, thus allowing it to simulate itself much more effectively than would otherwise be the case.
  
  StackInterpreter and subclasses support multiple memory managers.  Currently there are two.  NewMemoryManager is a slightly refined version of ObjectMemory, and is the memory manager and garbage collector for the original Squeak object representation as described in "Back to the Future The Story of Squeak, A Practical Smalltalk Written in Itself", see http://ftp.squeak.org/docs/OOPSLA.Squeak.html.  Spur is a faster, more regular object representation that is designed for more performance and functionality, and to have a common header format for both 32-bit and 64-bit versions.  You can read about it in SpurMemoryManager's class comment.  There is also a video of a presentation at ESUG 2014 (https://www.youtube.com/watch?v=k0nBNS1aHZ4), along with slides (http://www.slideshare.net/esug/spur-a-new-object-representation-for-cog?related=1).!

Item was changed:
  ----- Method: StackInterpreter class>>initializeMiscConstants (in category 'initialization') -----
  initializeMiscConstants
  
  	super initializeMiscConstants.
  	STACKVM := true.
  
  	"These flags function to identify a GC operation, or
  	 to specify what operations the leak checker should be run for."
  	GCModeFull := 1.				"stop-the-world global GC"
  	GCModeNewSpace := 2.		"Spur's scavenge, or V3's incremental"
  	GCModeIncremental := 4.		"incremental global gc (Dijkstra tri-colour marking); as yet unimplemented"
+ 	GCModeBecome := 8.			"v3 post-become sweeping/Spur forwarding"
- 	GCModeBecome := 8.			"v3 post-become sweeping"
  	GCModeImageSegment := 16.	"just a flag for leak checking image segments"
  	GCModeFreeSpace := 32.		"just a flag for leak checking free space; Spur only"
+ 	GCCheckPrimCall := 64.		"just a flag for leak checking external primitive calls"
  
  	StackPageTraceInvalid := -1.
  	StackPageUnreached := 0.
  	StackPageReachedButUntraced := 1.
  	StackPageTraced := 2.
  
  	DumpStackOnLowSpace := 0.
  	PrimitiveExternalCallIndex := 117. "Primitive index for #primitiveExternalCall"
  	MillisecondClockMask := 16r1FFFFFFF.
  	"Note: The external primitive table should actually be dynamically sized but for the sake of inferior platforms (e.g., Mac :-) who cannot allocate memory in any reasonable way, we keep it static (and cross our fingers...)"
  	MaxExternalPrimitiveTableSize := 4096. "entries"
  
  	MaxJumpBuf := 32. "max. callback depth"
  	FailImbalancedPrimitives := initializationOptions at: #FailImbalancedPrimitives ifAbsentPut: [true].
  	EnforceAccessControl := initializationOptions at: #EnforceAccessControl ifAbsent: [true]!

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

Item was changed:
  ----- Method: StackInterpreter class>>mustBeGlobal: (in category 'translation') -----
  mustBeGlobal: var
  	"Answer if a variable must be global and exported.  Used for inst vars that are accessed from VM support code."
  
  	^(super mustBeGlobal: var)
  	   or: [(self objectMemoryClass mustBeGlobal: var)
  	   or: [(#('interpreterProxy' 'interpreterVersion' 'inIOProcessEvents'
  			'deferDisplayUpdates' 'extraVMMemory' 'showSurfaceFn'
  			'desiredNumStackPages' 'desiredEdenBytes'
+ 			'breakSelector' 'breakSelectorLength' 'sendTrace' 'checkAllocFiller' 'checkedPluginName'
- 			'breakSelector' 'breakSelectorLength' 'sendTrace' 'checkAllocFiller'
  			'suppressHeartbeatFlag') includes: var)
  	   or: [ "This allows slow machines to define bytecodeSetSelector as 0
  			to avoid the interpretation overhead."
  			MULTIPLEBYTECODESETS not and: [var = 'bytecodeSetSelector']]]]!

Item was changed:
  ----- Method: StackInterpreter>>checkForAndFollowForwardedPrimitiveState (in category 'primitive support') -----
  checkForAndFollowForwardedPrimitiveState
  	"In Spur a primitive may fail due to encountering a forwarder. On failure,
  	 check the accessorDepth for the primitive and if non-negative scan the
  	 args to the depth, following any forwarders.  Answer if any are found so
  	 the prim can be retried.  The primitive index is derived from newMethod.
  	 If the primitive is 118, then primitiveDoPrimitiveWithArgs sets newMethod
  	 to a SmallInteger whose value is the primitive it is evaluating."
  	<option: #SpurObjectMemory>
  	| primIndex accessorDepth found scannedStackFrame |
  	self assert: self failed.
  	found := scannedStackFrame := false.
  	primIndex := (objectMemory isIntegerObject: newMethod)
  					ifTrue: [objectMemory integerValueOf: newMethod]
  					ifFalse:
  						[self assert: argumentCount = (self argumentCountOf: newMethod).
  						 self primitiveIndexOf: newMethod].
  	accessorDepth := primitiveAccessorDepthTable at: primIndex.
  	"For the method-executing primitives, failure could have been in those primitives or the
  	 primitives of the methods they execute.  Find out which failed by seeing what is in effect."
+ 	((primIndex = PrimNumberExternalCall and: [primitiveFunctionPointer ~~ #primitiveExternalCall])
+ 	 or: [primIndex = PrimNumberDoExternalCall and: [primitiveFunctionPointer ~~ #primitiveDoNamedPrimitiveWithArgs]])
- 	((primIndex = 117 and: [primitiveFunctionPointer ~~ #primitiveExternalCall])
- 	 or: [primIndex = 218 and: [primitiveFunctionPointer ~~ #primitiveDoNamedPrimitiveWithArgs]])
  		ifTrue:
  			[accessorDepth := self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod]
  		ifFalse:
  			[self assert: (self saneFunctionPointerForFailureOfPrimIndex: primIndex)].
+ 	self assert: (accessorDepth between: -1 and: 4).
- 	self assert: (accessorDepth between: -127 and: 127).
  	accessorDepth >= 0 ifTrue:
  		[0 to: argumentCount do:
  			[:index| | oop |
  			oop := self stackValue: index.
  			(objectMemory isNonImmediate: oop) ifTrue:
  				[(objectMemory isForwarded: oop) ifTrue:
  					[self assert: index < argumentCount. "receiver should have been caught at send time."
  					 found := true.
  					 oop := objectMemory followForwarded: oop.
  					 self stackValue: index put: oop.
  					 scannedStackFrame ifFalse:
  						[scannedStackFrame := true.
  						 self
  							followForwardedFrameContents: framePointer
  							stackPointer: stackPointer + (argumentCount + 1 * objectMemory wordSize) "don't repeat effort"]].
  				(accessorDepth > 0
  			 	 and: [(objectMemory hasPointerFields: oop)
  				 and: [objectMemory followForwardedObjectFields: oop toDepth: accessorDepth]]) ifTrue:
  					[found := true]]]].
  	^found!

Item was changed:
  ----- Method: StackInterpreter>>checkInterpreterIntegrity (in category 'object memory support') -----
  checkInterpreterIntegrity
  	"Perform an integrity/leak check using the heapMap.  Assume
  	 clearLeakMapAndMapAccessibleObjects has set a bit at each
  	 object's header.  Check that all oops in the interpreter's state
  	 points to a header.  Answer if all checks pass."
  	| ok |
  	ok := true.
  	(objectMemory checkOopIntegrity: objectMemory specialObjectsOop named: 'specialObjectsOop')ifFalse:
  		[ok := false].
  	"No longer check messageSelector; it is ephemeral, not living beyond message lookup.
  	(objectMemory isNonImmediate: messageSelector) ifTrue:
  		[(objectMemory checkOopIntegrity: messageSelector named: 'messageSelector')ifFalse:
  			[ok := false]]."
  	(objectMemory checkOopIntegrity: newMethod named: 'newMethod')ifFalse:
  		[ok := false].
  	"No longer check lkupClass; it is ephemeral, not living beyond message lookup.
  	(objectMemory checkOopIntegrity: lkupClass named: 'lkupClass')ifFalse:
  		[ok := false]."
  	(objectMemory checkOopIntegrity: profileProcess named: 'profileProcess')ifFalse:
  		[ok := false].
  	(objectMemory checkOopIntegrity: profileMethod named: 'profileMethod')ifFalse:
  		[ok := false].
  	(objectMemory checkOopIntegrity: profileSemaphore named: 'profileSemaphore')ifFalse:
  		[ok := false].
  	tempOop = 0 ifFalse:
  		[(objectMemory checkOopIntegrity: tempOop named: 'tempOop')ifFalse:
  			[ok := false]].
  	tempOop2 = 0 ifFalse:
  		[(objectMemory checkOopIntegrity: tempOop2 named: 'tempOop2')ifFalse:
  			[ok := false]].
+ 	tempOop3 = 0 ifFalse:
+ 		[(objectMemory checkOopIntegrity: tempOop3 named: 'tempOop3')ifFalse:
+ 			[ok := false]].
  
  	"Callback support - check suspended callback list"
  	1 to: jmpDepth do:
  		[:i|
  		(objectMemory checkOopIntegrity: (suspendedCallbacks at: i) named: 'suspendedCallbacks' index: i) ifFalse:
  			[ok := false].
  		(objectMemory checkOopIntegrity: (suspendedMethods at: i) named: 'suspendedMethods' index: i) ifFalse:
  			[ok := false]].
  
  	self checkLogIntegrity ifFalse:
  		[ok := false].
  
  	^ok!

Item was changed:
  ----- Method: StackInterpreter>>initialize (in category 'initialization') -----
  initialize
  	"Here we can initialize the variables C initializes to zero.  #initialize methods do /not/ get translated."
  	checkAllocFiller := false. "must precede initializeObjectMemory:"
  	primFailCode := 0.
  	stackLimit := 0. "This is also the initialization flag for the stack system."
  	stackPage := overflowedPage := 0.
  	extraFramesToMoveOnOverflow := 0.
  	bytecodeSetSelector := 0.
  	highestRunnableProcessPriority := 0.
  	nextProfileTick := 0.
  	nextPollUsecs := 0.
  	nextWakeupUsecs := 0.
+ 	tempOop := tempOop2 := tempOop3 := theUnknownShort := 0.
- 	tempOop := tempOop2 := theUnknownShort := 0.
  	interruptPending := false.
  	inIOProcessEvents := 0.
  	fullScreenFlag := 0.
  	deferDisplayUpdates := false.
  	pendingFinalizationSignals := statPendingFinalizationSignals := 0.
  	globalSessionID := 0.
  	jmpDepth := 0.
  	longRunningPrimitiveStartUsecs := longRunningPrimitiveStopUsecs := 0.
  	maxExtSemTabSizeSet := false.
  	statForceInterruptCheck := statStackOverflow := statCheckForEvents :=
  	statProcessSwitch := statIOProcessEvents := statStackPageDivorce := 0!

Item was added:
+ ----- Method: StackInterpreter>>isExternalPrimitiveCall: (in category 'compiled methods') -----
+ isExternalPrimitiveCall: aMethodObj
+ 	"Answer if the method is an external primtiive call (prim 117)."
+ 	<inline: true>
+ 	^(self primitiveIndexOf: aMethodObj) = PrimNumberExternalCall!

Item was changed:
  ----- Method: StackInterpreter>>isNullExternalPrimitiveCall: (in category 'compiled methods') -----
  isNullExternalPrimitiveCall: aMethodObj
  	"Answer if the method is an external primtiive call (prim 117) with a null external primtiive.
  	 This is just for an assert in the CoInterpreter."
  	| lit |
+ 	((self isExternalPrimitiveCall: aMethodObj)
- 	((self primitiveIndexOf: aMethodObj) = 117
  	and: [(objectMemory literalCountOf: aMethodObj) > 0]) ifFalse:
  		[^false].
  
  	lit := self literal: 0 ofMethod: aMethodObj.
  	^(objectMemory isArray: lit)
+ 	  and: [(objectMemory numSlotsOf: lit) = 4
- 	  and: [(objectMemory lengthOf: lit) = 4
  	  and: [(objectMemory fetchPointer: 3 ofObject: lit) = ConstZero
  			or: [(objectMemory fetchPointer: 3 ofObject: lit) = ConstMinusOne]]]!

Item was changed:
  ----- Method: StackInterpreter>>mapInterpreterOops (in category 'object memory support') -----
  mapInterpreterOops
  	"Map all oops in the interpreter's state to their new values 
  	 during garbage collection or a become: operation."
  	"Assume: All traced variables contain valid oops."
  	<inline: false>
  	self mapStackPages.
  	self mapMachineCode: self getGCMode.
  	self mapTraceLogs.
  	self mapVMRegisters.
  	self mapProfileState.
  	self remapCallbackState.
  	(tempOop ~= 0
  	 and: [objectMemory shouldRemapOop: tempOop]) ifTrue:
  		[tempOop := objectMemory remapObj: tempOop].
  	(tempOop2 ~= 0
  	 and: [objectMemory shouldRemapOop: tempOop2]) ifTrue:
+ 		[tempOop2 := objectMemory remapObj: tempOop2].
+ 	(tempOop3 ~= 0
+ 	 and: [objectMemory shouldRemapOop: tempOop3]) ifTrue:
+ 		[tempOop3 := objectMemory remapObj: tempOop3]!
- 		[tempOop2 := objectMemory remapObj: tempOop2]!

Item was changed:
  ----- Method: StackInterpreter>>markAndTraceInterpreterOops: (in category 'object memory support') -----
  markAndTraceInterpreterOops: fullGCFlag
  	"Mark and trace all oops in the interpreter's state."
  	"Assume: All traced variables contain valid oops.
  	 N.B. Don't trace messageSelector and lkupClass; these are ephemeral, live
  	 only during message lookup and because createActualMessageTo will not
  	 cause a GC these cannot change during message lookup."
  	| oop |
  	"Must mark stack pages first to initialize the per-page trace
  	 flags for full garbage collect before any subsequent tracing."
  	self markAndTraceStackPages: fullGCFlag.
  	self markAndTraceTraceLog.
  	self markAndTracePrimTraceLog.
  	objectMemory markAndTrace: objectMemory specialObjectsOop. "also covers nilObj, trueObj, falseObj, and compact classes"
  	(objectMemory isImmediate: newMethod) ifFalse:
  		[objectMemory markAndTrace: newMethod].
  	self traceProfileState.
  	tempOop = 0 ifFalse: [objectMemory markAndTrace: tempOop].
  	tempOop2 = 0 ifFalse: [objectMemory markAndTrace: tempOop2].
+ 	tempOop3 = 0 ifFalse: [objectMemory markAndTrace: tempOop3].
  
  	1 to: objectMemory remapBufferCount do: [:i | 
  			oop := objectMemory remapBuffer at: i.
  			(objectMemory isIntegerObject: oop) ifFalse: [objectMemory markAndTrace: oop]].
  
  	"Callback support - trace suspended callback list"
  	1 to: jmpDepth do:[:i|
  		oop := suspendedCallbacks at: i.
  		(objectMemory isIntegerObject: oop) ifFalse:[objectMemory markAndTrace: oop].
  		oop := suspendedMethods at: i.
  		(objectMemory isIntegerObject: oop) ifFalse:[objectMemory markAndTrace: oop].
  	]!

Item was added:
+ ----- Method: StackInterpreter>>maybeLeakCheckExternalPrimCall: (in category 'debug support') -----
+ maybeLeakCheckExternalPrimCall: aMethodObj
+ 	"Assert-only check for leaks after external prim calls if checkForLeaks includes the GCCheckPrimCall flag.
+ 	 This is ionly really useful from a low-level C debugger, hence no accessors for checkedPluginName."
+ 	((objectMemory checkForLeaks anyMask: GCCheckPrimCall)
+ 	 and: [(self isExternalPrimitiveCall: aMethodObj)
+ 	 and: [checkedPluginName = (objectMemory fetchPointer: 0 ofObject: (self literal: 0 ofMethod: aMethodObj))]]) ifTrue:
+ 		[objectMemory runLeakCheckerFor: GCCheckPrimCall].
+ 	^true!

Item was changed:
  ----- Method: StackInterpreter>>slowPrimitiveResponse (in category 'primitive support') -----
  slowPrimitiveResponse
  	"Invoke a normal (non-quick) primitive.
  	 Called under the assumption that primFunctionPointer has been preloaded."
  	| nArgs savedFramePointer savedStackPointer |
  	<inline: true>
  	<var: #savedFramePointer type: #'char *'>
  	<var: #savedStackPointer type: #'char *'>
  	self assert: (objectMemory isOopForwarded: (self stackValue: argumentCount)) not.
  	self assert: objectMemory remapBufferCount = 0.
  	FailImbalancedPrimitives ifTrue:
  		[nArgs := argumentCount.
  		 savedStackPointer := stackPointer.
  		 savedFramePointer := framePointer].
  	self initPrimCall.
  	self dispatchFunctionPointer: primitiveFunctionPointer.
+ 	self assert: (self maybeLeakCheckExternalPrimCall: newMethod).
  	self maybeRetryFailureDueToForwarding.
  	self maybeFailForLastObjectOverwrite.
  	(FailImbalancedPrimitives
  	and: [self successful
  	and: [framePointer = savedFramePointer
  	and: [(self isMachineCodeFrame: framePointer) not]]]) ifTrue:"Don't fail if primitive has done something radical, e.g. perform:"
  		[stackPointer ~= (savedStackPointer + (nArgs * objectMemory wordSize)) ifTrue:
  			[self flag: 'Would be nice to make this a message send of e.g. unbalancedPrimitive to the current process or context'.
  			 "This is necessary but insufficient; the result may still have been written to the stack.
  			   At least we'll know something is wrong."
  			 stackPointer := savedStackPointer.
  			 self failUnbalancedPrimitive]].
  	"If we are profiling, take accurate primitive measures"
  	nextProfileTick > 0 ifTrue:
  		[self checkProfileTick: newMethod].
  	^self successful!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveDoNamedPrimitiveWithArgs (in category 'plugin primitives') -----
  primitiveDoNamedPrimitiveWithArgs
  	"Simulate an primitiveExternalCall invocation (e.g. for the Debugger).  Do not cache anything.
  	 e.g. ContextPart>>tryNamedPrimitiveIn: aCompiledMethod for: aReceiver withArgs: arguments"
  	| argumentArray arraySize methodArg methodHeader
  	  moduleName functionName moduleLength functionLength
  	  spec addr primRcvr isArray |
  	<var: #addr declareC: 'void (*addr)()'>
  	argumentArray := self stackTop.
  	methodArg := self stackValue: 2.
  	((objectMemory isArray: argumentArray)
  	 and: [objectMemory isOopCompiledMethod: methodArg]) ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args"
  	arraySize := objectMemory numSlotsOf: argumentArray.
  	(self roomToPushNArgs: arraySize) ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args"
  
  	methodHeader := objectMemory methodHeaderOf: methodArg.
  	(objectMemory literalCountOfMethodHeader: methodHeader) > 2 ifFalse:
  		[^self primitiveFailFor: -3]. "invalid methodArg state"
  	spec := objectMemory fetchPointer: 1 "first literal" ofObject: methodArg.
  	isArray := self isInstanceOfClassArray: spec.
  	(isArray
+ 	and: [(objectMemory numSlotsOf: spec) = 4
+ 	and: [(self primitiveIndexOfMethod: methodArg header: methodHeader) = PrimNumberExternalCall]]) ifFalse:
- 	and: [(objectMemory lengthOf: spec) = 4
- 	and: [(self primitiveIndexOfMethod: methodArg header: methodHeader) = 117]]) ifFalse:
  		[^self primitiveFailFor: -3]. "invalid methodArg state"
  
  	(self argumentCountOfMethodHeader: methodHeader) = arraySize ifFalse:
  		[^self primitiveFailFor: -2]. "invalid args (Array args wrong size)"
  
  	"The function has not been loaded yet. Fetch module and function name."
  	moduleName := objectMemory fetchPointer: 0 ofObject: spec.
  	moduleName = objectMemory nilObject
  		ifTrue: [moduleLength := 0]
  		ifFalse: [self success: (objectMemory isBytes: moduleName).
  				moduleLength := objectMemory lengthOf: moduleName.
  				self cCode: '' inSmalltalk:
  					[ (#('FloatArrayPlugin' 'Matrix2x3Plugin') includes: (self stringOf: moduleName)) "??"
  						ifTrue: [moduleLength := 0  "Cause all of these to fail"]]].
  	functionName := objectMemory fetchPointer: 1 ofObject: spec.
  	self success: (objectMemory isBytes: functionName).
  	functionLength := objectMemory lengthOf: functionName.
  	self successful ifFalse: [^self primitiveFailFor: -3]. "invalid methodArg state"
  
  	addr := self ioLoadExternalFunction: functionName + objectMemory baseHeaderSize
  				OfLength: functionLength
  				FromModule: moduleName + objectMemory baseHeaderSize
  				OfLength: moduleLength.
  	addr = 0 ifTrue:
  		[^self primitiveFailFor: -1]. "could not find function; answer generic failure (see below)"
  
  	"Cannot fail this primitive from now on.  Can only fail the external primitive."
  	tempOop := objectMemory
  						eeInstantiateClassIndex: ClassArrayCompactIndex
  						format: objectMemory arrayFormat
  						numSlots: (objectMemory hasSpurMemoryManagerAPI
  									ifTrue: [5]
  									ifFalse: [4]).
  	objectMemory
  		storePointerUnchecked: 0 ofObject: tempOop withValue: (argumentArray := self popStack);
  		storePointerUnchecked: 1 ofObject: tempOop withValue: (primRcvr := self popStack);
  		storePointerUnchecked: 2 ofObject: tempOop withValue: self popStack; "the method"
  		storePointerUnchecked: 3 ofObject: tempOop withValue: self popStack. "the context receiver"
  	self push: primRcvr. "replace context receiver with actual receiver"
  	argumentCount := arraySize.
  	1 to: arraySize do:
  		[:index| self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray)].
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			[objectMemory storePointerUnchecked: 4 ofObject: tempOop withValue: newMethod.
  			 newMethod := methodArg.
  			 self callExternalPrimitive: addr. "On Spur, sets primitiveFunctionPointer"
  			 self maybeRetryFailureDueToForwarding.
  			 newMethod := objectMemory fetchPointer: 4 ofObject: tempOop]
  		ifFalse:
  			[self callExternalPrimitive: addr].
  	self successful ifFalse: "If primitive failed, then restore state for failure code"
  		[self pop: arraySize + 1.
  		 self push: (objectMemory fetchPointer: 3 ofObject: tempOop).
  		 self push: (objectMemory fetchPointer: 2 ofObject: tempOop).
  		 self push: (objectMemory fetchPointer: 1 ofObject: tempOop).
  		 self push: (objectMemory fetchPointer: 0 ofObject: tempOop).
  		 argumentCount := 3.
  		 "Must reset primitiveFunctionPointer for checkForAndFollowForwardedPrimitiveState"
  		 objectMemory hasSpurMemoryManagerAPI ifTrue:
  			[primitiveFunctionPointer := #primitiveDoNamedPrimitiveWithArgs].
  		 "Hack.  A nil prim error code (primErrorCode = 1) is interpreted by the image
  		  as meaning this primitive is not implemented.  So to pass back nil as an error
  		  code we use -1 to indicate generic failure."
  		 primFailCode = 1 ifTrue:
  			[primFailCode := -1]]!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveDoPrimitiveWithArgs (in category 'control primitives') -----
  primitiveDoPrimitiveWithArgs
+ 	"Implement either ProtoObject>>tryPrimitive: primIndex withArgs: argArray
+ 	 or Context>>receiver: anObject tryPrimitive: primIndex withArgs: argArray.
+ 	 If this primitive fails, arrange that its error code is a negative integer, to
+ 	 distinguish between this failing and the primitive it invokes failing."
+ 	| argumentArray arraySize index primIdx savedNumArgs rcvr |
+ 	(argumentCount between: 2 and: 3) ifFalse:
+ 		[^self primitiveFailFor: PrimErrUnsupported negated].
- 	| argumentArray arraySize index primIdx |
  	argumentArray := self stackTop.
+ 	primIdx := self stackValue: 1.
+ 	((objectMemory isArray: argumentArray)
+ 	 and: [objectMemory isIntegerObject: primIdx]) ifFalse:
+ 		[^self primitiveFailFor: PrimErrBadArgument negated].
- 	(objectMemory isArray: argumentArray) ifFalse: [^self primitiveFail].
  	arraySize := objectMemory numSlotsOf: argumentArray.
+ 	(self roomToPushNArgs: arraySize) ifFalse:
+ 		[^self primitiveFailFor: PrimErrLimitExceeded negated].
- 	self success: (self roomToPushNArgs: arraySize).
  
+ 	primIdx := objectMemory integerValueOf: primIdx.
- 	primIdx := self stackIntegerValue: 1.
- 	self successful ifFalse: [^self primitiveFail]. "invalid args"
- 
  	primitiveFunctionPointer := self functionPointerFor: primIdx inClass: nil.
  	primitiveFunctionPointer = 0 ifTrue:
  		[primitiveFunctionPointer := #primitiveDoPrimitiveWithArgs.
+ 		 ^self primitiveFailFor: PrimErrBadIndex negated].
- 		 ^self primitiveFail].
  
  	"Pop primIndex and argArray, then push args in place..."
+ 	(savedNumArgs := argumentCount) = 3
+ 		ifTrue: "...and receiver if the three arg form"
+ 			[tempOop2 := self stackValue: 4. "actual receiver"
+ 			 rcvr := self stackValue: 3. "receiver for primitive"
+ 			 (objectMemory isOopForwarded: rcvr) ifTrue:
+ 				[rcvr := objectMemory followForwarded: rcvr].
+ 			 self pop: 4; push: rcvr] "use first arg as receiver"
+ 		ifFalse:
+ 			[self pop: 2].
- 	self pop: 2.
  	argumentCount := arraySize.
  	index := 1.
  	[index <= argumentCount] whileTrue:
  		[self push: (objectMemory fetchPointer: index - 1 ofObject: argumentArray).
  		 index := index + 1].
  
  	self isPrimitiveFunctionPointerAnIndex ifTrue:
  		[self externalQuickPrimitiveResponse.
+ 		 tempOop2 := 0.
  		^nil].
  	"We use tempOop instead of pushRemappableOop:/popRemappableOop here because in
  	 the Cogit primitiveEnterCriticalSection, primitiveSignal, primitiveResume et al longjmp back
  	 to either the interpreter or machine code, depending on the process activated.  So if we're
+ 	 executing one of these primitives, control won't actually return here and the matching
+ 	 popRemappableOop: wouldn't occur, potentially overflowing the remap buffer.
+ 	 Note that while recursion could occur (nil tryPrimitive: 118 withArgs: #(118 #(110 #())))
+ 	 it counts as shooting oneself in the foot."
- 	 executing one of these primitives control won't actually return here and the matching
- 	 popRemappableOop: wouldn't occur, potentially overflowing the remap buffer.  While recursion
- 	 could occur (nil tryPrimitive: 118 withArgs: #(111 #())) it counts as shooting oneself in the foot."
  	tempOop := argumentArray. "prim might alloc/gc"
- 	"Run the primitive (sets primFailCode)"
  
+ 	"Run the primitive (sets primFailCode)"
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
+ 			[tempOop3 := newMethod.
- 			[tempOop2 := newMethod.
  			 newMethod := objectMemory integerObjectOf: primIdx.
  			 self slowPrimitiveResponse.
+ 			 newMethod := tempOop3.
+ 			 tempOop3 := 0]
- 			 newMethod := tempOop2.
- 			 tempOop2 := 0]
  		ifFalse:
  			[self slowPrimitiveResponse].
+ 
  	self successful ifFalse: "If primitive failed, then restore state for failure code"
  		[self pop: arraySize.
+ 		 savedNumArgs = 3 ifTrue:
+ 			[rcvr := self stackTop.
+ 			 self stackTopPut: tempOop2.
+ 			 self push: rcvr].
  		 self pushInteger: primIdx.
  		 self push: tempOop.
  		 primitiveFunctionPointer := #primitiveDoPrimitiveWithArgs.
+ 		 argumentCount := savedNumArgs].
+ 	tempOop := tempOop2 := 0!
- 		 argumentCount := 2].
- 	tempOop := 0!

Item was changed:
  ----- Method: StackInterpreterPrimitives>>primitiveExternalCall (in category 'plugin primitives') -----
  primitiveExternalCall
  	"Call an external primitive. External primitive methods first literals are an array of
  		* The module name (String | Symbol)
  		* The function name (String | Symbol)
+ 		* The session ID (SmallInteger) [OBSOLETE], or in Spur, the accessorDepth (Integer)
- 		* The session ID (SmallInteger) [OBSOLETE] (or in Spur, the accessorDepth)
  		* The function index (Integer) in the externalPrimitiveTable
  	For fast interpreter dispatch in subsequent invocations the primitiveFunctionPointer
  	in the method cache is rewritten, either to the function itself, or to zero if the external
  	function is not found.   This allows for fast responses as long as the method stays in
  	the cache. The cache rewrite relies on lastMethodCacheProbeWrite which is set in
  	addNewMethodToCache:.
  	Now that the VM flushes function addresses from its tables, the session ID is obsolete,
  	but it is kept for backward compatibility. Also, a failed lookup is reported specially. If a
  	method has been  looked up and not been found, the function address is stored as -1
  	(i.e., the SmallInteger -1 to distinguish from 16rFFFFFFFF which may be returned from
  	lookup), and the primitive fails with PrimErrNotFound."
  	| lit addr moduleName functionName moduleLength functionLength accessorDepth index |
  	<var: #addr declareC: 'void (*addr)()'>
  	
  	"Check for it being a method for primitiveDoPrimitiveWithArgs.
  	 Fetch the first literal of the method; check its an Array of length 4.
  	 Look at the function index in case it has been loaded before"
  	((objectMemory isOopCompiledMethod: newMethod)
  	 and: [(objectMemory literalCountOf: newMethod) > 0
  	 and: [lit := self literal: 0 ofMethod: newMethod.
  		(objectMemory isArray: lit)
  	 and: [(objectMemory numSlotsOf: lit) = 4
  	 and: [index := objectMemory fetchPointer: 3 ofObject: lit.
  		objectMemory isIntegerObject: index]]]]) ifFalse:
  		[^self primitiveFailFor: PrimErrBadMethod].
  
  	index := objectMemory integerValueOf: index.
  	"Check if we have already looked up the function and failed."
  	index < 0 ifTrue:
  		["Function address was not found in this session, 
  		  Void the primitive function."
  		 self rewriteMethodCacheEntryForExternalPrimitiveToFunction: 0.
  		 ^self primitiveFailFor: PrimErrNotFound].
  
  	"Try to call the function directly"
  	(index > 0 and: [index <= MaxExternalPrimitiveTableSize]) ifTrue:
  		[addr := externalPrimitiveTable at: index - 1.
  		 addr ~= 0 ifTrue:
  			[self rewriteMethodCacheEntryForExternalPrimitiveToFunction: (self cCode: 'addr' inSmalltalk: [1000 + index]).
  			 self callExternalPrimitive: addr. "On Spur, sets primitiveFunctionPointer"
  			 self maybeRetryFailureDueToForwarding.
  			 ^nil].
  		"if we get here, then an index to the external prim was 
  		kept on the ST side although the underlying prim 
  		table was already flushed"
  		^self primitiveFailFor: PrimErrNamedInternal].
  
  	"Clean up session id and external primitive index"
  	objectMemory storePointerUnchecked: 2 ofObject: lit withValue: ConstZero.
  	objectMemory storePointerUnchecked: 3 ofObject: lit withValue: ConstZero.
  
  	"The function has not been loaded yet. Fetch module and function name."
  	moduleName := objectMemory fetchPointer: 0 ofObject: lit.
  	moduleName = objectMemory nilObject
  		ifTrue: [moduleLength := 0]
  		ifFalse: [(objectMemory isBytes: moduleName) ifFalse:
  					[self primitiveFailFor: PrimErrBadMethod].
  				moduleLength := objectMemory lengthOf: moduleName].
  	functionName := objectMemory fetchPointer: 1 ofObject: lit.
  	(objectMemory isBytes: functionName) ifFalse:
  		[self primitiveFailFor: PrimErrBadMethod].
  	functionLength := objectMemory lengthOf: functionName.
  
+ 	"Spur needs to know the primitive's accessorDepth which is stored in the third slot of the first literal."
- 	"Spur needs to know the primitive's accessorDepth which is stored in the last slot of the first literal."
  	objectMemory hasSpurMemoryManagerAPI
  		ifTrue:
  			[addr := self ioLoadExternalFunction: functionName + objectMemory baseHeaderSize
  						OfLength: functionLength
  						FromModule: moduleName + objectMemory baseHeaderSize
  						OfLength: moduleLength
  						AccessorDepthInto: (self addressOf: accessorDepth
  												 put: [:val| accessorDepth := val]).
  			 addr = 0
  				ifTrue: [index := -1]
  				ifFalse: "add the function to the external primitive table"
  					[index := self addToExternalPrimitiveTable: addr.
  					 objectMemory
  						storePointerUnchecked: 2
  						ofObject: lit
  						withValue: (objectMemory integerObjectOf: accessorDepth)]]
  		ifFalse:
  			[addr := self ioLoadExternalFunction: functionName + objectMemory baseHeaderSize
  						OfLength: functionLength
  						FromModule: moduleName + objectMemory baseHeaderSize
  						OfLength: moduleLength.
  			 addr = 0
  				ifTrue: [index := -1]
  				ifFalse: "add the function to the external primitive table"
  					[index := self addToExternalPrimitiveTable: addr]].
  
  	"Store the index (or -1 if failure) back in the literal"
  	objectMemory storePointerUnchecked: 3 ofObject: lit withValue: (objectMemory integerObjectOf: index).
  
  	"If the function has been successfully loaded cache and call it"
  	index >= 0
  		ifTrue:
  			[self rewriteMethodCacheEntryForExternalPrimitiveToFunction: (self cCode: [addr] inSmalltalk: [1000 + index]).
  			 self callExternalPrimitive: addr.
  			 self maybeRetryFailureDueToForwarding]
  		ifFalse: "Otherwise void the primitive function and fail"
  			[self rewriteMethodCacheEntryForExternalPrimitiveToFunction: 0.
  			 self assert: (objectMemory fetchPointer: 2 ofObject: lit) = ConstZero.
  			 self primitiveFailFor: PrimErrNotFound]!

Item was changed:
  ----- Method: StackInterpreterSimulator>>primitiveExecuteMethodArgsArray (in category 'control primitives') -----
  primitiveExecuteMethodArgsArray
+ 	self halt: thisContext selector.
+ 	"(objectMemory isOopCompiledMethod: self stackTop) ifFalse:
+ 		[self halt]."
- 	"self halt: thisContext selector."
- 	(objectMemory isOopCompiledMethod: self stackTop) ifFalse:
- 		[self halt].
  	^super primitiveExecuteMethodArgsArray!

Item was changed:
  SharedPool subclass: #VMBasicConstants
  	instanceVariableNames: ''
+ 	classVariableNames: 'BaseHeaderSize BytesPerOop BytesPerWord COGMTVM COGVM DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCCheckPrimCall GCModeBecome GCModeFreeSpace GCModeFull GCModeImageSegment GCModeIncremental GCModeNewSpace IMMUTABILITY MULTIPLEBYTECODESETS NewspeakVM PharoVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrUnsupported PrimErrWritePastObject PrimNoErr SPURVM STACKVM SistaVM VMBIGENDIAN'
- 	classVariableNames: 'BaseHeaderSize BytesPerOop BytesPerWord COGMTVM COGVM DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCModeBecome GCModeFreeSpace GCModeFull GCModeImageSegment GCModeIncremental GCModeNewSpace IMMUTABILITY MULTIPLEBYTECODESETS NewspeakVM PharoVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrUnsupported PrimErrWritePastObject PrimNoErr SPURVM STACKVM SistaVM VMBIGENDIAN'
  	poolDictionaries: ''
  	category: 'VMMaker-Interpreter'!
  
  !VMBasicConstants commentStamp: '<historical>' prior: 0!
  I am a shared pool for basic constants upon which the VM as a whole depends.
  
  self ensureClassPool.
  self classPool declare: #BytesPerWord from: VMSqueakV3ObjectRepresentationConstants classPool.
  self classPool declare: #BaseHeaderSize from: VMSqueakV3ObjectRepresentationConstants classPool
  (ObjectMemory classPool keys select: [:k| k beginsWith: 'Byte']) do:
  	[:k| self classPool declare: k from: ObjectMemory classPool]!



More information about the Vm-dev mailing list