VM Maker: VMMaker.oscog-eem.2751.mcz

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

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

Name: VMMaker.oscog-eem.2751
Author: eem
Time: 7 May 2020, 6:30:23.701624 pm
UUID: 877f34de-92b0-49a1-b34d-a6e97fe7aa4e
Ancestors: VMMaker.oscog-nice.2750

Spur: Fix assert that checks for a valid function pointer on primitive failure that was confiused by FFI calls.  Fix potential bug with primitive failure of external and FFI calls, making sure the first literal of the method is followed.  The first literal is state used to cache an external call or define the siognature of an ffi call.  Make sure that FFI calls have a valid accessor depth.

Fix a common speeling rorre.

Slang: initGlobalStructure is never used; nuke its generator.

=============== Diff against VMMaker.oscog-nice.2750 ===============

Item was removed:
- ----- Method: CCodeGeneratorGlobalStructure>>emitCCodeOn:doInlining:doAssertions: (in category 'C code generator') -----
- emitCCodeOn: aStream doInlining: inlineFlag doAssertions: assertionFlag
- super emitCCodeOn: aStream doInlining: inlineFlag doAssertions: assertionFlag.
-
- "we add an initialiser for the pointer to the global struct; "
- aStream
- cr;
- nextPutAll: 'void initGlobalStructure(void) {';cr;
- nextPutAll: '#if SQ_USE_GLOBAL_STRUCT_REG';cr;
- nextPutAll: 'foo = &fum;' ; cr;
- nextPutAll: '#endif';  cr;
- nextPutAll:'}';
- cr!

Item was changed:
  ----- Method: CoInterpreter class>>interpreterMachineCodeTransitions (in category 'documentation') -----
  interpreterMachineCodeTransitions
  "The CoInterpreter only asks the Cog compiler to generate machine-code methods
  when a bytecoded method has been found in the cache, or block value has tried to
  invoke a block in the method two times consecutively.  This prevents the compiler
  being asked to compile an infrequenttly used method.
 
  I would like the following to be true, but it isn't.  The interpreter *does* invoke
  machine-code primitives that may context switch.
 
  The CoInterpreter will only activate a Cog method that doesn't have a primitive
  (this does not mean it won't invoke a Cog block method; it just does so through the
  interpreted block value primitives).  This is to avoid serious complications with the
  process switch primitives.  The CoInterpreter needs to know if it should push the
  instructionPointer or save it in frameSavedIP and substitute ceReturtnToInterpreterPC
  as the pushed instruction pointer.  The process switch primitives need to know if
  they were called from the interpreter or from machine-code to know how to continue.
 
  If a process switch primitive has been invoked from the interpreter and switches to
  a process suspended in an interpreted method it can return to the interpreter.  In both
+ cases switching to a process in machine-code the primitive can continue via the
- cases switching to a process in machine-code the primtiive can continue via the
  ceEnterCogCodeXXX enilopmart(s).  But if in machine-code and switching to a process
+ in the interpreter it must longjmp to the interpreter.  So the process-switch primitives
- in the interpreter it must longjmp to the interpreter.  So the process-switch primtiives
  need to know whether they werer invoked from the interpreter or not.
 
  If the process-switch primitives are allowed to be invoked from the interpreter via a
  machine-code method then, in the immortal words of Robert Fripp, ``affairs stand a
  good chance of getting severely out of hand...'' (The Guitar Handbook, Ralph Denyer,
  p 114, Pan Books).  The VM now has to longjmp not only if invoked from machine code
  and switching to the interpreter but if invoked from the interpreter via machine code
  and switching to the interpreter.  The issue is that it is difficult to discover from within
  a primitive whether the primitive call is from machine code, as it should be; it isn't a
  concern of the primitive.  Hence KISS says ``no machine-code invocation of primitives
  from the interpreter''."!

Item was changed:
  ----- Method: CoInterpreter>>internalExecuteNewMethod (in category 'message sending') -----
  internalExecuteNewMethod
  <inline: true>
  "For interpreter performance and to ease the objectAsMethod implementation eagerly
+ evaluate the primitive, i.e. if the method is cogged and has a primitive /do not/ evaluate
- evaluate the primtiive, i.e. if the method is cogged and has a primitive /do not/ evaluate
  the machine code primitive, just evaluate primitiveFunctionPointer directly."
  | succeeded methodHeader |
  primitiveFunctionPointer ~= 0 ifTrue:
  [self isPrimitiveFunctionPointerAnIndex ifTrue:
  [^self internalQuickPrimitiveResponse].
  "slowPrimitiveResponse may of course context-switch.  If so we must reenter the
   new process appropriately, returning only if we've found an interpreter frame."
  self externalizeIPandSP.
  succeeded := self slowPrimitiveResponse.
  instructionPointer = cogit ceReturnToInterpreterPC ifTrue:
  [instructionPointer := self iframeSavedIP: framePointer].
  self internalizeIPandSP.
  succeeded ifTrue:
  [self return: self popStack toExecutive: true.
  self browserPluginReturnIfNeeded.
  ^nil]].
  methodHeader := self rawHeaderOf: newMethod.
  "if not primitive, or primitive failed, activate the method"
  (self isCogMethodReference: methodHeader) ifFalse:
  [^self internalActivateNewMethod].
  self iframeSavedIP: localFP put: localIP asInteger.
  instructionPointer := cogit ceReturnToInterpreterPC.
  self externalizeFPandSP.
  "THis may cintext switch and hence return..."
  self activateNewCogMethod: (self cCoerceSimple: methodHeader to: #'CogMethod *') inInterpreter: true.
  "Hence this si reachable..."
  self internalizeIPandSP!

Item was changed:
  ----- Method: CoInterpreter>>primNumberExternalCall (in category 'compiled methods') -----
  primNumberExternalCall
+ "Answer if the method is an external primitive call (prim 117)."
- "Answer if the method is an external primtiive call (prim 117)."
  <api>
  <cmacro>
  ^PrimNumberExternalCall!

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 |
  self cCode: [] inSmalltalk: [#(mcprimHashMultiply: primitiveExternalCall primitiveCalloutToFFI)]. "For senders..."
  primIndex = PrimNumberHashMultiply ifTrue:
  [^PrimCallOnSmalltalkStack].
  baseFlags := PrimCallNeedsPrimitiveFunction + PrimCallNeedsNewMethod.
  profileSemaphore ~= objectMemory nilObject ifTrue:
  [baseFlags := baseFlags bitOr: PrimCallCollectsProfileSamples].
 
+ (self isCalloutPrimitiveIndex: primIndex) ifTrue: "For callbacks"
- (primIndex = PrimNumberExternalCall "#primitiveExternalCall"
- or: [primIndex = PrimNumberFFICall "#primitiveCalloutToFFI"]) ifTrue: "For callbacks"
  [baseFlags := baseFlags bitOr: PrimCallMayCallBack].
 
  ^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..."
+ (self isCalloutPrimitiveIndex: primIndex) ifTrue: "For callbacks"
- (primIndex = PrimNumberExternalCall "#primitiveExternalCall"
- or: [primIndex = PrimNumberFFICall "#primitiveCalloutToFFI"]) ifTrue: "For callbacks"
  [baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod + PrimCallNeedsPrimitiveFunction + PrimCallMayCallBack].
 
  ^baseFlags!

Item was changed:
  ----- Method: CogVMSimulator class>>initialize (in category 'class initialization') -----
  initialize
+ "These are primitives that alter the state of the stack.  They are here simply for assert checking.
- "These are primtiives that alter the state of the stack.  They are here simply for assert checking.
  After invocation the Cogit should not check for the expected stack delta when these primitives
  succeed, because the stack will usually have been modified."
  StackAlteringPrimitives := #( primitiveClosureValue primitiveClosureValueWithArgs primitiveClosureValueNoContextSwitch
  primitiveEnterCriticalSection primitiveExitCriticalSection
  primitiveFullClosureValue primitiveFullClosureValueWithArgs primitiveFullClosureValueNoContextSwitch
  primitiveSignal primitiveWait primitiveResume primitiveSuspend primitiveYield
  primitiveExecuteMethodArgsArray primitiveExecuteMethod
  primitivePerform primitivePerformWithArgs primitivePerformInSuperclass
  primitiveTerminateTo primitiveStoreStackp primitiveDoPrimitiveWithArgs) asIdentitySet!

Item was changed:
  ----- Method: InterpreterPlugin>>evaluateIfFailed: (in category 'simulation') -----
  evaluateIfFailed: aBlock
+ "Evaluate aBlock, catching primitive failure, and failing if so.
- "Evaluate aBlock, catching primtiive failure, and failing if so.
  Answer if evaluating aBlock caused primitive failure."
  <doNotGenerate>
  aBlock
  on: Error
  do: [:ex|
  ((ex signalerContext selector beginsWith: #primitiveFailed) "e.g. could be error: sent from primitiveFailed:"
  or: [ex signalerContext sender selector beginsWith: #primitiveFailed]) ifFalse:
  [ex pass].
  interpreterProxy primitiveFail.
  ^true].
  ^false!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveCalloutToFFI (in category 'plugin primitives') -----
  primitiveCalloutToFFI
  "Perform a function call to a foreign function.
  Only invoked from method containing explicit external call spec.
  Due to this we use the pluggable prim mechanism explicitly here
  (the first literal of any FFI spec'ed method is an ExternalFunction
  and not an array as used in the pluggable primitive mechanism)."
 
+ <accessorDepth: 2> "Manually copied from primitiveCalloutAccessorDepth in the ThreadedFFIPlugins..."
- | primitiveCallout |
  <var: #primitiveCallout declareC: 'void (*primitiveCallout)(void)'>
+ self functionForPrimitiveCallout
+ ifNil: [self primitiveFail]
+ ifNotNil: [:primitiveCallout| self perform: primitiveCallout]!
- primitiveCallout := self functionForPrimitiveCallout.
- primitiveCallout isNil
- ifTrue: [self primitiveFail]
- ifFalse: [self perform: primitiveCallout]!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveLoadImageSegment (in category 'image segment in/out') -----
  primitiveLoadImageSegment
  "This primitive is called from Smalltalk as...
  <imageSegment> loadSegmentFrom: aWordArray outPointers: anArray.
 
  This primitive will load a binary image segment created by primitiveStoreImageSegment.
  It expects the outPointer array to be of the proper size, and the wordArray to be well
  formed.  It will return as its value the original array of roots, and the erstwhile
  segmentWordArray will have been truncated to a size of one word, i.e. retaining the version
  stamp.  If this primitive should fail, the segmentWordArray will, sadly, have been reduced to
  an unrecognizable and unusable jumble.  But what more could you have done with it anyway?
+ [How about saving it so the system functions as primitives are intended?  eem 5/9/2017 16:31]
- [How about saving it so the system functions as primtiives are intended?  eem 5/9/2017 16:31]
 
  In Spur, if the primitive succeeds, the segmentWordArray is also becomed into the array of loaded
  objects, to allow fixing up of loaded objects directly without nextObject, which Spur doesn't support."
 
  | outPointerArray segmentWordArray result |
 
  outPointerArray := self stackTop.
  segmentWordArray := self stackValue: 1.
 
  "Essential type checks"
  ((objectMemory isArray: outPointerArray) "Must be indexable pointers"
  and: [objectMemory isWords: segmentWordArray]) "Must be indexable words"
  ifFalse: [^self primitiveFail].
 
  "the engine returns the roots array which was first in the segment, or an error code on failure."
  result := objectMemory loadImageSegmentFrom: segmentWordArray outPointers: outPointerArray.
  (self oop: result isGreaterThan: segmentWordArray)
  ifTrue: [self pop: 3 thenPush: result]
  ifFalse: [self primitiveFailFor: result]!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>compilePrimitive (in category 'primitive generators') -----
  compilePrimitive
+ "Compile a primitive.  If possible, performance-critical primitives will
- "Compile a primitive.  If possible, performance-critical primtiives will
  be generated by their own routines (primitiveGenerator).  Otherwise,
  if there is a primitive at all, we call the C routine with the usual
  stack-switching dance, test the primFailCode and then either return
  on success or continue to the method body."
  <inline: false>
  | primitiveDescriptor primitiveRoutine flags |
  <var: #primitiveDescriptor type: #'PrimitiveDescriptor *'>
  <var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
  primitiveIndex = 0 ifTrue: [^0].
  "If a descriptor specifies an argument count (by numArgs >= 0) then it must match
  for the generated code to be correct.  For example for speed many primitives use
  ResultReceiverReg instead of accessing the stack, so the receiver better be at
  numArgs down the stack.  Use the interpreter version if not."
  ((primitiveDescriptor := self primitiveGeneratorOrNil) notNil
  and: [primitiveDescriptor primitiveGenerator notNil
  and: [(primitiveDescriptor primNumArgs < 0 "means generator doesn't care"
    or: [primitiveDescriptor primNumArgs = (coInterpreter argumentCountOf: methodObj)])]]) ifTrue:
  [| opcodeIndexAtPrimitive code |
  "Note opcodeIndex so that any arg load instructions
  for unimplemented primitives can be discarded."
  opcodeIndexAtPrimitive := opcodeIndex.
  code := objectRepresentation perform: primitiveDescriptor primitiveGenerator.
 
  (code < 0 and: [code ~= UnimplementedPrimitive]) ifTrue: "Generator failed, so no point continuing..."
  [^code].
  "If the primitive can never fail then there is nothing more that needs to be done."
  code = UnfailingPrimitive ifTrue:
  [^0].
  "If the machine code version handles all cases the only reason to call the interpreter
  primitive is to reap the primitive error code.  Don't bother if it isn't used."
  (code = CompletePrimitive
  and: [(self methodUsesPrimitiveErrorCode: methodObj header: methodHeader) not]) ifTrue:
  [^0].
  "Discard any arg load code generated by the primitive generator."
  code = UnimplementedPrimitive ifTrue:
  [opcodeIndex := opcodeIndexAtPrimitive]].
 
  flags := coInterpreter primitivePropertyFlags: primitiveIndex.
  (flags anyMask: PrimCallDoNotJIT) ifTrue:
  [^ShouldNotJIT].
 
  (flags anyMask: PrimCallOnSmalltalkStack) ifTrue:
  [self assert: flags = PrimCallOnSmalltalkStack.
  ^self compileMachineCodeInterpreterPrimitive: (self cCoerceSimple: (coInterpreter mcprimFunctionForPrimitiveIndex: primitiveIndex)
  to: 'void (*)(void)')].
 
  ((primitiveRoutine := coInterpreter
  functionPointerForCompiledMethod: methodObj
  primitiveIndex: primitiveIndex) = 0 "no primitive"
  or: [primitiveRoutine = (self cCoerceSimple: #primitiveFail to: 'void (*)(void)')]) ifTrue:
  [^self genFastPrimFail].
  minValidCallAddress := minValidCallAddress min: primitiveRoutine asUnsignedInteger.
  ^self compileInterpreterPrimitive: primitiveRoutine flags: flags!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>genLookupForPerformNumArgs: (in category 'primitive generators') -----
  genLookupForPerformNumArgs: numArgs
+ "Compile the code for a probe of the first-level method cache for a perform primitive.
- "Compile the code for a probe of the first-level method cache for a perform primtiive.
  The selector is assumed to be in Arg0Reg.  Defer to adjustArgumentsForPerform: to
  adjust the arguments before the jump to the method."
  | jumpSelectorMiss jumpClassMiss jumpInterpret itsAHit cacheBaseReg |
  <var: #jumpSelectorMiss type: #'AbstractInstruction *'>
  <var: #jumpClassMiss type: #'AbstractInstruction *'>
  <var: #jumpInterpret type: #'AbstractInstruction *'>
  <var: #itsAHit type: #'AbstractInstruction *'>
 
  "N.B.  Can't assume TempReg already contains the tag because a method can
  of course be invoked via the unchecked entry-point, e.g. as does perform:."
  objectRepresentation genGetInlineCacheClassTagFrom: ReceiverResultReg into: SendNumArgsReg forEntry: false.
 
  self flag: #lookupInMethodCacheSel:classTag:. "so this method shows up as a sender of lookupInMethodCacheSel:class:"
 
  cacheBaseReg := NoReg.
  (backEnd isWithinMwOffsetRange: coInterpreter methodCacheAddress) ifFalse:
  [self MoveCq: coInterpreter methodCacheAddress R: (cacheBaseReg := Extra0Reg)].
 
  "Do first of three probes.  See CoInterpreter>>lookupInMethodCacheSel:classTag:"
  jumpSelectorMiss := self compilePerformMethodCacheProbeFor: Arg0Reg withShift: 0 baseRegOrNone: cacheBaseReg.
  jumpClassMiss := self JumpNonZero: 0.
 
  "Fetch the method, and check if it is cogged."
  itsAHit := self MoveMw: (cacheBaseReg = NoReg
  ifTrue: [coInterpreter methodCacheAddress asUnsignedInteger + (MethodCacheMethod << objectMemory shiftForWord)]
  ifFalse: [MethodCacheMethod << objectMemory shiftForWord])
  r: ClassReg
  R: SendNumArgsReg.
  "If the method is not compiled fall back on the interpreter primitive."
  objectRepresentation genLoadSlot: HeaderIndex sourceReg: SendNumArgsReg destReg: ClassReg.
  jumpInterpret := objectRepresentation genJumpImmediate: ClassReg.
  "Adjust arguments and jump to the method's unchecked entry-point."
  self AddCq: cmNoCheckEntryOffset R: ClassReg.
  self adjustArgumentsForPerform: numArgs.
  self JumpR: ClassReg.
 
  "First probe missed.  Do second of three probes.  Shift hash right one and retry."
  jumpSelectorMiss jmpTarget: (jumpClassMiss jmpTarget: self Label).
  jumpSelectorMiss := self compilePerformMethodCacheProbeFor: Arg0Reg withShift: 1 baseRegOrNone: cacheBaseReg.
  self JumpZero: itsAHit.
 
  "Second probe missed.  Do last probe.  Shift hash right two and retry."
  jumpSelectorMiss jmpTarget: self Label.
  jumpSelectorMiss := self compilePerformMethodCacheProbeFor: Arg0Reg withShift: 2 baseRegOrNone: cacheBaseReg.
  self JumpZero: itsAHit.
 
  "Last probe missed.  Caller will generate the call to fall back on the interpreter primitive."
  jumpSelectorMiss jmpTarget:
  (jumpInterpret jmpTarget: self Label).
  ^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>generateTracingTrampolines (in category 'initialization') -----
  generateTracingTrampolines
  "Generate trampolines for tracing.  In the simulator we can save a lot of time
  and avoid noise instructions in the lastNInstructions log by short-cutting these
  trampolines, but we need them in the real vm."
  ceTraceLinkedSendTrampoline :=
  self genTrampolineFor: #ceTraceLinkedSend:
  called: 'ceTraceLinkedSendTrampoline'
  arg: ReceiverResultReg
  regsToSave: CallerSavedRegisterMask.
  ceTraceBlockActivationTrampoline :=
  self genTrampolineFor: #ceTraceBlockActivation
  called: 'ceTraceBlockActivationTrampoline'
+ regsToSave: CallerSavedRegisterMask.
- regsToSave: CallerSavedRegisterMask..
  ceTraceStoreTrampoline :=
  self genTrampolineFor: #ceTraceStoreOf:into:
  called: 'ceTraceStoreTrampoline'
  arg: ClassReg
  arg: ReceiverResultReg
+ regsToSave: CallerSavedRegisterMask.
- regsToSave: CallerSavedRegisterMask..
  self cCode: [] inSmalltalk:
  [ceTraceLinkedSendTrampoline := self simulatedTrampolineFor: #ceShortCutTraceLinkedSend:.
  ceTraceBlockActivationTrampoline := self simulatedTrampolineFor: #ceShortCutTraceBlockActivation:.
  ceTraceStoreTrampoline := self simulatedTrampolineFor: #ceShortCutTraceStore:]!

Item was changed:
  ----- Method: SpurMemoryManager>>accessibleObjectAfter: (in category 'object enumeration') -----
  accessibleObjectAfter: objOop
  "Answer the accessible object following the given object or
  free chunk in the heap. Return nil when heap is exhausted.
+ This is for primitiveNextObject subsequent to primitiveSomeObject.
- This is for primitiveNextObject subsequent to primtiiveSomeObject.
  It also tries to handle more general use by ordering objects as
  eden
  past
  old
  but this is tricky becaus ethe order in memory is
  past
  eden
  old"
  <inline: false>
  | objAfter |
  objAfter := objOop.
  (self oop: objAfter isLessThan: nilObj) ifTrue: "object in new space"
  [self assert: ((self isInEden: objOop) or: [self isInPastSpace: objOop]).
  (self oop: objAfter isGreaterThan: pastSpaceStart) ifTrue:
  ["Obj is in eden.  Answer next normal object in eden, if there is one."
  [objAfter := self objectAfter: objAfter limit: freeStart.
   self oop: objAfter isLessThan: freeStart] whileTrue:
  [(self isNormalObject: objAfter) ifTrue:
  [^objAfter]].
  "There wasn't a next object in eden. If past space is empty answer nilObj."
  pastSpaceStart <= scavenger pastSpace start ifTrue:
  [^nilObj].
  "If the first object in pastSpace is OK, answer it, otherwise fall through to enumerate past space."
  objAfter := self objectStartingAt: scavenger pastSpace start.
  (self isNormalObject: objAfter) ifTrue:
  [^objAfter]].
  "Either objOop was in pastSpace, or enumeration exhaused eden, so enumerate past space."
  [objAfter := self objectAfter: objAfter limit: pastSpaceStart.
   self oop: objAfter isLessThan: pastSpaceStart] whileTrue:
  [(self isNormalObject: objAfter) ifTrue:
  [^objAfter]].
  ^nilObj].
  [objAfter := self objectAfter: objAfter limit: endOfMemory.
  objAfter = endOfMemory ifTrue:
  [^nil].
  (self isNormalObject: objAfter) ifTrue:
  [^objAfter]] repeat!

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.
+
+ See http://www.mirandabanda.org/cogblog/2014/02/08/primitives-and-the-partial-read-barrier/
+ and SpurMemoryManager's class comment."
+
- the prim can be retried.  The primitive index is derived from newMethod."
  <option: #SpurObjectMemory>
  | primIndex accessorDepth found scannedStackFrame |
  self assert: self failed.
  found := scannedStackFrame := false.
  primIndex := self primitiveIndexOf: newMethod.
  self assert: (argumentCount = (self argumentCountOf: newMethod) or: [self isMetaPrimitiveIndex: primIndex]).
+ "If the primitive is one of the meta primitives PrimNumberDoPrimitive or PrimNumberDoExternalCall, then
+ metaAccessorDepth will have been set to nil at the start of the primitive, and to the accessor depth of the
+ called primitive (or external call) immediately before dispatch.  Hence if primIndex is that of a meta primitive
+ then if metaAccessorDepth is -2, the accessor depth is that of the meta primitive, and if > -2, then
+ metaAccessorDepth is the accessor depth of the primitive (or external call).  Similarly, if the primitive is
+ primitiveExternalCall then the accessor depth is that of primitiveExternalCall until primitiveFunctionPointer
+ is assigned, at which point the accessor depth is taken from the slot in newMethod's first literal."
- "If the primitive is one of the meta primitives PrimNumberDoPrimitive or
- PrimNumberDoExternalCall, then metaAccessorDepth will have been set
- to nil at the start of the primitive, and to the accessor depth of the called
- primitive (or external call) immediately before dispatch.  Hence if primIndex
- is that of a meta primiitve then if metaAccessorDepth is -2, the accessor
- depth is that of the meta primitive, and if > -2, then metaAccessorDepth is
- the accessor depth of the primitive (or external call).  SImilarly, if the
- primitive is primitiveExternalCall then the accessor depth is that of
- primitiveExternalCall until primitiveFunctionPointer is assigned, at which
- point the accessor depth is taken from the slot in newMethod's first literal."
  accessorDepth := ((self isMetaPrimitiveIndex: primIndex)
  and: [metaAccessorDepth > -2])
  ifTrue: [metaAccessorDepth]
  ifFalse:
  [(primIndex = PrimNumberExternalCall
   and: [primitiveFunctionPointer ~~ #primitiveExternalCall])
  ifTrue: [self primitiveAccessorDepthForExternalPrimitiveMethod: newMethod]
  ifFalse: [primitiveAccessorDepthTable at: primIndex]].
  self assert: (self saneFunctionPointerForFailureOfPrimIndex: primIndex).
  self assert: (accessorDepth between: -1 and: 5).
  accessorDepth >= 0 ifTrue:
+ [(self isCalloutPrimitiveIndex: primIndex) ifTrue:
+ [(objectMemory
+ followForwardedObjectFields: (self literal: 0 ofMethod: newMethod)
+ toDepth: accessorDepth) ifTrue:
+ [found := true]].
+ 0 to: argumentCount do:
- [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 "Avoid repeated primitive failures by following all state in the current stack frame."
- self
  followForwardedFrameContents: framePointer
+ stackPointer: stackPointer + (argumentCount + 1 * objectMemory wordSize)]].
- 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 added:
+ ----- Method: StackInterpreter>>isCalloutPrimitiveIndex: (in category 'primitive support') -----
+ isCalloutPrimitiveIndex: primIndex
+ "This virtual machine provides two primitives that call external code,
+ primitiveExternalCall for plugin primitives, and primitiveCalloutToFFI
+ for FFI calls."
+ <inline: true>
+ self cCode: [] inSmalltalk: [#(primitiveExternalCall primitiveCalloutToFFI)]. "For senders..."
+ ^primIndex = PrimNumberExternalCall "#primitiveExternalCall"
+ or: [primIndex = PrimNumberFFICall] "#primitiveCalloutToFFI"!

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

Item was changed:
  ----- Method: StackInterpreter>>isMetaPrimitiveIndex: (in category 'primitive support') -----
  isMetaPrimitiveIndex: primIndex
  "This virtual machine provides two primitives that executes arbitrary primitives, one
  for indexed primitivces and one for named primitives.  These meta primitives are used
  in the debugger to execute primitives while simulating execution.  Spur needs to know
  the accessor depth for a primitive so that failures due to forwarders can be fixed up
  and retried.  This method identifies such meta primitives so that metaAccessorDepth
  can be substituted when appropriate."
  <inline: true>
+ self cCode: [] inSmalltalk: [#(primitiveDoPrimitiveWithArgs primitiveDoNamedPrimitiveWithArgs)]. "For senders..."
  ^primIndex = PrimNumberDoPrimitive
   or: [primIndex = PrimNumberDoExternalCall]!

Item was changed:
  ----- Method: StackInterpreter>>isNullExternalPrimitiveCall: (in category 'compiled methods') -----
  isNullExternalPrimitiveCall: aMethodObj
+ "Answer if the method is an external primitive call (prim 117) with a null external primitive.
- "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)
  and: [(objectMemory literalCountOf: aMethodObj) > 0]) ifFalse:
  [^false].
 
  lit := self literal: 0 ofMethod: aMethodObj.
  ^(objectMemory isArray: lit)
   and: [(objectMemory numSlotsOf: lit) = 4
   and: [(objectMemory fetchPointer: 3 ofObject: lit) = ConstZero
  or: [(objectMemory fetchPointer: 3 ofObject: lit) = ConstMinusOne]]]!

Item was changed:
  ----- Method: StackInterpreter>>maybeRetryPrimitiveOnFailure (in category 'primitive support') -----
  maybeRetryPrimitiveOnFailure
  "In Spur two cases of pirmitive failure are handled specially.  A primitive may fail due to validation
  encountering a forwarder. On failure, check the accessorDepth for the primitive and if non-negative
  scan the args to the depth, following any forwarders.  Retry the primitive if any are found.  Hence
+ lazily and transparently following forwarders on primitive failue.  Additionally a prmitive might fail
- lazily and transparently following forwarders on primtiive failue.  Additionally a prmitive might fail
  due to an allocation failing.  Retry if primitives have failed with PrimErrNoMemory after running
  first the scavenger and then on a subsequent failure, the global mark-sweep collector.  Hence lazily
  and transparently GC on memory exhaustion."
  <inline: true>
  (objectMemory hasSpurMemoryManagerAPI and: [self failed]) ifTrue:
  [self retryPrimitiveOnFailure]!

Item was changed:
  ----- Method: StackInterpreter>>retryPrimitiveOnFailure (in category 'primitive support') -----
  retryPrimitiveOnFailure
  "In Spur two cases of primitive failure are handled specially.  A primitive may fail due to validation
  encountering a forwarder. On failure, check the accessorDepth for the primitive and if non-negative
  scan the args to the depth, following any forwarders.  Retry the primitive if any are found.  Hence
+ lazily and transparently following forwarders on primitive failure.  Additionally a primitive might fail
- lazily and transparently following forwarders on primtiive failure.  Additionally a prmitive might fail
  due to an allocation failing.  Retry if external primitives have failed with PrimErrNoMemory after running
  first the scavenger and then on a subsequent failure, the global mark-sweep collector.  Hence lazily
  and transparently GC on memory exhaustion."
  <option: #SpurObjectMemory>
  <inline: false>
  | gcDone followDone canRetry retry retried |
  gcDone := 0.
  followDone := canRetry := retried := false.
  [retry := false.
  primFailCode = PrimErrNoMemory
  ifTrue:
  [(gcDone := gcDone + 1) = 1 ifTrue:
  [canRetry := self isExternalPrimitiveCall: newMethod].
  canRetry ifTrue:
  [gcDone = 1 ifTrue:
  [objectMemory scavengingGC].
  gcDone = 2 ifTrue:
  [objectMemory fullGC].
  retry := gcDone <= 2]]
  ifFalse:
  [followDone ifFalse:
  [followDone := true.
  retry := self checkForAndFollowForwardedPrimitiveState]].
  retry] whileTrue:
  [self assert: primFailCode ~= 0.
  retried := true.
  self initPrimCall.
  self cCode: [] inSmalltalk:
  [self maybeMapPrimitiveFunctionPointerBackToSomethingEvaluable].
  self dispatchFunctionPointer: primitiveFunctionPointer].
  ^retried!

Item was changed:
  ----- Method: StackInterpreter>>saneFunctionPointerForFailureOfPrimIndex: (in category 'primitive support') -----
  saneFunctionPointerForFailureOfPrimIndex: primIndex
+ "This is an assert function used to ensure consistency between the primitiveFunctionPointer
+ and the primitive index when a primitive fails in Spur.  Since Spur automagically retries
+ primitives that fail and are found to have a forwarder within the primitive's accessor depth
+ we want to know that the primitiveFuncitonPointer is actually valid.  This isn't always
+ possible for the `indirect'' primitives (calling a plugin primitive, calling the ffi, using the
+ receiver:tryPrimitive:withArgs: primitive evaluator in the simulator. We do the best we can."
  | basePrimitive |
  <var: 'basePrimitive' declareC: 'void (*basePrimitive)(void)'>
  basePrimitive := self functionPointerFor: primIndex inClass: objectMemory nilObject.
  ^primitiveFunctionPointer = basePrimitive
+  or: [((self isCalloutPrimitiveIndex: primIndex) and: [self isPrimitiveFunctionPointerAnIndex not])
-  or: [(basePrimitive = #primitiveExternalCall and: [self isPrimitiveFunctionPointerAnIndex not])
   or: [(self isMetaPrimitiveIndex: primIndex) and: [metaAccessorDepth > -2]]]!

Item was changed:
  ----- Method: StackToRegisterMappingCogit>>generateTracingTrampolines (in category 'initialization') -----
  generateTracingTrampolines
  "Generate trampolines for tracing.  In the simulator we can save a lot of time
  and avoid noise instructions in the lastNInstructions log by short-cutting these
  trampolines, but we need them in the real vm."
  ceTraceLinkedSendTrampoline :=
  self genTrampolineFor: #ceTraceLinkedSend:
  called: 'ceTraceLinkedSendTrampoline'
  arg: ReceiverResultReg
+ regsToSave: CallerSavedRegisterMask.
- regsToSave: CallerSavedRegisterMask..
  ceTraceBlockActivationTrampoline :=
  self genTrampolineFor: #ceTraceBlockActivation
  called: 'ceTraceBlockActivationTrampoline'
+ regsToSave: CallerSavedRegisterMask.
- regsToSave: CallerSavedRegisterMask..
  ceTraceStoreTrampoline :=
  self genTrampolineFor: #ceTraceStoreOf:into:
  called: 'ceTraceStoreTrampoline'
  arg: TempReg
  arg: ReceiverResultReg
+ regsToSave: CallerSavedRegisterMask.
- regsToSave: CallerSavedRegisterMask..
  self cCode: [] inSmalltalk:
  [ceTraceLinkedSendTrampoline := self simulatedTrampolineFor: #ceShortCutTraceLinkedSend:.
  ceTraceBlockActivationTrampoline := self simulatedTrampolineFor: #ceShortCutTraceBlockActivation:.
  ceTraceStoreTrampoline := self simulatedTrampolineFor: #ceShortCutTraceStore:]!