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

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

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

Name: VMMaker.oscog-eem.2874
Author: eem
Time: 9 November 2020, 8:03:01.884433 pm
UUID: 0bad3d2d-1051-4c4f-a77e-c9525ed39079
Ancestors: VMMaker.oscog-eem.2873

COGMTVM:
Nuke the old V3 GC lock hack.
Restore disownCount cuz aio.c uses it (to reduce noise when using the repl image).
Use DisownVMForThreading as the disown flag in primitiveFileReadPinningAndDisowning rather than DisownVMForFFICall because this flag is used for the fail-on-ffi-exceptin machinery.
Get the Vm to compile, making sure funcitons used in asserts are not always inlined (& hence inlined away).

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

Item was changed:
  CoInterpreterPrimitives subclass: #CoInterpreterMT
+ instanceVariableNames: 'cogThreadManager checkThreadActivation maxWaitingPriority foreignCallbackPriority deferThreadSwitch disowningVMThread disownCount foreignCallbackProcessSlot willNotThreadWarnCount activeProcessAffined relinquishing processHasThreadId noThreadingOfGUIThread reenterThreadSchedulingLoop'
- instanceVariableNames: 'cogThreadManager checkThreadActivation maxWaitingPriority foreignCallbackPriority deferThreadSwitch disowningVMThread foreignCallbackProcessSlot willNotThreadWarnCount activeProcessAffined relinquishing processHasThreadId noThreadingOfGUIThread reenterThreadSchedulingLoop'
  classVariableNames: 'DisownFlagsShift DisownVMForProcessorRelinquish LockGUIThreadFlag LockGUIThreadShift OwnVMForeignThreadFlag ProcessUnaffinedOnDisown ReturnToThreadSchedulingLoop VMAlreadyOwnedHenceDoNotDisown'
  poolDictionaries: 'VMThreadingConstants'
  category: 'VMMaker-Multithreading'!

Item was changed:
  ----- Method: CoInterpreterMT class>>declareCVarsIn: (in category 'translation') -----
  declareCVarsIn: aCCodeGenerator
  aCCodeGenerator
  addHeaderFile:'"sqAtomicOps.h"'. "For THRLOG"
  aCCodeGenerator vmClass
  declareInterpreterVersionIn: aCCodeGenerator
  defaultName: 'Cog MT'.
  aCCodeGenerator
+ var: #disowningVMThread type: #'CogVMThread *'.
+ aCCodeGenerator var: #reenterThreadSchedulingLoop type: 'jmp_buf'.!
- var: #disowningVMThread type: #'CogVMThread *'!

Item was changed:
  ----- Method: CoInterpreterMT>>assertCStackPointersBelongToCurrentThread (in category 'simulation') -----
  assertCStackPointersBelongToCurrentThread
+ <cmacro: '() 0'> "simulation only"
+ | ownerIndex range |
+ self assert: (ownerIndex := cogThreadManager getVMOwner) > 0.
+ self assert: ((range := self cStackRangeForThreadIndex: ownerIndex) includes: CFramePointer).
+ self assert: (range includes: CStackPointer)!
- <doNotGenerate>
- | range |
- range := self cStackRangeForCurrentThread.
- self assert: ((range includes: CStackPointer)
- and: [range includes: CFramePointer])!

Item was added:
+ ----- Method: CoInterpreterMT>>assertCStackPointersBelongToDisowningThread (in category 'debug support') -----
+ assertCStackPointersBelongToDisowningThread
+ <cmacro: '() 0'> "simulation only"
+ | range |
+ self assert: disowningVMThread notNil.
+ self assert: ((range := self cStackRangeForThreadIndex: disowningVMThread index) includes: CFramePointer).
+ self assert: (range includes: CStackPointer)!

Item was changed:
  ----- Method: CoInterpreterMT>>disownVM: (in category 'vm scheduling') -----
  disownVM: flags
  "Release the VM to other threads and answer the current thread's index.
  Currently valid flags:
- DisownVMLockOutFullGC - prevent fullGCs while this thread disowns the VM
  DisownVMForFFICall - informs the VM that it is entering an FFI call
+ DisownVMForThreading - informs the VM that it is entering code during which threading should be permitted
- DisownVMForThreading - informs the VM that it is entering an FFI call etc during which threading should be permitted
  OwnVMForeignThreadFlag - indicates lowest-level entry from a foreign thread
  - not to be used explicitly by clients
  - only set by ownVMFromUnidentifiedThread
  VMAlreadyOwnedHenceDoNotDisown
  - indicates an ownVM from a callback was made when
   the vm was still owned.
  - not to be used explicitly by clients
  - only set by ownVMFromUnidentifiedThread
 
  This is the entry-point for plugins and primitives that wish to release the VM while
  performing some operation that may potentially block, and for callbacks returning
  back to some blocking operation.  If this thread does not reclaim the VM before-
  hand then when the next heartbeat occurs the thread manager will schedule a
  thread to acquire the VM which may start running the VM in place of this thread.
 
  N.B. Most of the state needed to resume after preemption is set in preemptDisowningThread."
  <api>
  <inline: false>
  | vmThread result |
  <var: #vmThread type: #'CogVMThread *'>
  self assert: self successful.
  cogit recordEventTrace ifTrue:
  [self recordTrace: TraceDisownVM thing: (objectMemory integerObjectOf: flags) source: 0].
  processHasThreadId ifFalse:
  [willNotThreadWarnCount < 10 ifTrue:
  [self print: 'warning: VM parameter 48 indicates Process doesn''t have threadId; VM will not thread'; cr.
  willNotThreadWarnCount := willNotThreadWarnCount + 1]].
  vmThread := cogThreadManager currentVMThread.
  (flags anyMask: VMAlreadyOwnedHenceDoNotDisown) ifTrue:
  [disowningVMThread := vmThread.
  vmThread state: CTMUnavailable.
  ^0].
  self assertCStackPointersBelongToCurrentThread.
  (flags anyMask: DisownVMForProcessorRelinquish) ifTrue:
  [| proc |
  (proc := objectMemory splObj: foreignCallbackProcessSlot) ~= objectMemory nilObject ifTrue:
  [foreignCallbackPriority := self quickFetchInteger: PriorityIndex ofObject: proc].
  relinquishing := true.
  self sqLowLevelMFence].
- (flags anyMask: DisownVMLockOutFullGC) ifTrue:
- [objectMemory incrementFullGCLock].
  (noThreadingOfGUIThread and: [self inGUIThread]) ifTrue:
  [^vmThread index
  + LockGUIThreadFlag
  + (activeProcessAffined ifTrue: [0] ifFalse: [ProcessUnaffinedOnDisown])
  + (flags << DisownFlagsShift)].
+ disownCount := disownCount + 1.
  disowningVMThread := vmThread.
  "self cr; cr; print: 'disownVM  Csp: '; printHex: vmThread cStackPointer; cr.
  (0 to: 16 by: 4) do:
  [:offset|
  self print: ' *(esp+'; printNum: offset; print: ': '; printHex: (stackPages longAt: cogit processor sp + offset); cr].
  cogit processor printIntegerRegistersOn: Transcript."
 
  "OwnVMForeignThreadFlag indicates lowest-level of entry by a foreign
  thread. If that's where we are then release the vmThread.  Otherwise
  indicate the vmThread is off doing something outside of the VM."
  (flags anyMask: OwnVMForeignThreadFlag)
  ifTrue:
  ["I don't think this is quite right.  Josh's use case is creating some foreign thread and then registering
  it with the VM. That's not the same as binding a process to a foreign thread given that the foreign
  callback process is about to terminate anyway (it is returning from a callback here).  So do we need
  an additional concept, that of a vmThread being either of the set known to the VM or floating?"
  self flag: 'issue with registering foreign threads with the VM'.
  (self isBoundProcess: self activeProcess) ifFalse:
  [cogThreadManager unregisterVMThread: vmThread]]
  ifFalse: [vmThread state: CTMUnavailable].
  result := vmThread index
  + (activeProcessAffined ifTrue: [0] ifFalse: [ProcessUnaffinedOnDisown])
  + (flags << DisownFlagsShift).
  cogThreadManager releaseVM.
  ^result!

Item was removed:
- ----- Method: CoInterpreterMT>>enterSmalltalkExecutiveFromCallback (in category 'callback support') -----
- enterSmalltalkExecutiveFromCallback
- <inline: true>
- self threadSchedulingLoop: cogThreadManager currentVMThread!

Item was changed:
  ----- Method: CoInterpreterMT>>initialEnterSmalltalkExecutive (in category 'initialization') -----
  initialEnterSmalltalkExecutive
  "Main entry-point into the interpreter at system start-up."
  "Ensure that the myList of the activeProcess is nil.  Needed to load
  old images which don't nil myList in transferTo:{from:}"
  objectMemory storePointerUnchecked: MyListIndex ofObject: self activeProcess withValue: objectMemory nilObject.
  cogThreadManager startThreadSubsystem.
+ self threadSchedulingLoop: (cogThreadManager vmThreadAt: 1).
+ "NOTREACHED.  The following is to fool Slang"
+ self threadSchedulingLoopImplementation: cogThreadManager currentVMThread!
- self threadSchedulingLoop: (cogThreadManager vmThreadAt: 1)!

Item was changed:
  ----- Method: CoInterpreterMT>>initialize (in category 'initialization') -----
  initialize
  super initialize.
  relinquishing := checkThreadActivation := deferThreadSwitch := false.
+ foreignCallbackPriority := maxWaitingPriority := disownCount := willNotThreadWarnCount := 0!
- foreignCallbackPriority := maxWaitingPriority := willNotThreadWarnCount := 0!

Item was changed:
  ----- Method: CoInterpreterMT>>ownVM: (in category 'vm scheduling') -----
  ownVM: threadIndexAndFlags
  <api>
  <inline: false>
  "This is the entry-point for plugins and primitives that wish to reacquire the VM after having
  released it via disownVM or callbacks that want to acquire it without knowing their ownership
  status.  This call will block until the VM is owned by the current thread or an error occurs.
  The argument should be the value answered by disownVM, or 0 for callbacks that don't know
  if they have disowned or not.  This is both an optimization to avoid having to query thread-
  local storage for the current thread's index (since it can easily keep it in some local variable),
  and a record of when an unbound process becomes affined to a thread for the dynamic
  extent of some operation.
 
  Answer 0 if the current thread is known to the VM (and on return owns the VM).
  Answer 1 if the current thread is unknown to the VM and takes ownership.
  Answer -1 if the current thread is unknown to the VM and fails to take ownership."
  | threadIndex flags vmThread |
  threadIndexAndFlags = 0 ifTrue:
  [^self ownVMFromUnidentifiedThread].
 
  threadIndex := threadIndexAndFlags bitAnd: ThreadIdMask.
  flags := threadIndexAndFlags >> DisownFlagsShift.
 
  (flags anyMask: DisownVMForProcessorRelinquish) ifTrue:
  ["Presumably we have nothing to do; this primitive is typically called from the
   background process. So we should /not/ try and activate any threads in the
   pool; they will waste cycles finding there is no runnable process, and will
   cause a VM abort if no runnable process is found.  But we /do/ want to allow
   FFI calls that have completed, or callbacks a chance to get into the VM; they
   do have something to do.  DisownVMForProcessorRelinquish indicates this."
  relinquishing := false.
  self sqLowLevelMFence].
 
- (flags anyMask: DisownVMLockOutFullGC) ifTrue:
- [objectMemory decrementFullGCLock].
-
  (threadIndexAndFlags anyMask: LockGUIThreadFlag) ifTrue:
  [self assert: (noThreadingOfGUIThread and: [self inGUIThread]).
  self assert: disowningVMThread isNil.
  cogit recordEventTrace ifTrue:
  [self recordTrace: TraceOwnVM thing: ConstZero source: 0].
  ^0].
 
  vmThread := cogThreadManager acquireVMFor: threadIndex.
+ disownCount := disownCount - 1.
 
  disowningVMThread ifNotNil:
  [vmThread = disowningVMThread ifTrue:
  [self cCode: '' inSmalltalk:
  [| range | range := self cStackRangeForThreadIndex: threadIndex.
  self assert: ((range includes: CStackPointer) and: [range includes: CFramePointer])].
  self assert: self successful.
  self assert: (objectMemory fetchPointer: MyListIndex ofObject: self activeProcess) = objectMemory nilObject.
  disowningVMThread := nil.
  cogit recordEventTrace ifTrue:
  [self recordTrace: TraceOwnVM thing: ConstOne source: 0].
  ^0].  "if not preempted we're done."
  self preemptDisowningThread].
 
  "We've been preempted; we must restore state and update the threadId
  in our process, and may have to put the active process to sleep."
  self restoreVMStateFor: vmThread threadIndexAndFlags: threadIndexAndFlags.
 
  cogit recordEventTrace ifTrue:
  [self recordTrace: TraceOwnVM thing: ConstTwo source: 0].
  ^threadIndexAndFlags bitAnd: OwnVMForeignThreadFlag!

Item was changed:
  ----- Method: CogThreadManager>>vmIsOwned (in category 'public api-testing') -----
  vmIsOwned
  "Answer if the vm is owned"
+ <inline: true>
- <inline: #always>
  self sqLowLevelMFence.
  ^vmOwner > 0!

Item was changed:
  ----- Method: CogThreadManager>>vmOwnerIs: (in category 'public api-testing') -----
  vmOwnerIs: index
  "Test if the vmOwner is index."
+ <inline: true>
- <inline: #always>
  self sqLowLevelMFence.
  ^vmOwner = index!

Item was removed:
- ----- Method: CogVMSimulator>>assertCStackPointersBelongToCurrentThread (in category 'debug support') -----
- assertCStackPointersBelongToCurrentThread
- | ownerIndex range |
- self assert: (ownerIndex := cogThreadManager getVMOwner) > 0.
- self assert: ((range := self cStackRangeForThreadIndex: ownerIndex) includes: CFramePointer).
- self assert: (range includes: CStackPointer)!

Item was removed:
- ----- Method: CogVMSimulator>>assertCStackPointersBelongToDisowningThread (in category 'debug support') -----
- assertCStackPointersBelongToDisowningThread
- | range |
- self assert: disowningVMThread notNil.
- self assert: ((range := self cStackRangeForThreadIndex: disowningVMThread index) includes: CFramePointer).
- self assert: (range includes: CStackPointer)!

Item was removed:
- ----- Method: CogVMSimulator>>enterSmalltalkExecutiveFromCallback (in category 'multi-threading simulation switch') -----
- enterSmalltalkExecutiveFromCallback
- "This method includes or excludes CoInterpreterMT methods as required.
- Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate"
-
- ^self perform: #enterSmalltalkExecutiveFromCallback
- withArguments: {}
- inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])!

Item was changed:
  ----- Method: FilePlugin>>primitiveFileReadPinningAndDisowning (in category 'file primitives') -----
  primitiveFileReadPinningAndDisowning
  "This version of primitiveFileRead is for garbage collectors that support pinning
  and the multi-threaded VM.  It actually does the own/disown dance."
  | count startIndex array file slotSize elementSize bytesRead threadIndexAndFlags wasPinned |
  <inline: true>
  <var: 'file' type: #'SQFile *'>
  <var: 'count' type: #'size_t'>
  <var: 'startIndex' type: #'size_t'>
  <var: 'slotSize' type: #'size_t'>
  <var: 'elementSize' type: #'size_t'>
  count := interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 0).
  startIndex := interpreterProxy positiveMachineIntegerValueOf: (interpreterProxy stackValue: 1).
    array := interpreterProxy stackValue: 2.
  file := self fileValueOf: (interpreterProxy stackValue: 3).
 
  (interpreterProxy failed
  "buffer can be any indexable words or bytes object except CompiledMethod"
  or: [(interpreterProxy isWordsOrBytes: array) not]) ifTrue:
  [^interpreterProxy primitiveFailFor: PrimErrBadArgument].
 
  slotSize := interpreterProxy slotSizeOf: array.
  (startIndex >= 1 and: [startIndex + count - 1 <= slotSize]) ifFalse:
  [^interpreterProxy primitiveFailFor: PrimErrBadIndex].
  (wasPinned := interpreterProxy isPinned: array) ifFalse:
  [array := interpreterProxy pinObject: array].
+ threadIndexAndFlags := interpreterProxy disownVM: DisownVMForThreading.
- threadIndexAndFlags := interpreterProxy disownVM: DisownVMForFFICall.
  "Note: adjust startIndex for zero-origin byte indexing"
  elementSize := slotSize = 0
  ifTrue: [1]
  ifFalse: [(interpreterProxy byteSizeOf: array) // slotSize].
  bytesRead := self
  sqFile: file
  Read: count * elementSize
  Into: (interpreterProxy cCoerce: (interpreterProxy firstIndexableField: array) to: #'char *')
  At: startIndex - 1 * elementSize.
  interpreterProxy ownVM: threadIndexAndFlags.
  wasPinned ifFalse:
  [interpreterProxy unpinObject: array].
  interpreterProxy failed ifFalse:
  [interpreterProxy methodReturnInteger: bytesRead // elementSize] "answer # of elements read"!

Item was changed:
  ----- Method: InterpreterPrimitives>>primitiveFullGC (in category 'memory space primitives') -----
  primitiveFullGC
  "Do a full garbage collection.  In SqueakV3ObjectMemory, answer the number
  of bytes available (including swap space if dynamic memory management is
  supported).  In Spur, answer the size of the largest free chunk."
 
  objectMemory hasSpurMemoryManagerAPI ifTrue:
+ [self methodReturnInteger: objectMemory fullGC.
- [self pop: 1 thenPushInteger: objectMemory fullGC.
  ^self].
- objectMemory fullGCLock > 0 ifTrue:
- [self primitiveFailFor: PrimErrInappropriate.
- ^self].
  objectMemory incrementalGC.  "maximimize space for forwarding table"
  objectMemory fullGC.
+ self methodReturnInteger: (objectMemory bytesLeft: true)!
- self pop: 1 thenPushInteger: (objectMemory bytesLeft: true)!

Item was changed:
  ObjectMemory subclass: #NewObjectMemory
+ instanceVariableNames: 'coInterpreter freeStart reserveStart scavengeThreshold needGCFlag edenBytes checkForLeaks statGCEndUsecs heapMap'
- instanceVariableNames: 'coInterpreter freeStart reserveStart scavengeThreshold needGCFlag fullGCLock edenBytes checkForLeaks statGCEndUsecs heapMap'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'VMMaker-Interpreter'!
 
  !NewObjectMemory commentStamp: '<historical>' prior: 0!
  I am a refinement of ObjectMemory that eliminates the need for pushRemappableOop:/popRemappableOop in the interpreter proper.  Certain primitives that do major allocation may still want to provoke a garbage collection and hence may still need to remap private pointers.  But the interpreter subclass of this class does not have to provided it reserves sufficient space for it to make progress to the next scavenge point (send or backward branch).!

Item was removed:
- ----- Method: NewObjectMemory>>decrementFullGCLock (in category 'interpreter access') -----
- decrementFullGCLock
- self assert: fullGCLock > 0.
- (fullGCLock := fullGCLock - 1) < 0 ifTrue:
- [fullGCLock := 0]!

Item was changed:
  ----- Method: NewObjectMemory>>fullGC (in category 'garbage collection') -----
  fullGC
  "Do a mark/sweep garbage collection of the entire object memory.
  Free inaccessible objects but do not move them."
 
  <inline: false>
- fullGCLock > 0 ifTrue:
- [self warning: 'aborting fullGC because fullGCLock > 0'.
- ^self].
  self runLeakCheckerFor: GCModeFull.
  coInterpreter preGCAction: GCModeFull.
  needGCFlag := false.
  gcStartUsecs := self ioUTCMicrosecondsNow.
  statSweepCount := statMarkCount := statMkFwdCount := statCompMoveCount := 0.
  self clearRootsTable.
  self initWeakTableForIncrementalGC: false.
  youngStart := self startOfMemory.  "process all of memory"
  self markPhase: true.
  "Sweep phase returns the number of survivors.
  Use the up-to-date version instead the one from startup."
  totalObjectCount := self sweepPhaseForFullGC.
  self runLeakCheckerFor: GCModeFull.
  self fullCompaction.
  statFullGCs := statFullGCs + 1.
  statGCEndUsecs := self ioUTCMicrosecondsNow.
  statFullGCUsecs := statFullGCUsecs + (statGCEndUsecs - gcStartUsecs).
  coInterpreter capturePendingFinalizationSignals.
 
  youngStart := freeStart.  "reset the young object boundary"
  self attemptToShrink.
  coInterpreter postGCAction: GCModeFull.
  self runLeakCheckerFor: GCModeFull!

Item was removed:
- ----- Method: NewObjectMemory>>fullGCLock (in category 'accessing') -----
- fullGCLock
- ^fullGCLock!

Item was removed:
- ----- Method: NewObjectMemory>>incrementFullGCLock (in category 'interpreter access') -----
- incrementFullGCLock
- fullGCLock := fullGCLock + 1!

Item was changed:
  ----- Method: NewObjectMemory>>initialize (in category 'initialization') -----
  initialize
  "Initialize NewObjectMemory when simulating the VM inside Smalltalk."
  super initialize.
+ checkForLeaks := 0.
- checkForLeaks := fullGCLock := 0.
  needGCFlag := false.
  heapMap := CogCheck32BitHeapMap new!

Item was removed:
- ----- Method: SpurMemoryManager>>fullGCLock (in category 'gc - global') -----
- fullGCLock
- "Spur never has a need to lock GC because it does not move pinned objects."
- ^0!

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"
  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.
  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].
 
  ReturnToInterpreter := 1. "setjmp/longjmp code."
 
+ "Because of a hack with callbacks in the non-threaded VM they must not conflct with the VM's tag bits."
- "N.B. some of these DisownFlags are replicated in platforms/Cross/vm/sqVirtualMachine.h.
- Hence they should always be initialized.  Because of a hack with callbacks in the non-threaded
- VM they must not conflct with the VM's tag bits."
- DisownVMLockOutFullGC := 8.
  DisownVMForFFICall := 16.
  DisownVMForThreading := 32
  !

Item was changed:
  ----- Method: StackInterpreter class>>writeVMHeaderTo:bytesPerWord:generator: (in category 'translation') -----
  writeVMHeaderTo: aStream bytesPerWord: bytesPerWord generator: aCCodeGenerator
  super writeVMHeaderTo: aStream bytesPerWord: bytesPerWord generator: aCCodeGenerator.
  SistaVM ifTrue:
  [aCCodeGenerator putDefineOf: #SistaVM as: 1 on: aStream].
  NewspeakVM ifTrue:
  [aCCodeGenerator putDefineOf: #NewspeakVM as: 1 on: aStream].
  MULTIPLEBYTECODESETS ifTrue:
  [aCCodeGenerator putDefineOf: #MULTIPLEBYTECODESETS as: 1 on: aStream].
  IMMUTABILITY ifTrue:
  [aCCodeGenerator
  putConditionalDefineOf: #IMMUTABILITY
  as: 1
  comment: 'Allow this to be overridden on the compiler command line'
  on: aStream].
  SistaVM | NewspeakVM | MULTIPLEBYTECODESETS | IMMUTABILITY ifTrue:
  [aStream cr].
  aCCodeGenerator putDefineOf: #STACKVM as: 1 on: aStream.
  (InitializationOptions at: #SpurObjectMemory ifAbsent: false) ifTrue:
  [aCCodeGenerator putDefineOf: #SPURVM as: 1 on: aStream].
 
  aCCodeGenerator
- putDefineOf: #DisownVMLockOutFullGC as: DisownVMLockOutFullGC on: aStream;
  putDefineOf: #DisownVMForFFICall as: DisownVMForFFICall on: aStream;
  putDefineOf: #DisownVMForThreading as: DisownVMForThreading on: aStream!

Item was changed:
  ----- Method: StackInterpreter>>disownVM: (in category 'vm scheduling') -----
  disownVM: flags
  <api>
  <inline: false>
  "Release the VM to other threads and answer the current thread's index.
  Currently valid flags for the non-threaded VM are:
  DisownVMLockOutFullGC - prevent fullGCs while this thread disowns the VM
  DisownVMForFFICall - informs the VM that it is entering an FFI call
 
  This is the entry-point for plugins and primitives that wish to release the VM while
  performing some operation that may potentially block, and for callbacks returning
  back to some blocking operation.  While this exists for the threaded FFI VM we use
  it to reset newMethod and the argumentCount after a callback."
  self assert: primFailCode = 0.
 
  "Hack encodings of client state.  We use non-immediates (bottom three bits clear)
  for FFI/Plugin doing
  save := self disownVM: FLAGS. ... callout ... self ownVM: save.
  We use immediate integer (bottom bit 1) for callbacks doing
  save := self ownVM: 0. ... callback ... self disownVM: save. return to C"
  self assert: ((objectMemory isImmediate: flags)
  ifFalse:
+ [flags = (flags bitAnd: DisownVMForFFICall+DisownVMForThreading)
- [flags = (flags bitAnd: DisownVMLockOutFullGC+DisownVMForFFICall+DisownVMForThreading)
  and: [flags anyMask: DisownVMForFFICall]]
  ifTrue:
  [(objectMemory isIntegerObject: flags)
  and: [(objectMemory integerValueOf: flags)
  between: 0
  and: (self argumentCountOfMethodHeader: -1)]]).
 
  "If DisownVMForFFICall this is from the FFI plugin and we're making a callout; remember the fact."
  (((objectMemory isImmediate: flags)) not
  and: [flags anyMask: DisownVMForFFICall]) ifTrue:
  [self assert: ((objectMemory isOopCompiledMethod: newMethod)
  and: [(self argumentCountOf: newMethod) = argumentCount]).
  inFFIFlags := DisownVMForFFICall.
  ^flags].
 
  self assert: ((objectMemory isIntegerObject: flags)
  and: [(objectMemory integerValueOf: flags)
  between: 0
  and: (self argumentCountOfMethodHeader: -1)]).
 
  "Otherwise this is a callback return; restore argumentCount and newMethod as per the ownVM: on callback."
  argumentCount := objectMemory integerValueOf: flags.
  newMethod := self popStack.
  self assert: ((objectMemory isOopCompiledMethod: newMethod)
  and: [(self argumentCountOf: newMethod) = argumentCount]).
  ^0!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiAtomicArgByReference:Class:in: (in category 'callout support') -----
  ffiAtomicArgByReference: oop Class: oopClass in: calloutState
  <var: #calloutState type: #'CalloutState *'>
  "Support for generic callout. Prepare a pointer reference to an atomic type for callout.
  Note:
  for type 'void*' we allow ByteArray/String/Symbol, wordVariableSubclass, Alien or ExternalAddress.
  for other types we allow ByteArray, wordVariableSubclass, Alien or ExternalAddress."
+ | atomicType isString argIsAlien |
- | atomicType isString isAlien |
  <inline: true>
  atomicType := self atomicTypeOf: calloutState ffiArgHeader.
  (atomicType = FFITypeBool) ifTrue: "No bools on input"
  [^FFIErrorCoercionFailed].
+ argIsAlien := (isString := interpreterProxy
+ includesBehavior: oopClass
+ ThatOf: interpreterProxy classString)
+ ifTrue: [false]
+ ifFalse:
+ [interpreterProxy
+ includesBehavior: oopClass
+ ThatOf: interpreterProxy classAlien].
- isAlien := (isString := interpreterProxy
- includesBehavior: oopClass
- ThatOf: interpreterProxy classString)
- ifTrue: [false]
- ifFalse:
- [interpreterProxy
- includesBehavior: oopClass
- ThatOf: interpreterProxy classAlien].
  ((atomicType >> 1) = (FFITypeSignedChar >> 1)) ifTrue:"string value (char*)"
  "note: the only types allowed for passing into char* types are
  ByteArray, String, Symbol, Alien and *no* other byte indexed objects
  (e.g., CompiledMethod, LargeInteger). We only check for strings
  here and fall through to the byte* check otherwise."
  [isString ifTrue:"String/Symbol"
  "Strings must be allocated by the ffi support code"
  [^self ffiPushString: (interpreterProxy firstIndexableField: oop)
  OfLength: (interpreterProxy byteSizeOf: oop)
  in: calloutState].
  "Fall through to byte* test"
  atomicType := FFITypeUnsignedByte].
 
  self cppIf: COGMTVM ifTrue:
  ["Since all the following pass the address of the first indexable field we need to fail
  the call if it is threaded and the object is young, since it may move during the call."
  ((calloutState callFlags anyMask: FFICallFlagThreaded)
+ and: [(argIsAlien not or: [self isDirectAlien: oop])
- and: [(isAlien not or: [self isDirectAlien: oop])
  and: [interpreterProxy isYoung: oop]]) ifTrue:
  [^PrimErrObjectMayMove negated]].
 
  (atomicType = FFITypeVoid or:[(atomicType >> 1) = (FFITypeSignedByte >> 1)]) ifTrue:
  "byte* -- see comment on string above"
  [(isString or: [oopClass = interpreterProxy classByteArray]) ifTrue: "String/Symbol/ByteArray"
  [^self ffiPushPointer: (interpreterProxy firstIndexableField: oop) in: calloutState].
  (oopClass = interpreterProxy classExternalAddress) ifTrue:
  [^self ffiPushPointer: (self longAt: oop + interpreterProxy baseHeaderSize) in: calloutState].
+ argIsAlien ifTrue:
- isAlien ifTrue:
  [^self ffiPushPointer: (self pointerForOop: (self startOfData: oop)) in: calloutState].
  atomicType = FFITypeVoid ifFalse:
  [^FFIErrorCoercionFailed]].
  "note: type void falls through"
 
  "I can push pointers to any type (take for instance calls who receive int* output arguments, etc.)
  but I need to store them into a ByteArray, ExternalAddress or Alien"
  (atomicType <= FFITypeDoubleFloat) ifTrue:
  [((interpreterProxy isWords: oop) or: [oopClass = interpreterProxy classByteArray]) ifTrue:
  [^self ffiPushPointer: (interpreterProxy firstIndexableField: oop) in: calloutState].
  (oopClass = interpreterProxy classExternalAddress) ifTrue:
  [^self ffiPushPointer: (self longAt: oop + interpreterProxy baseHeaderSize) in: calloutState].
+ argIsAlien ifTrue:
- isAlien ifTrue:
  [^self ffiPushPointer: (self pointerForOop: (self startOfData: oop)) in: calloutState]].
 
  ^FFIErrorCoercionFailed!

Item was changed:
  SharedPool subclass: #VMBasicConstants
  instanceVariableNames: ''
+ classVariableNames: 'BaseHeaderSize BytecodeSetHasExtensions BytesPerOop BytesPerWord COGMTVM COGVM CloneOnGC CloneOnScavenge DisownVMForFFICall DisownVMForThreading DoAssertionChecks DoExpensiveAssertionChecks GCCheckPrimCall GCModeBecome GCModeFreeSpace GCModeFull GCModeImageSegment GCModeIncremental GCModeNewSpace HashMultiplyConstant HashMultiplyMask IMMUTABILITY LowcodeVM MULTIPLEBYTECODESETS NewspeakVM PharoVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrCallbackError PrimErrFFIException PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNeedCompaction PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrOSError PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrObjectMoved PrimErrObjectNotPinned PrimErrOperationFailed PrimErrUnsupported PrimErrWritePastObject PrimNoErr SPURVM STACKVM SistaVM TempVectReadBarrier VMBIGENDIAN'
- classVariableNames: 'BaseHeaderSize BytecodeSetHasExtensions BytesPerOop BytesPerWord COGMTVM COGVM CloneOnGC CloneOnScavenge DisownVMForFFICall DisownVMForThreading DisownVMLockOutFullGC DoAssertionChecks DoExpensiveAssertionChecks GCCheckPrimCall GCModeBecome GCModeFreeSpace GCModeFull GCModeImageSegment GCModeIncremental GCModeNewSpace HashMultiplyConstant HashMultiplyMask IMMUTABILITY LowcodeVM MULTIPLEBYTECODESETS NewspeakVM PharoVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrCallbackError PrimErrFFIException PrimErrGenericFailure PrimErrInappropriate PrimErrLimitExceeded PrimErrNamedInternal PrimErrNeedCompaction PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrOSError PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrObjectMoved PrimErrObjectNotPinned PrimErrOperationFailed PrimErrUnsupported PrimErrWritePastObject PrimNoErr SPURVM STACKVM SistaVM TempVectReadBarrier 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]!