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

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

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

Name: VMMaker.oscog-eem.2892
Author: eem
Time: 20 November 2020, 11:51:23.884407 am
UUID: c01b9cfa-a988-4deb-952c-2decf8ea1a0c
Ancestors: VMMaker.oscog-eem.2891

Implement a better fix for the VMMaker.oscog-eem.2824/http://forum.world.st/corruption-of-PC-in-context-objects-or-not-tt5121662.html case.  Instead of changing to the interpreter, mark the cog method containing instructionPointer and relocate instructionPointer in markActiveMethodsAndReferents/updateStackZoneReferencesToCompiledCodePreCompaction.

Rename PrimCallMayCallBack to PrimCallMayEndureCodeCompaction.

Get rid of some <doNotGenerate>'s from initialize methods.

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

Item was changed:
  ----- Method: CoInterpreter class>>initializeMiscConstants (in category 'initialization') -----
  initializeMiscConstants
 
  super initializeMiscConstants.
  COGVM := true.
 
  MinBackwardJumpCountForCompile := 40.
 
  MaxNumArgs := 15.
  PrimCallNeedsNewMethod := 1.
  PrimCallNeedsPrimitiveFunction := 2.
+ PrimCallMayEndureCodeCompaction := 4.
- PrimCallMayCallBack := 4.
  PrimCallOnSmalltalkStack := 8.
  PrimCallCollectsProfileSamples := 16.
  "CheckAllocationFillerAfterPrimCall := 32. this has never been successfully used in all the years we've had it; nuking it"
  PrimCallDoNotJIT := 64.
 
  PrimTraceLogSize := 256. "Room for 256 selectors.  Must be 256 because we use a byte to hold the index"
  TraceBufferSize := 256 * 3. "Room for 256 events"
  TraceContextSwitch := self objectMemoryClass basicNew integerObjectOf: 1.
  TraceBlockActivation := self objectMemoryClass basicNew integerObjectOf: 2.
  TraceBlockCreation := self objectMemoryClass basicNew integerObjectOf: 3.
  TraceIncrementalGC := self objectMemoryClass basicNew integerObjectOf: 4.
  TraceFullGC := self objectMemoryClass basicNew integerObjectOf: 5.
  TraceCodeCompaction := self objectMemoryClass basicNew integerObjectOf: 6.
  TraceOwnVM := self objectMemoryClass basicNew integerObjectOf: 7.
  TraceDisownVM := self objectMemoryClass basicNew integerObjectOf: 8.
  TraceThreadSwitch := self objectMemoryClass basicNew integerObjectOf: 9.
  TracePreemptDisowningThread := self objectMemoryClass basicNew integerObjectOf: 10.
  TraceVMCallback := self objectMemoryClass basicNew integerObjectOf: 11.
  TraceVMCallbackReturn := self objectMemoryClass basicNew integerObjectOf: 12.
  TraceStackOverflow := self objectMemoryClass basicNew integerObjectOf: 13.
  TracePrimitiveFailure := self objectMemoryClass basicNew integerObjectOf: 14.
  TracePrimitiveRetry := self objectMemoryClass basicNew integerObjectOf: 15.
 
  TraceIsFromMachineCode := 1.
  TraceIsFromInterpreter := 2.
  CSCallbackEnter := 3.
  CSCallbackLeave := 4.
  CSEnterCriticalSection := 5.
  CSExitCriticalSection := 6.
  CSResume := 7.
  CSSignal := 8.
  CSSuspend := 9.
  CSWait := 10.
  CSYield := 11.
  CSCheckEvents := 12.
  CSThreadSchedulingLoop := 13.
  CSOwnVM := 14.
  CSThreadBind := 15.
  CSSwitchIfNeccessary := 16.
 
  TraceSources := CArrayAccessor on: #('?' 'm' 'i' 'callbackEnter' 'callbackLeave' 'enterCritical' 'exitCritical' 'resume' 'signal'  'suspend' 'wait' 'yield' 'eventcheck' 'threadsched' 'ownVM' 'bindToThread' 'switchIfNecessary').
 
  "this is simulation only"
  RumpCStackSize := 4096!

Item was added:
+ ----- Method: CoInterpreter>>isCodeCompactingPrimitiveIndex: (in category 'primitive support') -----
+ isCodeCompactingPrimitiveIndex: primIndex
+ "If instVarAt:, slotAt: or shallowCopy operate on a Context then they compute a
+ bytecode pc and hence may provoke a code compaction. Hence primtiive invocation
+ from these primitives must use a static return address (cePrimReturnEnterCogCode:)."
+ <inline: true>
+ self cCode: [] inSmalltalk: [#primitiveClone. #primitiveInstVarAt. #primitiveSlotAt]. "For senders..."
+ ^primIndex = PrimNumberInstVarAt
+ or: [primIndex = PrimNumberShallowCopy
+ or: [primIndex = PrimNumberSlotAt]]!

Item was changed:
  ----- Method: CoInterpreter>>markActiveMethodsAndReferents (in category 'cog jit support') -----
  markActiveMethodsAndReferents
  <api>
+ "If instructionPointer is referring to machine code, as it will be if a primitive is in progress
+ (see isCodeCompactingPrimitiveIndex:) it may refer to a method, and if so that method
+ must be retained."
+ instructionPointer ~= 0 ifTrue:
+ [(cogit cogMethodContaining: instructionPointer) ifNotNil:
+ [:primCogMethod|
+ cogit markMethodAndReferents: primCogMethod]].
+
- | thePage |
- <var: #thePage type: #'StackPage *'>
  0 to: numStackPages - 1 do:
+ [:i| | thePage |
- [:i|
  thePage := stackPages stackPageAt: i.
  (stackPages isFree: thePage) ifFalse:
  [self markCogMethodsAndReferentsOnPage: thePage]]!

Item was changed:
  ----- Method: CoInterpreter>>markCogMethodsAndReferentsOnPage: (in category 'frame access') -----
  markCogMethodsAndReferentsOnPage: thePage
  <var: #thePage type: #'StackPage *'>
  | theFP callerFP |
- <var: #theFP type: #'char *'>
- <var: #callerFP type: #'char *'>
  <inline: false>
  self assert: (stackPages isFree: thePage) not.
  self assert: (self ifCurrentStackPageHasValidHeadPointers: thePage).
  theFP := thePage headFP.
- "Skip the instruction pointer on top of stack of inactive pages."
  [(self isMachineCodeFrame: theFP) ifTrue:
  [cogit markMethodAndReferents: (self mframeCogMethod: theFP)].
  (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
  [theFP := callerFP]!

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) "For callbacks"
+ or: [self isCodeCompactingPrimitiveIndex: primIndex]) ifTrue: "For code reclamations"
+ [baseFlags := baseFlags bitOr: PrimCallMayEndureCodeCompaction].
- (self isCalloutPrimitiveIndex: primIndex) 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 isCalloutPrimitiveIndex: primIndex) ifTrue: "For callbacks"
+ [baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod + PrimCallNeedsPrimitiveFunction + PrimCallMayEndureCodeCompaction].
- [baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod + PrimCallNeedsPrimitiveFunction + PrimCallMayCallBack].
  (self isCodeCompactingPrimitiveIndex: primIndex) ifTrue:
+ [baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod + PrimCallMayEndureCodeCompaction].
- [baseFlags := baseFlags bitOr: PrimCallNeedsNewMethod].
 
  ^baseFlags!

Item was changed:
  ----- Method: CoInterpreter>>updateStackZoneReferencesToCompiledCodePreCompaction (in category 'code compaction') -----
  updateStackZoneReferencesToCompiledCodePreCompaction
  <api>
+ "Go through all frames in the stack zone and mark their methods
+ so that compaction does not free any methods that are in use."
+ <var: 'primCogMethod' type: #'CogMethod *'>
+
+ "If instructionPointer is referring to machine code, as it will be if a primitive is in progress
+ (see isCodeCompactingPrimitiveIndex:) it must be updated if it is referring to a moved
+ method."
+ instructionPointer ~= 0 ifTrue:
+ [(cogit cogMethodContaining: instructionPointer) ifNotNil:
+ [:primCogMethod|
+ instructionPointer := instructionPointer + primCogMethod objectHeader]].
+
- <var: #thePage type: #'StackPage *'>
- <var: #theFP type: #'char *'>
- <var: #callerFP type: #'char *'>
- <var: #theIPPtr type: #'char *'>
- <var: #theIP type: #usqInt>
- <var: #theMethod type: #'CogMethod *'>
  0 to: numStackPages - 1 do:
+ [:i| | thePage |
- [:i| | thePage theFP callerFP theIPPtr theIP theMethodField theFlags theMethod |
  thePage := stackPages stackPageAt: i.
  (stackPages isFree: thePage) ifFalse:
+ [self updateStackZoneReferencesToCompiledCodePreCompactionOnPage: thePage]]!
- [theIPPtr := thePage headSP.
- theFP := thePage  headFP.
- [(self isMachineCodeFrame: theFP) ifTrue:
- [theMethodField := self frameMethodField: theFP.
- theFlags := theMethodField bitAnd: MFMethodFlagsMask.
- theMethod := self cCoerceSimple: theMethodField - theFlags to: #'CogMethod *'.
- theMethod cmType = CMBlock ifTrue:
- [theMethod := (self cCoerceSimple: theMethodField - theFlags to: #'CogBlockMethod *') cmHomeMethod].
- theIP := (stackPages longAt: theIPPtr) asUnsignedInteger.
- (theIP ~= cogit ceCannotResumePC
-  and: [self asserta: (theIP >= theMethod asUnsignedInteger
-   and: [theIP < (theMethod asUnsignedInteger + theMethod blockSize)])]) ifTrue:
- [stackPages
- longAt: theIPPtr
- put: theIP + theMethod objectHeader].
- stackPages
- longAt: theFP + FoxMethod
- put: theMethodField + theMethod objectHeader].
- (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
- [theIPPtr := theFP + FoxCallerSavedIP.
- theFP := callerFP]]]!

Item was added:
+ ----- Method: CoInterpreter>>updateStackZoneReferencesToCompiledCodePreCompactionOnPage: (in category 'frame access') -----
+ updateStackZoneReferencesToCompiledCodePreCompactionOnPage: thePage
+ <var: #thePage type: #'StackPage *'>
+ <inline: true>
+ | theFP callerFP theIPPtr theIP theMethodField theFlags theMethod |
+ theIPPtr := thePage headSP.
+ theFP := thePage  headFP.
+ [(self isMachineCodeFrame: theFP) ifTrue:
+ [theMethodField := self frameMethodField: theFP.
+ theFlags := theMethodField bitAnd: MFMethodFlagsMask.
+ theMethod := self cCoerceSimple: theMethodField - theFlags to: #'CogMethod *'.
+ theMethod cmType = CMBlock ifTrue:
+ [theMethod := (self cCoerceSimple: theMethodField - theFlags to: #'CogBlockMethod *') cmHomeMethod].
+ theIP := (stackPages longAt: theIPPtr) asUnsignedInteger.
+ (theIP ~= cogit ceCannotResumePC
+  and: [self asserta: (theIP >= theMethod asUnsignedInteger
+   and: [theIP < (theMethod asUnsignedInteger + theMethod blockSize)])]) ifTrue:
+ [stackPages
+ longAt: theIPPtr
+ put: theIP + theMethod objectHeader].
+ stackPages
+ longAt: theFP + FoxMethod
+ put: theMethodField + theMethod objectHeader].
+ (callerFP := self frameCallerFP: theFP) ~= 0] whileTrue:
+ [theIPPtr := theFP + FoxCallerSavedIP.
+ theFP := callerFP]!

Item was removed:
- ----- Method: CoInterpreterPrimitives>>cloneContext: (in category 'primitive support') -----
- cloneContext: aContext
- "Copy a Context.  There are complications here.
- Fields of married contexts must be mapped to image-level values.
- In mapping a machine code pc, a code compaction may occur.
- In this case return through machine code is impossible without
- updating a C call stack return address, since the machine code
- method that invoked this primitive could have moved.  So if this
- happens, map to an interpreter frame and return to the interpreter."
- | cloned couldBeCogMethod |
- self assert: ((objectMemory isCompiledMethod: newMethod)
- and: [(self primitiveIndexOf: newMethod) > 0]).
-
- couldBeCogMethod := objectMemory rawHeaderOf: newMethod.
- cloned := super cloneContext: aContext.
-
- "If the header has changed in any way then it is most likely that machine code
- has been moved or reclaimed for this method and so normal return is impossible."
- couldBeCogMethod ~= (objectMemory rawHeaderOf: newMethod) ifTrue:
- [self convertToInterpreterFrame: 0.
- self push: cloned.
- cogit ceInvokeInterpret
- "NOTREACHED"].
-
- ^cloned!

Item was removed:
- ----- Method: CoInterpreterPrimitives>>primitiveInstVarAt (in category 'object access primitives') -----
- primitiveInstVarAt
- "Override to deal with potential code compaction on accessing context pcs"
- | index rcvr hdr fmt totalLength fixedFields value |
- self assert: ((objectMemory isCompiledMethod: newMethod)
- and: [(self primitiveIndexOf: newMethod) > 0]).
-
- index := self stackTop.
- rcvr := self stackValue: 1.
- ((objectMemory isNonIntegerObject: index)
- or: [argumentCount > 1 "e.g. object:instVarAt:"
- and: [objectMemory isOopForwarded: rcvr]]) ifTrue:
- [^self primitiveFailFor: PrimErrBadArgument].
- (objectMemory isImmediate: rcvr) ifTrue: [^self primitiveFailFor: PrimErrInappropriate].
- index := objectMemory integerValueOf: index.
- hdr := objectMemory baseHeader: rcvr.
- fmt := objectMemory formatOfHeader: hdr.
- totalLength := objectMemory lengthOf: rcvr baseHeader: hdr format: fmt.
- fixedFields := objectMemory fixedFieldsOf: rcvr format: fmt length: totalLength.
- (index >= 1 and: [index <= fixedFields]) ifFalse:
- [^self primitiveFailFor: PrimErrBadIndex].
- (fmt = objectMemory indexablePointersFormat
- and: [objectMemory isContextHeader: hdr])
- ifTrue:
- [| couldBeCogMethod |
- self externalWriteBackHeadFramePointers.
- "Note newMethod's header to check for potential code compaction
-  in mapping the context's pc from machine code to bytecode."
- index = InstructionPointerIndex ifTrue:
- [couldBeCogMethod := objectMemory rawHeaderOf: newMethod].
- value := self externalInstVar: index - 1 ofContext: rcvr.
- "If the header has changed in any way then it is most likely that machine code
- has been moved or reclaimed for this method and so normal return is impossible."
- (index = InstructionPointerIndex
-  and: [couldBeCogMethod ~= (objectMemory rawHeaderOf: newMethod)]) ifTrue:
- [self pop: argumentCount + 1.
- self convertToInterpreterFrame: 0.
- self push: value.
- cogit ceInvokeInterpret
- "NOTREACHED"]]
- ifFalse: [value := self subscript: rcvr with: index format: fmt].
- self pop: argumentCount + 1 thenPush: value!

Item was removed:
- ----- Method: CoInterpreterPrimitives>>primitiveSlotAt (in category 'object access primitives') -----
- primitiveSlotAt
- "Answer a slot in an object.  This numbers all slots from 1, ignoring the distinction between
- named and indexed inst vars.  In objects with both named and indexed inst vars, the named
- inst vars precede the indexed ones.  In non-object indexed objects (objects that contain
- bits, not object references) this primitive answers the raw integral value at each slot.
- e.g. for Strings it answers the character code, not the Character object at each slot."
-
- "Override to deal with potential code compaction on accessing context pcs"
- | index rcvr fmt numSlots |
- self assert: ((objectMemory isCompiledMethod: newMethod)
- and: [(self primitiveIndexOf: newMethod) > 0]).
-
- index := self stackTop.
- rcvr := self stackValue: 1.
- (objectMemory isIntegerObject: index) ifFalse:
- [^self primitiveFailFor: PrimErrBadArgument].
- (objectMemory isImmediate: rcvr) ifTrue:
- [^self primitiveFailFor: PrimErrBadReceiver].
- fmt := objectMemory formatOf: rcvr.
- index := (objectMemory integerValueOf: index) - 1.
-
- fmt <= objectMemory lastPointerFormat ifTrue:
- [numSlots := objectMemory numSlotsOf: rcvr.
- (self asUnsigned: index) < numSlots ifTrue:
- [| value numLiveSlots |
- (objectMemory isContextNonImm: rcvr)
- ifTrue:
- [self externalWriteBackHeadFramePointers.
- numLiveSlots := (self stackPointerForMaybeMarriedContext: rcvr) + CtxtTempFrameStart.
- (self asUnsigned: index) < numLiveSlots
- ifTrue:
- [| couldBeCogMethod |
- "Note newMethod's header to check for potential code compaction
-  in mapping the context's pc from machine code to bytecode."
- index = InstructionPointerIndex ifTrue:
- [couldBeCogMethod := objectMemory rawHeaderOf: newMethod].
- value := self externalInstVar: index ofContext: rcvr.
- "If the header has changed in any way then it is most likely that machine code
- has been moved or reclaimed for this method and so normal return is impossible."
- (index = InstructionPointerIndex
-  and: [couldBeCogMethod ~= (objectMemory rawHeaderOf: newMethod)]) ifTrue:
- [self pop: argumentCount + 1.
- self convertToInterpreterFrame: 0.
- self push: value.
- cogit ceInvokeInterpret
- "NOTREACHED"]]
- ifFalse: [value := objectMemory nilObject]]
- ifFalse:
- [value := objectMemory fetchPointer: index ofObject: rcvr].
- self pop: argumentCount + 1 thenPush: value.
- ^0].
- ^self primitiveFailFor: PrimErrBadIndex].
-
- fmt >= objectMemory firstByteFormat ifTrue:
- [fmt >= objectMemory firstCompiledMethodFormat ifTrue:
- [^self primitiveFailFor: PrimErrUnsupported].
- numSlots := objectMemory numBytesOfBytes: rcvr.
- (self asUnsigned: index) < numSlots ifTrue:
- [self pop: argumentCount + 1 thenPushInteger: (objectMemory fetchByte: index ofObject: rcvr).
- ^0].
- ^self primitiveFailFor: PrimErrBadIndex].
-
- (objectMemory hasSpurMemoryManagerAPI
- and: [fmt >= objectMemory firstShortFormat]) ifTrue:
- [numSlots := objectMemory num16BitUnitsOf: rcvr.
- (self asUnsigned: index) < numSlots ifTrue:
- [self pop: argumentCount + 1 thenPushInteger: (objectMemory fetchUnsignedShort16: index ofObject: rcvr).
- ^0].
- ^self primitiveFailFor: PrimErrBadIndex].
-
- fmt = objectMemory sixtyFourBitIndexableFormat ifTrue:
- [numSlots := objectMemory num64BitUnitsOf: rcvr.
- (self asUnsigned: index) < numSlots ifTrue:
- [self pop: argumentCount + 1
- thenPush: (self positive64BitIntegerFor: (objectMemory fetchLong64: index ofObject: rcvr)).
- ^0].
- ^self primitiveFailFor: PrimErrBadIndex].
-
- fmt >= objectMemory firstLongFormat ifTrue:
- [numSlots := objectMemory num32BitUnitsOf: rcvr.
- (self asUnsigned: index) < numSlots ifTrue:
- [self pop: argumentCount + 1
- thenPush: (self positive32BitIntegerFor: (objectMemory fetchLong32: index ofObject: rcvr)).
- ^0].
- ^self primitiveFailFor: PrimErrBadIndex].
-
- ^self primitiveFailFor: PrimErrBadReceiver!

Item was removed:
- ----- Method: CogARMCompiler>>initialize (in category 'generate machine code') -----
- initialize
- "This method intializes the Smalltalk instance.  The C instance is merely a struct and doesn't need initialization."
- <doNotGenerate>
- operands := CArrayAccessor on: (Array new: NumOperands).
- machineCode := CArrayAccessor on: (WordArray new: self machineCodeWords)!

Item was changed:
  ----- Method: CogAbstractInstruction>>initialize (in category 'initialization') -----
  initialize
  "This method intializes the Smalltalk instance.  The C instance is merely a struct and doesn't need initialization."
- <doNotGenerate>
  operands := CArrayAccessor on: (Array new: NumOperands).
+ machineCode := CArrayAccessor on: (self codeGranularity = 4
+ ifTrue: [WordArray new: self machineCodeWords]
+ ifFalse: [ByteArray new: self machineCodeBytes])!
- machineCode := CArrayAccessor on: (ByteArray new: self machineCodeBytes)!

Item was removed:
- ----- Method: CogMIPSELCompiler>>initialize (in category 'generate machine code') -----
- initialize
- "This method intializes the Smalltalk instance.  The C instance is merely a struct and doesn't need initialization."
- <doNotGenerate>
- operands := CArrayAccessor on: (Array new: NumOperands).
- machineCode := CArrayAccessor on: (Array new: self machineCodeWords)!

Item was changed:
  SharedPool subclass: #CogMethodConstants
  instanceVariableNames: ''
+ classVariableNames: 'CMBlock CMClosedPIC CMFree CMMaxUsageCount CMMethod CMOpenPIC CompletePrimitive EncounteredUnknownBytecode InsufficientCodeSpace MaxLiteralCountForCompile MaxMethodSize MaxNegativeErrorCode MaxNumArgs MaxStackCheckOffset MethodTooBig NotFullyInitialized PrimCallCollectsProfileSamples PrimCallDoNotJIT PrimCallMayEndureCodeCompaction PrimCallNeedsNewMethod PrimCallNeedsPrimitiveFunction PrimCallOnSmalltalkStack ShouldNotJIT UnfailingPrimitive UnimplementedPrimitive YoungSelectorInPIC'
- classVariableNames: 'CMBlock CMClosedPIC CMFree CMMaxUsageCount CMMethod CMOpenPIC CompletePrimitive EncounteredUnknownBytecode InsufficientCodeSpace MaxLiteralCountForCompile MaxMethodSize MaxNegativeErrorCode MaxNumArgs MaxStackCheckOffset MethodTooBig NotFullyInitialized PrimCallCollectsProfileSamples PrimCallDoNotJIT PrimCallMayCallBack PrimCallNeedsNewMethod PrimCallNeedsPrimitiveFunction PrimCallOnSmalltalkStack ShouldNotJIT UnfailingPrimitive UnimplementedPrimitive YoungSelectorInPIC'
  poolDictionaries: ''
  category: 'VMMaker-JIT'!

Item was added:
+ ----- Method: CogMethodZone>>cogMethodContaining: (in category 'jit - api') -----
+ cogMethodContaining: mcpc
+ "Answer the method containing mcpc for the purposes of code zone compaction,
+ where mcpc is actually the value of instructionPointer at the time of a compaction."
+ <var: 'mcpc' type: #usqInt>
+ <api>
+ | cogMethod prevMethod |
+ mcpc > limitAddress ifTrue:
+ [^nil].
+ mcpc < baseAddress ifTrue:
+ [cogit assertMcpcIsPrimReturn: mcpc.
+ ^nil].
+ self assert: mcpc < self limitZony.
+ cogMethod := coInterpreter cCoerceSimple: baseAddress to: #'CogMethod *'.
+ [cogMethod < mcpc] whileTrue:
+ [prevMethod := cogMethod.
+ cogMethod := self methodAfter: cogMethod].
+
+ "Since mcpc is actually instructionPointer we expect that it is either at the stack check
+ (normal code zone reclamation invoked through checkForEventsMayContextSwitch:)
+ or is in a primitive, immediately following the call of the C primitive routine."
+ self assert: (prevMethod notNil
+ and: [mcpc = prevMethod asUnsignedInteger + prevMethod stackCheckOffset
+ or: [(coInterpreter
+ primitiveIndexOfMethod: prevMethod methodObject
+ header: prevMethod methodHeader) > 0
+ and: [cogit backEnd isCallPrecedingReturnPC: mcpc]]]).
+ ^prevMethod!

Item was added:
+ ----- Method: Cogit>>assertMcpcIsPrimReturn: (in category 'debugging') -----
+ assertMcpcIsPrimReturn: mcpc
+ <inline: #always>
+ ^self assert: (mcpc = cePrimReturnEnterCogCode
+ or: [mcpc = cePrimReturnEnterCogCodeProfiling])!

Item was added:
+ ----- Method: Cogit>>cogMethodContaining: (in category 'jit - api') -----
+ cogMethodContaining: mcpc
+ <doNotGenerate>
+ ^methodZone cogMethodContaining: mcpc!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>compileInterpreterPrimitive:flags: (in category 'primitive generators') -----
  compileInterpreterPrimitive: primitiveRoutine flags: flags
  "Compile a call to an interpreter primitive.  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."
  <var: #primitiveRoutine declareC: 'void (*primitiveRoutine)(void)'>
  | jmp jmpSamplePrim continuePostSamplePrim jmpSampleNonPrim continuePostSampleNonPrim |
  <var: #jmp type: #'AbstractInstruction *'>
  <var: #jmpSamplePrim type: #'AbstractInstruction *'>
  <var: #jmpSampleNonPrim type: #'AbstractInstruction *'>
  <var: #continuePostSamplePrim type: #'AbstractInstruction *'>
  <var: #continuePostSampleNonPrim type: #'AbstractInstruction *'>
 
  "Save processor fp, sp and return pc in the interpreter's frame stack and instruction pointers"
  self genExternalizePointersForPrimitiveCall.
  "Switch to the C stack."
  self genLoadCStackPointersForPrimCall.
 
  (flags anyMask: PrimCallCollectsProfileSamples) ifTrue:
  ["Test nextProfileTick for being non-zero and call checkProfileTick if so"
  objectMemory wordSize = 4
  ifTrue:
  [self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  self MoveAw: coInterpreter nextProfileTickAddress + objectMemory wordSize R: ClassReg.
  self OrR: TempReg R: ClassReg]
  ifFalse:
  [self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  self CmpCq: 0 R: TempReg].
  "If set, jump to record sample call."
  jmpSampleNonPrim := self JumpNonZero: 0.
  continuePostSampleNonPrim := self Label].
 
  "Old full prim trace is in VMMaker-eem.550 and prior"
  self recordPrimTrace ifTrue:
  [self genFastPrimTraceUsing: ClassReg and: SendNumArgsReg].
 
  "Clear the primFailCode and set argumentCount"
  self MoveCq: 0 R: TempReg.
  self MoveR: TempReg Aw: coInterpreter primFailCodeAddress.
  methodOrBlockNumArgs ~= 0 ifTrue:
  [self MoveCq: methodOrBlockNumArgs R: TempReg].
  self MoveR: TempReg Aw: coInterpreter argumentCountAddress.
 
  "If required, set primitiveFunctionPointer and newMethod"
  (flags anyMask: PrimCallNeedsPrimitiveFunction) ifTrue:
  [self MoveCw: primitiveRoutine asInteger R: TempReg.
  primSetFunctionLabel :=
  self MoveR: TempReg Aw: coInterpreter primitiveFunctionPointerAddress].
+ (flags anyMask: PrimCallNeedsNewMethod+PrimCallMayEndureCodeCompaction) ifTrue:
- (flags anyMask: PrimCallNeedsNewMethod+PrimCallMayCallBack) ifTrue:
  ["The ceActivateFailingPrimitiveMethod: machinery can't handle framelessness."
+ (flags anyMask: PrimCallMayEndureCodeCompaction) ifTrue:
- (flags anyMask: PrimCallMayCallBack) ifTrue:
  [needsFrame := true].
  methodLabel addDependent:
  (self annotateAbsolutePCRef:
  (self MoveCw: methodLabel asInteger R: ClassReg)).
  self MoveMw: (self offset: CogMethod of: #methodObject) r: ClassReg R: TempReg.
  self MoveR: TempReg Aw: coInterpreter newMethodAddress].
 
  "Invoke the primitive"
  self PrefetchAw: coInterpreter primFailCodeAddress.
+ (flags anyMask: PrimCallMayEndureCodeCompaction)
- (flags anyMask: PrimCallMayCallBack)
  ifTrue: "Sideways call the C primitive routine so that we return through cePrimReturnEnterCogCode."
  ["On Spur ceActivateFailingPrimitiveMethod: would like to retry if forwarders
   are found. So insist on PrimCallNeedsPrimitiveFunction being set too."
  self assert: (flags anyMask: PrimCallNeedsPrimitiveFunction).
  backEnd
  genMarshallNArgs: 0 arg: nil arg: nil arg: nil arg: nil;
  genSubstituteReturnAddress:
  ((flags anyMask: PrimCallCollectsProfileSamples)
  ifTrue: [cePrimReturnEnterCogCodeProfiling]
  ifFalse: [cePrimReturnEnterCogCode]).
  primInvokeInstruction := self JumpFullRT: primitiveRoutine asInteger.
  jmp := jmpSamplePrim := continuePostSamplePrim := nil]
  ifFalse:
  ["Call the C primitive routine."
  backEnd genMarshallNArgs: 0 arg: 0 arg: 0 arg: 0 arg: 0.
  primInvokeInstruction := self CallFullRT: primitiveRoutine asInteger.
  backEnd genRemoveNArgsFromStack: 0.
  (flags anyMask: PrimCallCollectsProfileSamples) ifTrue:
  [self assert: (flags anyMask: PrimCallNeedsNewMethod).
  "Test nextProfileTick for being non-zero and call checkProfileTick if so"
  objectMemory wordSize = 4
  ifTrue:
  [self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  self MoveAw: coInterpreter nextProfileTickAddress + objectMemory wordSize R: ClassReg.
  self OrR: TempReg R: ClassReg]
  ifFalse:
  [self MoveAw: coInterpreter nextProfileTickAddress R: TempReg.
  self CmpCq: 0 R: TempReg].
  "If set, jump to record sample call."
  jmpSamplePrim := self JumpNonZero: 0.
  continuePostSamplePrim := self Label].
  objectRepresentation maybeCompileRetryOnPrimitiveFail: primitiveIndex.
  "Switch back to the Smalltalk stack.  Stack better be in either of these two states:
  success: stackPointer -> result (was receiver)
  arg1
  ...
  argN
  return pc
  failure: receiver
  arg1
  ...
  stackPointer -> argN
  return pc
  In either case we can push the instructionPointer or load it into the LinkRegister to reestablish the return pc"
  self MoveAw: coInterpreter instructionPointerAddress
  R: (backEnd hasLinkRegister ifTrue: [LinkReg] ifFalse: [ClassReg]).
  backEnd genLoadStackPointers.
  "Test primitive failure"
  self MoveAw: coInterpreter primFailCodeAddress R: TempReg.
  backEnd hasLinkRegister ifFalse: [self PushR: ClassReg]. "Restore return pc on CISCs"
  self flag: 'ask concrete code gen if move sets condition codes?'.
  self CmpCq: 0 R: TempReg.
  jmp := self JumpNonZero: 0.
  "Fetch result from stack"
  self MoveMw: (backEnd hasLinkRegister ifTrue: [0] ifFalse: [objectMemory wordSize])
  r: SPReg
  R: ReceiverResultReg.
  self RetN: objectMemory wordSize]. "return to caller, popping receiver"
 
  (flags anyMask: PrimCallCollectsProfileSamples) ifTrue:
  ["The sample is collected by cePrimReturnEnterCogCode for external calls"
  jmpSamplePrim ifNotNil:
  ["Call ceCheckProfileTick: to record sample and then continue."
  jmpSamplePrim jmpTarget: self Label.
  self assert: (flags anyMask: PrimCallNeedsNewMethod).
  self CallFullRT: (self cCode: [#ceCheckProfileTick asUnsignedIntegerPtr]
    inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick]).
  "reenter the post-primitive call flow"
  self Jump: continuePostSamplePrim].
  "Null newMethod and call ceCheckProfileTick: to record sample and then continue.
  ceCheckProfileTick will map null/0 to coInterpreter nilObject"
  jmpSampleNonPrim jmpTarget: self Label.
  self MoveCq: 0 R: TempReg.
  self MoveR: TempReg Aw: coInterpreter newMethodAddress.
  self CallFullRT: (self cCode: [#ceCheckProfileTick asUnsignedIntegerPtr]
    inSmalltalk: [self simulatedTrampolineFor: #ceCheckProfileTick]).
  "reenter the post-primitive call flow"
  self Jump: continuePostSampleNonPrim].
 
  jmp ifNotNil:
  ["Jump to restore of receiver reg and proceed to frame build for failure."
  jmp jmpTarget: self Label.
  "Restore receiver reg from stack.  If on RISCs ret pc is in LinkReg, if on CISCs ret pc is on stack."
  self MoveMw: objectMemory wordSize * (methodOrBlockNumArgs + (backEnd hasLinkRegister ifTrue: [0] ifFalse: [1]))
  r: SPReg
  R: ReceiverResultReg].
  ^0!

Item was changed:
  ----- Method: SimpleStackBasedCogit>>rewritePrimInvocationIn:to: (in category 'external primitive support') -----
  rewritePrimInvocationIn: cogMethod to: primFunctionPointer
  <api>
  <var: #cogMethod type: #'CogMethod *'>
  <var: #primFunctionPointer declareC: #'void (*primFunctionPointer)(void)'>
  | primIndex flags address extent |
  self cCode: [] inSmalltalk:
  [primFunctionPointer isInteger ifFalse:
  [^self rewritePrimInvocationIn: cogMethod to: (self simulatedTrampolineFor: primFunctionPointer)]].
  self assert: cogMethod cmType = CMMethod.
  primIndex := coInterpreter
  primitiveIndexOfMethod: cogMethod methodObject
  header: cogMethod methodHeader.
  flags := coInterpreter primitivePropertyFlags: primIndex.
  (flags anyMask: PrimCallNeedsPrimitiveFunction) ifTrue:
  [backEnd
  storeLiteral: primFunctionPointer asUnsignedInteger
  beforeFollowingAddress: cogMethod asUnsignedInteger
  + (externalSetPrimOffsets at: cogMethod cmNumArgs)].
  "See compileInterpreterPrimitive:"
+ (flags anyMask: PrimCallMayEndureCodeCompaction)
- (flags anyMask: PrimCallMayCallBack)
  ifTrue:
  [address := cogMethod asUnsignedInteger
  + (externalPrimJumpOffsets at: cogMethod cmNumArgs).
  extent := backEnd
  rewriteJumpFullAt: address
  target: primFunctionPointer asUnsignedInteger]
  ifFalse:
  [address := cogMethod asUnsignedInteger
  + (externalPrimCallOffsets at: cogMethod cmNumArgs).
  extent := backEnd
  rewriteCallFullAt: address
  target: primFunctionPointer asUnsignedInteger].
  extent > 0 ifTrue:
  [backEnd
  flushICacheFrom: cogMethod asUnsignedInteger + cmNoCheckEntryOffset
  to: address asUnsignedInteger + extent]!

Item was removed:
- ----- Method: StackInterpreter>>isCodeCompactingPrimitiveIndex: (in category 'primitive support') -----
- isCodeCompactingPrimitiveIndex: primIndex
- "If instVarAt:, slotAt: or shallowCopy operate on a Context then they compute a
- bytecode pc and hence may provoke a code compaction.  If so, they *cannot*
- return through the potentially moved method and so continue in the interpreter."
- <inline: true>
- self cCode: [] inSmalltalk: [#primitiveClone primitiveInstVarAt primitiveSlotAt]. "For senders..."
- ^primIndex = PrimNumberInstVarAt
- or: [primIndex = PrimNumberShallowCopy
- or: [primIndex = PrimNumberSlotAt]]!