Marcel Taeumel uploaded a new version of VMMaker to project VM Maker: http://source.squeak.org/VMMaker/VMMaker.oscog-mt.3361.mcz
==================== Summary ====================
Name: VMMaker.oscog-mt.3361 Author: mt Time: 16 April 2024, 6:05:40.062284 pm UUID: 42fd33c7-f3f9-2c4a-b874-0415e7cf2bce Ancestors: VMMaker.oscog-mt.3360
For single-threaded VM, following the recent efforts in multi-threaded VM, adjust #disownVM:/#ownVM: - rename 'inFFIFlags' to 'ffiCalloutVMHandle' - add flag DisownVMFromCallback to indicate disown from thunkEntry() - for callbacks push both newMethod and argumentCount on stack (Eliot, is this okay?) because the return value of #ownVM: should only indicate success or failure
=============== Diff against VMMaker.oscog-mt.3360 ===============
Item was changed: ----- Method: CoInterpreterMT>>ownVM: (in category 'vm scheduling') ----- ownVM: vmThreadHandle <public> <inline: false> <var: #vmThreadHandle type: #'void *'> + <var: #vmThread type: #'CogVMThread *'> + "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." + | flags vmThread | + vmThread := self cCoerce: vmThreadHandle to: #'CogVMThread *'. + vmThread ifNil: + [^self ownVMFromUnidentifiedThread]. + + self assert: vmThread = (cogThreadManager vmThreadAt: vmThread index). + + flags := vmThread disownFlags. + + vmThread := cogThreadManager acquireVMFor: vmThread. + disownCount := disownCount - 1. + + (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]. + + disowningVMThread ifNotNil: + [vmThread = disowningVMThread ifTrue: + [self assert: (vmThread cFramePointer isNil + or: [CFramePointer = vmThread cFramePointer and: [CStackPointer = vmThread cStackPointer]]). + 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 andFlags: flags. + + cogit recordEventTrace ifTrue: + [self recordTrace: TraceOwnVM thing: ConstTwo source: 0]. + ^flags bitAnd: OwnVMForeignThreadFlag! - ^ self ownVM: vmThreadHandle withFlags: 0!
Item was removed: - ----- Method: CoInterpreterMT>>ownVM:withFlags: (in category 'vm scheduling') ----- - ownVM: vmThreadHandle withFlags: additionalFlags - <public> - <inline: false> - <var: #vmThreadHandle type: #'void *'> - <var: #vmThread type: #'CogVMThread *'> - "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." - | flags vmThread | - vmThread := self cCoerce: vmThreadHandle to: #'CogVMThread *'. - vmThread ifNil: - [^self ownVMFromUnidentifiedThread]. - - self assert: vmThread = (cogThreadManager vmThreadAt: vmThread index). - - flags := vmThread disownFlags bitOr: additionalFlags. - - vmThread := cogThreadManager acquireVMFor: vmThread. - disownCount := disownCount - 1. - - (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]. - - disowningVMThread ifNotNil: - [vmThread = disowningVMThread ifTrue: - [self assert: (vmThread cFramePointer isNil - or: [CFramePointer = vmThread cFramePointer and: [CStackPointer = vmThread cStackPointer]]). - 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 andFlags: flags. - - cogit recordEventTrace ifTrue: - [self recordTrace: TraceOwnVM thing: ConstTwo source: 0]. - ^flags bitAnd: OwnVMForeignThreadFlag!
Item was removed: - ----- Method: CogVMSimulator>>ownVM:withFlags: (in category 'multi-threading simulation switch') ----- - ownVM: vmThreadHandle withFlags: additionalFlags - "This method includes or excludes CoInterpreterMT methods as required. - Auto-generated by CogVMSimulator>>ensureMultiThreadingOverridesAreUpToDate" - - ^self perform: #ownVM:withFlags: - withArguments: {vmThreadHandle. additionalFlags} - inSuperclass: (cogThreadManager ifNil: [CoInterpreterPrimitives] ifNotNil: [CoInterpreterMT])!
Item was changed: VMClass subclass: #InterpreterPrimitives + instanceVariableNames: 'objectMemory messageSelector argumentCount newMethod primFailCode secondaryErrorCode exceptionPC ffiCalloutVMHandle profileMethod profileProcess profileSemaphore nextProfileTick preemptionYields sHEAFn ffiExceptionResponse eventTraceMask multipleBytecodeSetsActive' - instanceVariableNames: 'objectMemory messageSelector argumentCount newMethod primFailCode secondaryErrorCode exceptionPC inFFIFlags profileMethod profileProcess profileSemaphore nextProfileTick preemptionYields sHEAFn ffiExceptionResponse eventTraceMask multipleBytecodeSetsActive' classVariableNames: 'CrossedX EndOfRun MillisecondClockMask' poolDictionaries: 'VMBasicConstants VMBytecodeConstants VMMethodCacheConstants VMObjectIndices VMSqueakClassIndices VMStackFrameOffsets' category: 'VMMaker-Interpreter'!
!InterpreterPrimitives commentStamp: 'eem 9/23/2021 13:20' prior: 0! InterpreterPrimitives implements most of the VM's core primitives. It is the root of the interpreter hierarchy so as to share the core primitives amongst the varioius interpreters.
Instance Variables argumentCount <Integer> eventTraceMask <Integer> exceptionPC <Integer> ffiExceptionResponse <Integer> inFFIFlags <Integer> messageSelector <Integer> newMethod <Integer> nextProfileTick <Integer> objectMemory <ObjectMemory> (simulation only) preemptionYields <Boolean> primFailCode <Integer> secondaryErrorCode <Integer> profileMethod <Integer> profileProcess <Integer> profileSemaphore <Integer> sHEAFn <Integer>
argumentCount - the number of arguments of the current message
eventTraceMask - a bit mask corresponding to the Event type codes in sq.h that decides what events are printed in primitiveGetNextEvent
exceptionPC - the pc of an exception for an exception reporting primitive failure such as PrimErrFFIException
ffiExceptionResponse - controls system response to exceptions during FFI calls. See primitiveFailForFFIException:at:
inFFIFlags - flags recording currently only whether the system is in an FFI call
messageSelector - the oop of the selector of the current message
newMethod - the oop of the result of looking up the current message
nextProfileTick - the millisecond clock value of the next profile tick (if profiling is in effect)
objectMemory - the memory manager and garbage collector that manages the heap
preemptionYields - a boolean controlling the process primitives. If true (old, incorrect, blue-book semantics) a preempted process is sent to the back of its run-queue. If false, a process preempted by a higher-priority process is put back at the head of its run queue, hence preserving cooperative scheduling within priorities.
primFailCode - primitive success/failure flag, 0 for success, otherwise the reason code for failure
profileMethod - the primitive method active when the last profile sample was taken (if any)
profileProcess - the process active when the last profile sample was taken profileSemaphore - the semaphore to be signalled when a profile sample is taken; if nil disables profiling
secondaryErrorCode - a 64-bit value settable for clonable primitive failures (PrimErrOSError, PrimErrFFIException et al)
profileMethod - the oop of the method at the time nextProfileTick was reached
profileProcess - the oop of the activeProcess at the time nextProfileTick was reached
profileSemaphore - the oop of the semaphore to signal when nextProfileTick is reached
secondaryErrorCode - an additional value associated with various primitive failures
sHEAFn - the function to call to check if access to the envronment should be granted to primitiveGetenv!
Item was changed: ----- Method: InterpreterPrimitives class>>declareCVarsIn: (in category 'C translation') ----- declareCVarsIn: aCCodeGen aCCodeGen var: 'secondaryErrorCode' type: #sqLong; var: 'exceptionPC' type: #usqInt; + var: 'sHEAFn' declareC: 'int (*sHEAFn)() = 0'; "the hasEnvironmentAccess function" + var: 'ffiCalloutVMHandle' type: #'void *'! - var: 'sHEAFn' declareC: 'int (*sHEAFn)() = 0' "the hasEnvironmentAccess function"!
Item was changed: ----- Method: InterpreterPrimitives>>initialize (in category 'initialization') ----- initialize "Here we can initialize the variables C initializes to zero. #initialize methods do /not/ get translated." + argumentCount := primFailCode := nextProfileTick := secondaryErrorCode := exceptionPC := ffiExceptionResponse := eventTraceMask := 0. + ffiCalloutVMHandle := nil.! - argumentCount := primFailCode := nextProfileTick := secondaryErrorCode := exceptionPC := inFFIFlags := ffiExceptionResponse := eventTraceMask := 0!
Item was changed: ----- Method: InterpreterPrimitives>>primitiveFailForFFIException:at: (in category 'primitive support') ----- primitiveFailForFFIException: exceptionCode at: pc <var: 'exceptionCode' type: #usqLong> <var: 'pc' type: #usqInt> "Set PrimErrFFIException primitive failure and associated exceptionCode (a.k.a. secondaryErrorCode) and exceptionPC. Under control of the ffiExceptionResponse flag, + if in a primitive with an error code and ffiCalloutVMHandle indicates we're in an FFI call, - if in a primitive with an error code and the inFFIFlags indicate we're in an FFI call, then fail the primitive. ffiExceptionResponse < 0 never fail ffiExceptionResponse = 0 fail if method has a primitive error code (default) ffiExceptionResponse > 0 always fail" <public> + (ffiCalloutVMHandle isNil "i.e. not in an FFI call" - ((inFFIFlags noMask: DisownVMForFFICall) "i.e. not in an FFI call" or: [ffiExceptionResponse < 0]) ifTrue: "i.e. never fail" [^self]. secondaryErrorCode := self cCoerceSimple: exceptionCode to: #sqLong. exceptionPC := pc. primFailCode := PrimErrFFIException. (ffiExceptionResponse > 0 "always fail..." or: [(objectMemory isOopCompiledMethod: newMethod) and: [self methodUsesPrimitiveErrorCode: newMethod]]) ifTrue: + [self ownVM: ffiCalloutVMHandle. - [self ownVM: nil withFlags: DisownVMForFFICall. "To take ownership but importantly to reset inFFIFlags" self activateFailingPrimitiveMethod]!
Item was changed: ----- Method: StackInterpreter class>>initializeMiscConstants (in category 'initialization') ----- initializeMiscConstants
super initializeMiscConstants. STACKVM := true.
RevisedSuspend := true. "primitiveSuspendBackingUpV1/2 no longer allow a process waiting on a condition variable to go past the condition variable"
"These flags identify a GC operation (& hence a reason to leak check), or just operations the leak checker can 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" GCCheckImageSegment := 16. "just a flag for leak checking image segments" GCCheckFreeSpace := 32. "just a flag for leak checking free space; Spur only" GCCheckShorten := 64. "just a flag for leak checking object shortening operations; Spur only" GCCheckPrimCall := 128. "just a flag for leak checking external primitive calls"
StackPageTraceInvalid := -1. StackPageUnreached := 0. StackPageReachedButUntraced := 1. StackPageTraced := 2.
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"
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." DisownVMForFFICall := 16. DisownVMForThreading := 32. + DisownVMFromCallback := 64. "The multiple bytecodes active bit in the image format number" MultipleBytecodeSetsBitmask := 512.!
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: #DisownVMForFFICall as: DisownVMForFFICall on: aStream; + putDefineOf: #DisownVMForThreading as: DisownVMForThreading on: aStream; + putDefineOf: #DisownVMFromCallback as: DisownVMFromCallback on: aStream! - putDefineOf: #DisownVMForThreading as: DisownVMForThreading on: aStream!
Item was changed: ----- Method: StackInterpreter>>disownVM: (in category 'vm scheduling') ----- disownVM: flags <public> <inline: false> + <returnTypeC: #'void *'> + <var: #vmHandle type: #'void *'> + | vmHandle | "Release the VM to other threads and answer the current thread's index. Currently valid flags for the non-threaded VM are: DisownVMForThreading - allow the VM to thread-switch; this is ignored - 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. + self assert: flags ~= 0. + + "In the single-threaded VM here, we treat flags directly as vmHandle. See MTVM." + vmHandle := self cCoerce: flags to: #'void *'.
+ "We are either in disowning after a callback (see thunkEntry) or before an FFI + callout." + self assert: (flags = DisownVMFromCallback or: + [flags = (flags bitAnd: DisownVMForFFICall+DisownVMForThreading) + and: [flags anyMask: DisownVMForFFICall]]). - flags = DisownVMForThreading ifTrue: - [^flags].
- "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) - 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." + (flags anyMask: DisownVMForFFICall) ifTrue: - (((objectMemory isImmediate: flags)) not - and: [flags anyMask: DisownVMForFFICall]) ifTrue: [self assert: ((objectMemory isOopCompiledMethod: newMethod) and: [(self argumentCountOf: newMethod) = argumentCount]). + ^ ffiCalloutVMHandle := vmHandle]. - 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." + (flags anyMask: DisownVMFromCallback) ifTrue: + [argumentCount := objectMemory integerValueOf: self popStack. + self assert: (argumentCount + between: 0 + and: (self argumentCountOfMethodHeader: -1)). + newMethod := self popStack. + self assert: ((objectMemory isOopCompiledMethod: newMethod) - argumentCount := objectMemory integerValueOf: flags. - newMethod := self popStack. - self assert: ((objectMemory isOopCompiledMethod: newMethod) and: [(self argumentCountOf: newMethod) = argumentCount]). + ^ nil]. + + ^ vmHandle! - ^0!
Item was changed: ----- Method: StackInterpreter>>ownVM: (in category 'vm scheduling') ----- + ownVM: vmHandle - ownVM: threadIndexAndFlags <public> <inline: false> + <var: #vmHandle type: #'void *'> + "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. While this exists for the threaded FFI VM we use it to reset newMethod and the + argumentCount after a callback. + + 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." + + | flags | + self assert: ((objectMemory isOopCompiledMethod: newMethod) + and: [(self argumentCountOf: newMethod) = argumentCount]). + + "From callbacks (see thunkEntry), we don't know our ownerhip. Stash newMethod + and argumentCount on the stack." + vmHandle ifNil: + [self assert: primFailCode = 0. + self push: newMethod. + self push: (objectMemory integerObjectOf: argumentCount). + ^ 1 "unknown to VM"]. + + flags := self cCoerce: vmHandle to: #sqInt. + (flags anyMask: DisownVMForFFICall) ifTrue: + [ffiCalloutVMHandle := nil]. + + ^0 "already known"! - ^ self ownVM: threadIndexAndFlags withFlags: 0!
Item was removed: - ----- Method: StackInterpreter>>ownVM:withFlags: (in category 'vm scheduling') ----- - ownVM: threadIndexAndFlags withFlags: additionalFlags - <public> - <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. While this exists for the threaded FFI VM we use it to reset newMethod and the - argumentCount after a callback. - - Answer -1 if the current thread is unknown to the VM and fails to take ownership." - <var: 'amInVMThread' declareC: 'extern sqInt amInVMThread(void)'> - | flags | - flags := threadIndexAndFlags bitOr: additionalFlags. - self cppIf: COGMTVM - ifTrue: - [self amInVMThread ifFalse: - [^-1]]. - - self assert: ((objectMemory isOopCompiledMethod: newMethod) - and: [(self argumentCountOf: newMethod) = argumentCount]). - - "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" - - "If DisownVMForFFICall this is from the FFI plugin and we're returning from a callout." - (flags anyMask: DisownVMForFFICall) ifTrue: - [inFFIFlags := 0. - ^flags]. - - "Otherwise this is a callback; stash newMethod on the stack and encode - argumentCount in the flags retrieved when the calback calls disownVM:." - self assert: primFailCode = 0. - self push: newMethod. - ^objectMemory integerObjectOf: argumentCount!
Item was changed: ----- Method: ThreadedARM32FFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') ----- ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState <var: #procAddr type: #'void *'> <var: #calloutState type: #'CalloutState *'> <var: #loadFloatRegs declareC: 'extern void loadFloatRegs(double, double, double, double, double, double, double, double)'> "Go out, call this guy and create the return value. This *must* be inlined because of the alloca of the outgoing stack frame in ffiCall:WithFlags:NumArgs:Args:AndTypes:" + | vmHandle atomicType floatRet intRet | + <var: #vmHandle type: #'void *'> - | myThreadIndex atomicType floatRet intRet | <var: #floatRet type: #double> <var: #intRet type: #usqLong> <inline: #always> + vmHandle := interpreterProxy disownVM: (self disownFlagsFor: calloutState). - myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState).
calloutState floatRegisterIndex > 0 ifTrue: [self loadFloatRegs: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 0)) to: #'double *') at: 0) _: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 2)) to: #'double *') at: 0) _: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 4)) to: #'double *') at: 0) _: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 6)) to: #'double *') at: 0) _: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 8)) to: #'double *') at: 0) _: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 10)) to: #'double *') at: 0) _: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 12)) to: #'double *') at: 0) _: ((self cCoerceSimple: (self addressOf: (calloutState floatRegisters at: 14)) to: #'double *') at: 0)].
(self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue: [self setsp: calloutState argVector].
atomicType := self atomicTypeOf: calloutState ffiRetHeader. (atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue: [atomicType = FFITypeSingleFloat ifTrue: [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3)] ifFalse: "atomicType = FFITypeDoubleFloat" [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3)].
"undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. + interpreterProxy ownVM: vmHandle. - interpreterProxy ownVM: myThreadIndex.
^interpreterProxy floatObjectOf: floatRet].
intRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqIntptr_t (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3).
"undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. + interpreterProxy ownVM: vmHandle. - interpreterProxy ownVM: myThreadIndex.
(calloutState ffiRetHeader anyMask: FFIFlagPointer+FFIFlagStructure) ifTrue: [| returnType | "Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent 'typedef void* VoidPointer' and VoidPointer must be returned as pointer *not* as struct." returnType := self ffiReturnType: specOnStack. (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue: [^self ffiReturnPointer: intRet ofType: returnType in: calloutState]. ^self ffiReturnStruct: (self addressOf: intRet) ofType: returnType in: calloutState]. ^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState!
Item was changed: ----- Method: ThreadedARM64FFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') ----- ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState <var: #procAddr type: #'void *'> <var: #calloutState type: #'CalloutState *'> <var: #loadFloatRegs declareC: 'extern void loadFloatRegs(double, double, double, double, double, double, double, double)'> "Go out, call this guy and create the return value. This *must* be inlined because of the alloca of the outgoing stack frame in ffiCall:WithFlags:NumArgs:Args:AndTypes:" + | vmHandle atomicType floatRet intRet structRet specSize | + <var: 'vmHandle' type: #'void *'> - | myThreadIndex atomicType floatRet intRet structRet specSize | <var: 'floatRet' type: #ThirtyTwoByteReturnDF> <var: 'structRet' type: #SixteenByteReturnII> <var: 'intRet' type: #usqLong> <inline: #always> self cCode: [] inSmalltalk: [floatRet := ByteArray new: 32]. "Just a hack to placate the Smalltalk compiler; these should be proper struct types..." + vmHandle := interpreterProxy disownVM: (self disownFlagsFor: calloutState). - myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState). calloutState floatRegisterIndex > 0 ifTrue: [self loadFloatRegs: (calloutState floatRegisters at: 0) _: (calloutState floatRegisters at: 1) _: (calloutState floatRegisters at: 2) _: (calloutState floatRegisters at: 3) _: (calloutState floatRegisters at: 4) _: (calloutState floatRegisters at: 5) _: (calloutState floatRegisters at: 6) _: (calloutState floatRegisters at: 7)].
(self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue: [self setsp: calloutState argVector].
atomicType := self atomicTypeOf: calloutState ffiRetHeader. ((atomicType >> 1) = (FFITypeSingleFloat >> 1) or: [(calloutState ffiRetHeader bitAnd: FFIFlagPointer+FFIFlagStructure) = FFIFlagStructure and: [self structIsHomogenousFloatArrayOfSize: (calloutState ffiRetHeader bitAnd: FFIStructSizeMask) typeSpec: (self cCoerce: (interpreterProxy firstIndexableField: calloutState ffiRetSpec) to: #'unsigned int *') ofLength: (specSize := interpreterProxy byteSizeOf: calloutState ffiRetSpec) / (self sizeof: #'unsigned int')]]) ifTrue: [floatRet d: (self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'struct dprr (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5) with: (calloutState integerRegisters at: 6) with: (calloutState integerRegisters at: 7)).
"undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. + interpreterProxy ownVM: vmHandle. - interpreterProxy ownVM: myThreadIndex.
atomicType = FFITypeDoubleFloat ifTrue: [^interpreterProxy floatObjectOf: (floatRet d doubles at: 0)]. atomicType = FFITypeSingleFloat ifTrue: [^interpreterProxy floatObjectOf: (floatRet f floats at: 0)]. "If the struct is a vector of floats then move float[2] to float[1], float[4] to float[2] and float[6] to float[3], to pack the float data in the double fields. We can tell if the struct is composed of floats if its size is less than the spec size, since the spec size is (1 + n fields) * 4 bytes, and the struct size is n fields * 4 bytes for floats and n fields * 8 bytes for doubles. We can't access the spec post call because it may have moved." specSize > calloutState structReturnSize ifTrue: [floatRet f floats at: 1 put: (floatRet f floats at: 2). floatRet f floats at: 2 put: (floatRet f floats at: 4). floatRet f floats at: 3 put: (floatRet f floats at: 6)]. ^self ffiReturnStruct: (self addressOf: floatRet) ofType: (self ffiReturnType: specOnStack) in: calloutState].
"Integer and Structure returns..." "If struct address used for return value, call is special; struct return pointer must be in x8" (self mustReturnStructOnStack: calloutState structReturnSize) ifTrue: [intRet := 0. self setReturnRegister: (self cCoerceSimple: calloutState limit to: #sqLong) "stack alloca'd struct" andCall: (self cCoerceSimple: procAddr to: #sqLong) withArgsArray: (self cCoerceSimple: (self addressOf: calloutState integerRegisters) to: #sqLong)] ifFalse: [structRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnII (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5) with: (calloutState integerRegisters at: 6) with: (calloutState integerRegisters at: 7). intRet := structRet a]. "X1"
"undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. + interpreterProxy ownVM: vmHandle. - interpreterProxy ownVM: myThreadIndex.
(calloutState ffiRetHeader anyMask: FFIFlagPointer+FFIFlagStructure) ifTrue: [| returnType | "Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent 'typedef void* VoidPointer' and VoidPointer must be returned as pointer *not* as struct." returnType := self ffiReturnType: specOnStack. (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue: [^self ffiReturnPointer: intRet ofType: returnType in: calloutState]. ^self ffiReturnStruct: (((self returnStructInRegisters: calloutState) ifTrue: [self cCoerceSimple: (self addressOf: structRet) to: #'char *'] ifFalse: [calloutState limit])) ofType: returnType in: calloutState]. ^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState!
Item was changed: ----- Method: ThreadedFFIPlugin>>disownFlagsFor: (in category 'primitive support') ----- disownFlagsFor: calloutState <var: #calloutState type: #'CalloutState *'> <inline: #always> + ^ (calloutState callFlags anyMask: FFICallFlagThreaded) - ^self cppIf: COGMTVM - ifTrue: [(calloutState callFlags anyMask: FFICallFlagThreaded) ifTrue: [DisownVMForFFICall+DisownVMForThreading] + ifFalse: [DisownVMForFFICall]! - ifFalse: [DisownVMForFFICall]] - ifFalse: [DisownVMForFFICall]!
Item was changed: ----- Method: ThreadedIA32FFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') ----- ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState <var: #procAddr type: #'void *'> <var: #calloutState type: #'CalloutState *'> "Go out, call this guy and create the return value. This *must* be inlined because of the alloca of the outgoing stack frame in ffiCall:WithFlags:NumArgs:Args:AndTypes:" + | vmHandle atomicType floatRet intRet | + <var: #vmHandle type: #'void *'> - | myThreadIndex atomicType floatRet intRet | <var: #floatRet type: #double> <var: #intRet type: #usqLong> "Support up to int64_t or uint64_t" <inline: #always> + vmHandle := interpreterProxy disownVM: (self disownFlagsFor: calloutState). - myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState).
(self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue: [self setsp: calloutState argVector].
atomicType := self atomicTypeOf: calloutState ffiRetHeader. (atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue: [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)()').
"undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. + interpreterProxy ownVM: vmHandle. - interpreterProxy ownVM: myThreadIndex.
^interpreterProxy floatObjectOf: floatRet].
intRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqLong (*)()').
"undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. + interpreterProxy ownVM: vmHandle. - interpreterProxy ownVM: myThreadIndex.
(calloutState ffiRetHeader anyMask: FFIFlagPointer+FFIFlagStructure) ifTrue: [| returnType | "Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent 'typedef void* VoidPointer' and VoidPointer must be returned as pointer *not* as struct." returnType := self ffiReturnType: specOnStack. (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue: [^self ffiReturnPointer: intRet ofType: returnType in: calloutState]. ^self ffiReturnStruct: (self addressOf: intRet) ofType: returnType in: calloutState]. ^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState!
Item was changed: ----- Method: ThreadedRiscV64FFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') ----- ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState <var: #procAddr type: #'void *'> <var: #calloutState type: #'CalloutState *'> <var: #loadFloatRegs declareC: 'extern void loadFloatRegs(double, double, double, double, double, double, double, double)'> "Go out, call this guy and create the return value. This *must* be inlined because of the alloca of the outgoing stack frame in ffiCall:WithFlags:NumArgs:Args:AndTypes:" + | vmHandle atomicType floatRet intRet structRet specSize | + <var: 'vmHandle' type: #'void *'> - | myThreadIndex atomicType floatRet intRet structRet specSize | <var: 'doubleRet' type: #double> <var: 'floatRet' type: #ThirtyTwoByteReturnDF> <var: 'structRet' type: #SixteenByteReturnII> <var: 'intRet' type: #usqLong> <inline: #always> self cCode: [] inSmalltalk: [floatRet := ByteArray new: 32]. "Just a hack to placate the Smalltalk compiler; these should be proper struct types..." + vmHandle := interpreterProxy disownVM: (self disownFlagsFor: calloutState). - myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState). calloutState floatRegisterIndex > 0 ifTrue: [self loadFloatRegs: (calloutState floatRegisters at: 0) _: (calloutState floatRegisters at: 1) _: (calloutState floatRegisters at: 2) _: (calloutState floatRegisters at: 3) _: (calloutState floatRegisters at: 4) _: (calloutState floatRegisters at: 5) _: (calloutState floatRegisters at: 6) _: (calloutState floatRegisters at: 7)].
(self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue: [self setsp: calloutState argVector].
"float or double returns" atomicType := self atomicTypeOf: calloutState ffiRetHeader. (atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue: [| doubleRet | atomicType = FFITypeDoubleFloat ifTrue: [doubleRet := (self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5) with: (calloutState integerRegisters at: 6) with: (calloutState integerRegisters at: 7))] ifFalse: [doubleRet := (self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5) with: (calloutState integerRegisters at: 6) with: (calloutState integerRegisters at: 7))]. "undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. + interpreterProxy ownVM: vmHandle. - interpreterProxy ownVM: myThreadIndex. ^self floatObjectOf: doubleRet].
"homogenous array of float/double returns" ((calloutState ffiRetHeader bitAnd: FFIFlagPointer+FFIFlagStructure) = FFIFlagStructure and: [self structIsHomogenousFloatArrayOfSize: (calloutState ffiRetHeader bitAnd: FFIStructSizeMask) typeSpec: (self cCoerce: (interpreterProxy firstIndexableField: calloutState ffiRetSpec) to: #'unsigned int *') ofLength: (specSize := interpreterProxy byteSizeOf: calloutState ffiRetSpec) / (self sizeof: #'unsigned int')]) ifTrue: [floatRet d: (self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'struct dprr (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5) with: (calloutState integerRegisters at: 6) with: (calloutState integerRegisters at: 7)).
"undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. + interpreterProxy ownVM: vmHandle. - interpreterProxy ownVM: myThreadIndex.
"If the struct is a vector of floats then move float[2] to float[1], float[4] to float[2] and float[6] to float[3], to pack the float data in the double fields. We can tell if the struct is composed of floats if its size is less than the spec size, since the spec size is (1 + n fields) * 4 bytes, and the struct size is n fields * 4 bytes for floats and n fields * 8 bytes for doubles. We can't access the spec post call because it may have moved." specSize > calloutState structReturnSize ifTrue: [floatRet f floats at: 1 put: (floatRet f floats at: 2). floatRet f floats at: 2 put: (floatRet f floats at: 4). floatRet f floats at: 3 put: (floatRet f floats at: 6)]. ^self ffiReturnStruct: (self addressOf: floatRet) ofType: (self ffiReturnType: specOnStack) in: calloutState].
"Integer and Structure returns..." (self mustReturnStructOnStack: calloutState structReturnSize) ifTrue: [intRet := 0. self setReturnRegister: (self cCoerceSimple: calloutState limit to: #sqLong) "stack alloca'd struct" andCall: (self cCoerceSimple: procAddr to: #sqLong) withArgsArray: (self cCoerceSimple: (self addressOf: calloutState integerRegisters) to: #sqLong)] ifFalse: [structRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnII (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5) with: (calloutState integerRegisters at: 6) with: (calloutState integerRegisters at: 7). intRet := structRet a]. "X1"
"undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. + interpreterProxy ownVM: vmHandle. - interpreterProxy ownVM: myThreadIndex.
(calloutState ffiRetHeader anyMask: FFIFlagPointer+FFIFlagStructure) ifTrue: [| returnType | "Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent 'typedef void* VoidPointer' and VoidPointer must be returned as pointer *not* as struct." returnType := self ffiReturnType: specOnStack. (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue: [^self ffiReturnPointer: intRet ofType: returnType in: calloutState]. ^self ffiReturnStruct: (((self returnStructInRegisters: calloutState) ifTrue: [self cCoerceSimple: (self addressOf: structRet) to: #'char *'] ifFalse: [calloutState limit])) ofType: returnType in: calloutState]. ^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState!
Item was changed: ----- Method: ThreadedX64SysVFFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') ----- ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState <var: #procAddr type: #'void *'> <var: #calloutState type: #'CalloutState *'> <var: #loadFloatRegs declareC: 'extern void loadFloatRegs(double, double, double, double, double, double, double, double)'> "Go out, call this guy and create the return value. This *must* be inlined because of the alloca of the outgoing stack frame in ffiCall:WithFlags:NumArgs:Args:AndTypes:" + | vmHandle atomicType floatRet intRet sddRet sdiRet sidRet siiRet returnStructByValue registerType sRetPtr | + <var: #vmHandle type: #'void *'> - | myThreadIndex atomicType floatRet intRet sddRet sdiRet sidRet siiRet returnStructByValue registerType sRetPtr | <var: #floatRet type: #double> <var: #intRet type: #sqInt> <var: #siiRet type: #SixteenByteReturnII> <var: #sidRet type: #SixteenByteReturnID> <var: #sdiRet type: #SixteenByteReturnDI> <var: #sddRet type: #SixteenByteReturnDD> <var: #sRetPtr type: #'void *'> <inline: #always> returnStructByValue := (calloutState ffiRetHeader bitAnd: FFIFlagStructure + FFIFlagPointer + FFIFlagAtomic) = FFIFlagStructure. + vmHandle := interpreterProxy disownVM: (self disownFlagsFor: calloutState). - myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState).
calloutState floatRegisterIndex > 0 ifTrue: [self loadFloatRegs: (calloutState floatRegisters at: 0) _: (calloutState floatRegisters at: 1) _: (calloutState floatRegisters at: 2) _: (calloutState floatRegisters at: 3) _: (calloutState floatRegisters at: 4) _: (calloutState floatRegisters at: 5) _: (calloutState floatRegisters at: 6) _: (calloutState floatRegisters at: 7)].
(self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue: [self setsp: calloutState argVector].
atomicType := self atomicTypeOf: calloutState ffiRetHeader. (atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue: [atomicType = FFITypeSingleFloat ifTrue: [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5)] ifFalse: "atomicType = FFITypeDoubleFloat" [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5)].
+ interpreterProxy ownVM: vmHandle. - interpreterProxy ownVM: myThreadIndex.
^interpreterProxy floatObjectOf: floatRet].
returnStructByValue ifFalse: [intRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'sqInt (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5). + interpreterProxy ownVM: vmHandle. - interpreterProxy ownVM: myThreadIndex. (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue: [^self ffiReturnPointer: intRet ofType: (self ffiReturnType: specOnStack) in: calloutState]. ^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState].
registerType := calloutState structReturnType. registerType caseOf: {[2r00] -> [sddRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnDD (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5). sRetPtr := (self addressOf: sddRet) asVoidPointer]. [2r01] -> [sidRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnID (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5). sRetPtr := (self addressOf: sidRet) asVoidPointer]. [2r10] -> [sdiRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnDI (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5). sRetPtr := (self addressOf: sdiRet) asVoidPointer]. [2r11] -> [siiRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'SixteenByteReturnII (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5). sRetPtr := (self addressOf: siiRet) asVoidPointer]. [2r100] -> [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5). sRetPtr := (self addressOf: floatRet) asVoidPointer]. [2r101] -> [intRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'sqInt (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5). sRetPtr := (self addressOf: intRet) asVoidPointer]. [2r110] -> ["return a pointer to alloca'd memory" intRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'sqInt (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3) with: (calloutState integerRegisters at: 4) with: (calloutState integerRegisters at: 5). sRetPtr := intRet asVoidPointer "address of struct is returned in RAX, which also is calloutState limit"]} otherwise: + [interpreterProxy ownVM: vmHandle. - [interpreterProxy ownVM: myThreadIndex. self ffiFail: FFIErrorWrongType. ^nil].
+ interpreterProxy ownVM: vmHandle. - interpreterProxy ownVM: myThreadIndex. ^self ffiReturnStruct: sRetPtr ofType: (self ffiReturnType: specOnStack) in: calloutState!
Item was changed: ----- Method: ThreadedX64Win64FFIPlugin>>ffiCalloutTo:SpecOnStack:in: (in category 'callout support') ----- ffiCalloutTo: procAddr SpecOnStack: specOnStack in: calloutState <var: #procAddr type: #'void *'> <var: #calloutState type: #'CalloutState *'> <var: #loadFloatRegs declareC: 'extern void loadFloatRegs(double, double, double, double)'> "Go out, call this guy and create the return value. This *must* be inlined because of the alloca of the outgoing stack frame in ffiCall:WithFlags:NumArgs:Args:AndTypes:" + | vmHandle atomicType floatRet intRet | + <var: #vmHandle type: #'void *'> - | myThreadIndex atomicType floatRet intRet | <var: #floatRet type: #double> <var: #intRet type: #usqLong> <inline: #always> + vmHandle := interpreterProxy disownVM: (self disownFlagsFor: calloutState). - myThreadIndex := interpreterProxy disownVM: (self disownFlagsFor: calloutState).
calloutState floatRegisterSignature > 0 ifTrue: [self loadFloatRegs: (calloutState floatRegisters at: 0) _: (calloutState floatRegisters at: 1) _: (calloutState floatRegisters at: 2) _: (calloutState floatRegisters at: 3)].
(self allocaLiesSoSetSpBeforeCall or: [self mustAlignStack]) ifTrue: [self setsp: calloutState argVector].
atomicType := self atomicTypeOf: calloutState ffiRetHeader. (atomicType >> 1) = (FFITypeSingleFloat >> 1) ifTrue: [atomicType = FFITypeSingleFloat ifTrue: [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'float (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3)] ifFalse: "atomicType = FFITypeDoubleFloat" [floatRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'double (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3)].
"undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. + interpreterProxy ownVM: vmHandle. - interpreterProxy ownVM: myThreadIndex.
^interpreterProxy floatObjectOf: floatRet].
intRet := self dispatchFunctionPointer: (self cCoerceSimple: procAddr to: 'usqIntptr_t (*)(sqIntptr_t, sqIntptr_t, sqIntptr_t, sqIntptr_t)') with: (calloutState integerRegisters at: 0) with: (calloutState integerRegisters at: 1) with: (calloutState integerRegisters at: 2) with: (calloutState integerRegisters at: 3).
"undo any callee argument pops because it may confuse stack management with the alloca." (self isCalleePopsConvention: calloutState callFlags) ifTrue: [self setsp: calloutState argVector]. + interpreterProxy ownVM: vmHandle. - interpreterProxy ownVM: myThreadIndex.
(calloutState ffiRetHeader anyMask: FFIFlagPointer+FFIFlagStructure) ifTrue: [| returnType | "Note: Order is important here since FFIFlagPointer + FFIFlagStructure is used to represent 'typedef void* VoidPointer' and VoidPointer must be returned as pointer *not* as struct." returnType := self ffiReturnType: specOnStack. (calloutState ffiRetHeader anyMask: FFIFlagPointer) ifTrue: [^self ffiReturnPointer: intRet ofType: returnType in: calloutState]. ^self ffiReturnStruct: (self addressOf: intRet) ofType: returnType in: calloutState]. ^self ffiCreateIntegralResultOop: intRet ofAtomicType: atomicType in: calloutState!
Item was changed: SharedPool subclass: #VMBasicConstants instanceVariableNames: '' + classVariableNames: 'BaseHeaderSize BytecodeSetHasExtensions BytesPerOop BytesPerWord COGMTVM COGVM CloneOnGC CloneOnScavenge DisownVMForFFICall DisownVMForThreading DisownVMFromCallback DoAssertionChecks DoExpensiveAssertionChecks FastCPrimitiveAlignForFloatsFlag FastCPrimitiveFlag GCCheckFreeSpace GCCheckImageSegment GCCheckPrimCall GCCheckShorten GCModeBecome GCModeFull GCModeIncremental GCModeNewSpace HashMultiplyConstant HashMultiplyMask IMMUTABILITY LowcodeVM MULTIPLEBYTECODESETS NewspeakVM PharoVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrCallbackError PrimErrFFIException PrimErrFFIMarshallingError PrimErrGenericFailure PrimErrInappropriate PrimErrInternalError PrimErrLimitExceeded PrimErrNamedInternal PrimErrNeedCompaction PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrOSError PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrObjectMoved PrimErrObjectNotPinned PrimErrOperationFailed PrimEr rUninitialized PrimErrUnsupported PrimErrWritePastObject PrimNoErr PrimNumberHandlerMarker PrimNumberNoContextSwitchMarker PrimNumberUnwindMarker SPURVM STACKVM SistaVM TempVectReadBarrier VMBIGENDIAN' - classVariableNames: 'BaseHeaderSize BytecodeSetHasExtensions BytesPerOop BytesPerWord COGMTVM COGVM CloneOnGC CloneOnScavenge DisownVMForFFICall DisownVMForThreading DoAssertionChecks DoExpensiveAssertionChecks FastCPrimitiveAlignForFloatsFlag FastCPrimitiveFlag GCCheckFreeSpace GCCheckImageSegment GCCheckPrimCall GCCheckShorten GCModeBecome GCModeFull GCModeIncremental GCModeNewSpace HashMultiplyConstant HashMultiplyMask IMMUTABILITY LowcodeVM MULTIPLEBYTECODESETS NewspeakVM PharoVM PrimErrBadArgument PrimErrBadIndex PrimErrBadMethod PrimErrBadNumArgs PrimErrBadReceiver PrimErrCallbackError PrimErrFFIException PrimErrFFIMarshallingError PrimErrGenericFailure PrimErrInappropriate PrimErrInternalError PrimErrLimitExceeded PrimErrNamedInternal PrimErrNeedCompaction PrimErrNoCMemory PrimErrNoMemory PrimErrNoModification PrimErrNotFound PrimErrOSError PrimErrObjectIsPinned PrimErrObjectMayMove PrimErrObjectMoved PrimErrObjectNotPinned PrimErrOperationFailed PrimErrUninitialized PrimEr rUnsupported PrimErrWritePastObject PrimNoErr PrimNumberHandlerMarker PrimNumberNoContextSwitchMarker PrimNumberUnwindMarker 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]!