VM Maker Inbox: VMMaker.oscog-nice.2763.mcz

 
Nicolas Cellier uploaded a new version of VMMaker to project VM Maker Inbox:
http://source.squeak.org/VMMakerInbox/VMMaker.oscog-nice.2763.mcz

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

Name: VMMaker.oscog-nice.2763
Author: nice
Time: 21 June 2020, 9:36:33.453625 pm
UUID: 685e3e10-e9d5-4dab-acf0-188b5a543315
Ancestors: VMMaker.oscog-nice.2762

Major changes to FFI:

- always wrap returned value into its ExternalTypeAlias when it's an atomic value
  This is necessary so that we can chain FFI calls, because, FFI only accept instance of ExternalTypeAlias on input
  Note that an alias to a pointer (like void *) will be wrapped in an ExternalData fromHandle: ExternalAddress

- handle only these combinations
  FFIFlagAtomic & nil referentClass
  FFIFlagAtomic + FFIFlagPointer & nil referentClass
  FFIFlagAtomic & atomic TypeAlias referentClass
  FFIFlagAtomic + FFIFlagPointer & atomic TypeAlias referentClass
  FFIFlagStructure & ExternalStructure referentClass
  FFIFlagStructure + FFIFlagPointer & ExternalStructure referentClass

When a non nil referentClass is specified in external function API, only accept:
- an instance of the referentClass (or subclass) if an atomic value (TypeAlias)/or struct (both by reference or value)
- an ExternalData whose type points to same referentClass (or subclass)
- eventually nil if passed by reference

An ExternalData is accepted even when the arguments are passed by value.
This enables passing direct reference to external variables (global variables exported by the ExternalLibrary).
Hence the new ffiPushDereference* protocol.

Also accept double-byte, word and double-word arrays when the referentClass is nil.
TODO: accept them as valid memory area thru ExternalData too... (not the case yet).

Side notes:

- this version of the plugin requires image side changes:
 Most notably, Pointer to struct needs to have FFIFlagStructure+FFIFlagPointer set in their compiledSpec.

- provision has been made to make the plugin more permissive (ffiHasPermissiveArgCheck)
  For the case when type checking and marshalling is taken care at image side (in UFFI), the plugin might want to handle lower level data (ExternalAddress and immediate values) with less checks.
  The plan would be to add a flag in the ExternalFunction flags (used only for ABI cdecl/apicall by now), so as to give a maximum of flexibility and let mixed FFI/UFFI coexist peacefully (this might happen if your application depends on a lot of 3rd party)

- The FFI flags/typeSpec encoding shall be revised.
  Obviously, we do not need both Atomic+Structure flags
  A type is either atomic, or it is composite, but not both, nor neither
  There are plenty unused combinations, and previous encoding was somehow mysterious

- it might be good to encode pointer arity in the type spec for more safety
  If we keep 1 bit for indicating a pointer, then with 2 or 3 extra bits, we can encode extra arity (up to 4 or 8 levels, more than enough)
  Those bits can be resused for something else when non pointer (extra size for example...)

- it might be good to encode byte alignment in the spec rather than re-computing it in the plugin. This way, we could manage exotic/specific byte alignment at image side (byte alignment can vary with C compile flags! Not recommended, but can happen!)

- considerable simplification/acceleration could be obtained if we ensured unchanged ExternalType identity between ExternalFunction specification and types used in ExternalData.
  Note that this type is not easily accessible when an ExternalStructure/ExternalTypeAlias is passed as argument. Maybe it should!

- both structTypeNamed: and their corresponding pointerType share the same ExternalStructure/ExternalTypeAlias referentClass.
  There is thus some kind of ambiguity, we never know if a Foo or Foo* was passed on input or returned on output (there is no direct way to retrieve ExternalTypeAliasFoo externalType from the plugin)
  This is going to be a problem if we add pointer arity support.

Note that I lost the ability to raise the FFIErrorIntAsPointer, but that's minor, we can bring it back if we want to.

With those changes, I can somehow have the basic examples of HDF5 interface working (http://www.squeaksource.com/STEM), which is a challenge, HDF5 has a rich/complex API (uses external variables, callbacks, many types, alias enums struct and unions, many functions)

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

Item was changed:
  ----- Method: ThreadedARM64FFIPlugin>>ffiCall:ArgArrayOrNil:NumArgs: (in category 'callout support') -----
  ffiCall: externalFunction ArgArrayOrNil: argArrayOrNil NumArgs: nArgs
  "Generic callout. Does the actual work.  If argArrayOrNil is nil it takes args from the stack
  and the spec from the method.  If argArrayOrNil is not nil takes args from argArrayOrNil
  and the spec from the receiver."
+ | flags argTypeArray address argType oop argSpec argClass err theCalloutState calloutState requiredStackSize stackSize allocation result primNumArgs alias retClass |
- | flags argTypeArray address argType oop argSpec argClass err theCalloutState calloutState requiredStackSize stackSize allocation result primNumArgs |
  <inline: true>
  <var: #theCalloutState type: #'CalloutState'>
  <var: #calloutState type: #'CalloutState *'>
  <var: #allocation type: #'char *'>
 
  primNumArgs := interpreterProxy methodArgumentCount.
  (interpreterProxy is: externalFunction KindOfClass: interpreterProxy classExternalFunction) ifFalse:
  [^self ffiFail: FFIErrorNotFunction].
  "Load and check the values in the externalFunction before we call out"
  flags := interpreterProxy fetchInteger: ExternalFunctionFlagsIndex ofObject: externalFunction.
  interpreterProxy failed ifTrue:
  [^self ffiFail: FFIErrorBadArgs].
 
  "This must come early for compatibility with the old FFIPlugin.  Image-level code
  may assume the function pointer is loaded eagerly.  Thanks to Nicolas Cellier."
  address := self ffiLoadCalloutAddress: externalFunction.
  interpreterProxy failed ifTrue:
  [^0 "error code already set by ffiLoadCalloutAddress:"].
 
  argTypeArray := interpreterProxy fetchPointer: ExternalFunctionArgTypesIndex ofObject: externalFunction.
  "must be array of arg types"
  ((interpreterProxy isArray: argTypeArray)
  and: [(interpreterProxy slotSizeOf: argTypeArray) = (nArgs + 1)]) ifFalse:
  [^self ffiFail: FFIErrorBadArgs].
  "check if the calling convention is supported"
  self cppIf: COGMTVM
  ifTrue:
  [(self ffiSupportsCallingConvention: (flags bitAnd: FFICallTypesMask)) ifFalse:
  [^self ffiFail: FFIErrorCallType]]
  ifFalse: "not masking causes threaded calls to fail, which is as they should if the plugin is not threaded."
  [(self ffiSupportsCallingConvention: flags) ifFalse:
  [^self ffiFail: FFIErrorCallType]].
 
  requiredStackSize := self externalFunctionHasStackSizeSlot
  ifTrue: [interpreterProxy
  fetchInteger: ExternalFunctionStackSizeIndex
  ofObject: externalFunction]
  ifFalse: [-1].
  interpreterProxy failed ifTrue:
  [^interpreterProxy primitiveFailFor: (argArrayOrNil isNil
  ifTrue: [PrimErrBadMethod]
  ifFalse: [PrimErrBadReceiver])].
  stackSize := requiredStackSize < 0 ifTrue: [DefaultMaxStackSize] ifFalse: [requiredStackSize].
  self cCode: [] inSmalltalk: [theCalloutState := self class calloutStateClass new].
  calloutState := self addressOf: theCalloutState.
  self cCode: [self memset: calloutState _: 0 _: (self sizeof: #CalloutState)].
  calloutState callFlags: flags.
  "Fetch return type and args"
  argType := interpreterProxy fetchPointer: 0 ofObject: argTypeArray.
  argSpec := interpreterProxy fetchPointer: 0 ofObject: argType.
+ retClass := interpreterProxy fetchPointer: 1 ofObject: argType.
+ (err := self ffiCheckReturn: argSpec With: retClass in: calloutState) ~= 0 ifTrue:
- argClass := interpreterProxy fetchPointer: 1 ofObject: argType.
- (err := self ffiCheckReturn: argSpec With: argClass in: calloutState) ~= 0 ifTrue:
  [^self ffiFail: err]. "cannot return"
  "alloca the outgoing stack frame, leaving room for marshalling args, and including space for the return struct, if any.
  Additional space reserved for saving register args like mandated by Win64 X64 or PPC ABI, will be managed by the call itself"
  allocation := self alloca: stackSize + calloutState structReturnSize + self cStackAlignment.
  self mustAlignStack ifTrue:
  [allocation := self cCoerce: (allocation asUnsignedIntegerPtr bitClear: self cStackAlignment - 1) to: #'char *'].
  calloutState
  argVector: allocation;
  currentArg: allocation;
  limit: allocation + stackSize.
  1 to: nArgs do:
  [:i|
  argType := interpreterProxy fetchPointer: i ofObject: argTypeArray.
  argSpec := interpreterProxy fetchPointer: 0 ofObject: argType.
  argClass := interpreterProxy fetchPointer: 1 ofObject: argType.
  oop := argArrayOrNil isNil
  ifTrue: [interpreterProxy stackValue: nArgs - i]
  ifFalse: [interpreterProxy fetchPointer: i - 1 ofObject: argArrayOrNil].
  err := self ffiArgument: oop Spec: argSpec Class: argClass in: calloutState.
  err ~= 0 ifTrue:
  [self cleanupCalloutState: calloutState.
  self cppIf: COGMTVM ifTrue:
  [err = PrimErrObjectMayMove negated ifTrue:
  [^PrimErrObjectMayMove]]. "N.B. Do not fail if object may move because caller will GC and retry."
  ^self ffiFail: err]]. "coercion failed or out of stack space"
  "Failures must be reported back from ffiArgument:Spec:Class:in:.
  Should not fail from here on in."
  self assert: interpreterProxy failed not.
  self ffiLogCallout: externalFunction.
  (requiredStackSize < 0
  and: [self externalFunctionHasStackSizeSlot]) ifTrue:
  [stackSize := calloutState currentArg - calloutState argVector.
  interpreterProxy storeInteger: ExternalFunctionStackSizeIndex ofObject: externalFunction withValue: stackSize].
  "Go out and call this guy"
  result := self ffiCalloutTo: address SpecOnStack: argArrayOrNil notNil in: calloutState.
+ retClass = interpreterProxy nilObject
+ ifFalse:
+ [(calloutState ffiRetHeader bitAnd: (FFIFlagAtomic + FFIFlagPointer + FFIFlagStructure)) = FFIFlagAtomic
+ ifTrue:
+ [self remapOop: result
+ in: [alias := interpreterProxy
+ instantiateClass: retClass
+ indexableSize: 0].
+ interpreterProxy storePointer: 0 ofObject: alias withValue: result.
+ result := alias]].
  self cleanupCalloutState: calloutState.
  "Can not safely use argumentCount (via e.g. methodReturnValue:) since it may have been changed by a callback."
  interpreterProxy pop: primNumArgs + 1 thenPush: result.
  ^result!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiArgument:Spec:Class:in: (in category 'callout support') -----
  ffiArgument: oop Spec: argSpec Class: argClass in: calloutState
- "Callout support. Prepare the given oop as argument.
- argSpec defines the compiled spec for the argument.
- argClass (if non-nil) defines the required (super)class for the argument."
  <var: #calloutState type: #'CalloutState *'>
- | valueOop oopClass isStruct nilOop |
- <inline: false>
- oopClass := interpreterProxy fetchClassOf: oop. "Prefetch class (we'll need it)"
- nilOop :=  interpreterProxy nilObject.
- "Do the necessary type checks"
- argClass = nilOop ifFalse:[
- "Type check 1:
- Is the required class of the argument a subclass of ExternalStructure?"
- (interpreterProxy includesBehavior: argClass
- ThatOf: interpreterProxy classExternalStructure)
- ifFalse:[^FFIErrorWrongType]. "Nope. Fail."
- "Type check 2:
- Is the class of the argument a subclass of required class?"
- ((nilOop = oop) or:[interpreterProxy includesBehavior: oopClass ThatOf: argClass])
- ifFalse:[^FFIErrorCoercionFailed]. "Nope. Fail."
- "Okay, we've passed the type check (so far)"
- ].
 
- "Check if oopClass is a subclass of ExternalStructure.
- If this is the case we'll work on it's handle and not the actual oop."
- isStruct := false.
- (oop ~= nilOop
- and: [interpreterProxy isPointers: oop]) ifTrue: "#isPointers: will fail if oop is immediate so don't even attempt to use it"
- [isStruct := interpreterProxy
- includesBehavior: oopClass
- ThatOf: interpreterProxy classExternalStructure.
- (argClass = nilOop or: [isStruct]) ifFalse:
- [^FFIErrorCoercionFailed]].
- "note: the test for #isPointers: above should speed up execution since no pointer type
- ST objects are allowed in external calls and thus if #isPointers: is true then the arg must
- be ExternalStructure to work. If it isn't then the code fails anyways so speed isn't an issue."
-
- "Determine valueOop (e.g., the actual oop to pass as argument)"
- isStruct
- ifTrue:[valueOop := interpreterProxy fetchPointer: 0 ofObject: oop]
- ifFalse:[valueOop := oop].
-
  "Fetch and check the contents of the compiled spec"
+ | nilOop oopClass |
  (interpreterProxy isWords: argSpec)
  ifFalse:[^FFIErrorWrongType].
  calloutState ffiArgSpecSize: (interpreterProxy slotSizeOf: argSpec).
  calloutState ffiArgSpecSize = 0 ifTrue:[^FFIErrorWrongType].
  calloutState ffiArgSpec: (interpreterProxy firstIndexableField: argSpec).
  calloutState ffiArgHeader: (interpreterProxy longAt: calloutState ffiArgSpec).
+
+ oopClass := interpreterProxy fetchClassOf: oop. "Prefetch class (we'll need it)"
+ nilOop :=  interpreterProxy nilObject.
+ nilOop = argClass
+ ifTrue: [(calloutState ffiArgHeader bitAnd: FFIFlagAtomic + FFIFlagPointer + FFIFlagStructure)
+ caseOf:
+ {[FFIFlagAtomic] -> [^self ffiPassAtomicArgumentByValue: oop Class: oopClass In: calloutState].
+ [FFIFlagAtomic + FFIFlagPointer] -> [^self ffiPassAtomicArgumentByReference: oop Class: oopClass In: calloutState]}
+ otherwise: [^FFIErrorWrongType]]
+ ifFalse:
+ ["If specified, the required class of the argument shall be subclass of ExternalStructure"
+ (interpreterProxy includesBehavior: argClass ThatOf: interpreterProxy classExternalStructure)
+ ifFalse:[^FFIErrorWrongType].
+ (calloutState ffiArgHeader bitAnd: FFIFlagAtomic + FFIFlagPointer + FFIFlagStructure)
+ caseOf:
+ {[FFIFlagAtomic] -> [^self ffiPassAtomicArgumentByValue: oop Class: oopClass expectedClass: argClass In: calloutState].
+ [FFIFlagAtomic + FFIFlagPointer] -> [^self ffiPassAtomicArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState].
+ [FFIFlagStructure] -> [^self ffiPassStructureArgumentByValue: oop Class: oopClass expectedClass: argClass In: calloutState].
+ [FFIFlagStructure + FFIFlagPointer] -> [^self ffiPassStructureArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState].}
+ otherwise: [^FFIErrorWrongType]].!
-
- "Do the actual preparation of the argument"
- "Note: Order is important since FFIFlagStructure + FFIFlagPointer is used to represent 'typedef void* VoidPointer' and VoidPointer really is *struct* not pointer."
-
- (calloutState ffiArgHeader anyMask: FFIFlagStructure) ifTrue:[
- "argument must be ExternalStructure"
- isStruct ifFalse:[^FFIErrorCoercionFailed].
- (calloutState ffiArgHeader anyMask: FFIFlagAtomic)
- ifTrue:[^FFIErrorWrongType]. "bad combination"
- ^self ffiPushStructureContentsOf: valueOop in: calloutState].
-
- (calloutState ffiArgHeader anyMask: FFIFlagPointer) ifTrue:[
- "no integers (or characters) for pointers please"
- (interpreterProxy isImmediate: oop)
- ifTrue:[^FFIErrorIntAsPointer].
-
- "but allow passing nil pointer for any pointer type"
- oop = nilOop ifTrue:[^self ffiPushPointer: nil in: calloutState].
-
- "argument is reference to either atomic or structure type"
- (calloutState ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[
- isStruct "e.g., ExternalData"
- ifTrue:[^self ffiAtomicStructByReference: oop Class: oopClass in: calloutState]
- ifFalse:[^self ffiAtomicArgByReference: oop Class: oopClass in: calloutState].
- "********* NOTE: The above uses 'oop' not 'valueOop' (for ExternalData) ******"
- ].
-
- "Needs to be external structure here"
- isStruct ifFalse:[^FFIErrorCoercionFailed].
- ^self ffiPushPointerContentsOf: valueOop in: calloutState].
-
- (calloutState ffiArgHeader anyMask: FFIFlagAtomic) ifTrue:[
- "argument is atomic value"
- ^self ffiArgByValue: valueOop in: calloutState].
- "None of the above - bad spec"
- ^FFIErrorWrongType!

Item was removed:
- ----- 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 isAlien |
- <inline: true>
- atomicType := self atomicTypeOf: calloutState ffiArgHeader.
- (atomicType = FFITypeBool) ifTrue: "No bools on input"
- [^FFIErrorCoercionFailed].
- 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: [(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].
- 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].
- isAlien ifTrue:
- [^self ffiPushPointer: (self pointerForOop: (self startOfData: oop)) in: calloutState]].
-
- ^FFIErrorCoercionFailed!

Item was removed:
- ----- Method: ThreadedFFIPlugin>>ffiAtomicStructByReference:Class:in: (in category 'callout support') -----
- ffiAtomicStructByReference: oop Class: oopClass in: calloutState
- <var: #calloutState type: #'CalloutState *'>
- "Support for generic callout. Prepare an external pointer reference to an atomic type for callout."
- | atomicType err valueOop |
- <inline: true>
- "must be external data to pass pointers to atomic type"
- oopClass = interpreterProxy classExternalData
- ifFalse:[^FFIErrorCoercionFailed].
- atomicType := self atomicTypeOf: calloutState ffiArgHeader.
- "no type checks for void pointers"
- atomicType ~= FFITypeVoid ifTrue:[
- err := self ffiValidateExternalData: oop AtomicType: atomicType.
- err ~= 0 ifTrue:[^err].
- ].
- "and push pointer contents"
- valueOop := interpreterProxy fetchPointer: 0 ofObject: oop.
- ^self ffiPushPointerContentsOf: valueOop in: calloutState!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiCall:ArgArrayOrNil:NumArgs: (in category 'callout support') -----
  ffiCall: externalFunction ArgArrayOrNil: argArrayOrNil NumArgs: nArgs
  "Generic callout. Does the actual work.  If argArrayOrNil is nil it takes args from the stack
  and the spec from the method.  If argArrayOrNil is not nil takes args from argArrayOrNil
  and the spec from the receiver."
+ | flags argTypeArray address argType oop argSpec argClass err theCalloutState calloutState requiredStackSize stackSize allocation result primNumArgs alias retClass |
- | flags argTypeArray address argType oop argSpec argClass err theCalloutState calloutState requiredStackSize stackSize allocation result primNumArgs |
  <inline: true>
  <var: #theCalloutState type: #'CalloutState'>
  <var: #calloutState type: #'CalloutState *'>
  <var: #allocation type: #'char *'>
 
  primNumArgs := interpreterProxy methodArgumentCount.
  (interpreterProxy is: externalFunction KindOfClass: interpreterProxy classExternalFunction) ifFalse:
  [^self ffiFail: FFIErrorNotFunction].
  "Load and check the values in the externalFunction before we call out"
  flags := interpreterProxy fetchInteger: ExternalFunctionFlagsIndex ofObject: externalFunction.
  interpreterProxy failed ifTrue:
  [^self ffiFail: FFIErrorBadArgs].
 
  "This must come early for compatibility with the old FFIPlugin.  Image-level code
  may assume the function pointer is loaded eagerly.  Thanks to Nicolas Cellier."
  address := self ffiLoadCalloutAddress: externalFunction.
  interpreterProxy failed ifTrue:
  [^0 "error code already set by ffiLoadCalloutAddress:"].
 
  argTypeArray := interpreterProxy fetchPointer: ExternalFunctionArgTypesIndex ofObject: externalFunction.
  "must be array of arg types"
  ((interpreterProxy isArray: argTypeArray)
  and: [(interpreterProxy slotSizeOf: argTypeArray) = (nArgs + 1)]) ifFalse:
  [^self ffiFail: FFIErrorBadArgs].
  "check if the calling convention is supported"
  self cppIf: COGMTVM
  ifTrue:
  [(self ffiSupportsCallingConvention: (flags bitAnd: FFICallTypesMask)) ifFalse:
  [^self ffiFail: FFIErrorCallType]]
  ifFalse: "not masking causes threaded calls to fail, which is as they should if the plugin is not threaded."
  [(self ffiSupportsCallingConvention: flags) ifFalse:
  [^self ffiFail: FFIErrorCallType]].
 
  requiredStackSize := self externalFunctionHasStackSizeSlot
  ifTrue: [interpreterProxy
  fetchInteger: ExternalFunctionStackSizeIndex
  ofObject: externalFunction]
  ifFalse: [-1].
  interpreterProxy failed ifTrue:
  [^interpreterProxy primitiveFailFor: (argArrayOrNil isNil
  ifTrue: [PrimErrBadMethod]
  ifFalse: [PrimErrBadReceiver])].
  stackSize := requiredStackSize < 0 ifTrue: [DefaultMaxStackSize] ifFalse: [requiredStackSize].
  self cCode: [] inSmalltalk: [theCalloutState := self class calloutStateClass new].
  calloutState := self addressOf: theCalloutState.
  self cCode: [self memset: calloutState _: 0 _: (self sizeof: #CalloutState)].
  calloutState callFlags: flags.
  "Fetch return type and args"
  argType := interpreterProxy fetchPointer: 0 ofObject: argTypeArray.
  argSpec := interpreterProxy fetchPointer: 0 ofObject: argType.
+ retClass := interpreterProxy fetchPointer: 1 ofObject: argType.
+ (err := self ffiCheckReturn: argSpec With: retClass in: calloutState) ~= 0 ifTrue:
- argClass := interpreterProxy fetchPointer: 1 ofObject: argType.
- (err := self ffiCheckReturn: argSpec With: argClass in: calloutState) ~= 0 ifTrue:
  [^self ffiFail: err]. "cannot return"
  "alloca the outgoing stack frame, leaving room for marshalling args, and including space for the return struct, if any.
  Additional space reserved for saving register args like mandated by Win64 X64 or PPC ABI, will be managed by the call itself"
  allocation := self alloca: stackSize + calloutState structReturnSize + self cStackAlignment.
  self mustAlignStack ifTrue:
  [allocation := self cCoerce: (allocation asUnsignedIntegerPtr bitClear: self cStackAlignment - 1) to: #'char *'].
  calloutState
  argVector: allocation;
  currentArg: allocation;
  limit: allocation + stackSize.
  (calloutState structReturnSize > 0
  and: [self nonRegisterStructReturnIsViaImplicitFirstArgument
  and: [(self returnStructInRegisters: calloutState) not]]) ifTrue:
  [err := self ffiPushPointer: calloutState limit in: calloutState.
  err ~= 0 ifTrue:
  [self cleanupCalloutState: calloutState.
  self cppIf: COGMTVM ifTrue:
  [err = PrimErrObjectMayMove negated ifTrue:
  [^PrimErrObjectMayMove]]. "N.B. Do not fail if object may move because caller will GC and retry."
  ^self ffiFail: err]].
  1 to: nArgs do:
  [:i|
  argType := interpreterProxy fetchPointer: i ofObject: argTypeArray.
  argSpec := interpreterProxy fetchPointer: 0 ofObject: argType.
  argClass := interpreterProxy fetchPointer: 1 ofObject: argType.
  oop := argArrayOrNil isNil
  ifTrue: [interpreterProxy stackValue: nArgs - i]
  ifFalse: [interpreterProxy fetchPointer: i - 1 ofObject: argArrayOrNil].
  err := self ffiArgument: oop Spec: argSpec Class: argClass in: calloutState.
  err ~= 0 ifTrue:
  [self cleanupCalloutState: calloutState.
  self cppIf: COGMTVM ifTrue:
  [err = PrimErrObjectMayMove negated ifTrue:
  [^PrimErrObjectMayMove]]. "N.B. Do not fail if object may move because caller will GC and retry."
  ^self ffiFail: err]]. "coercion failed or out of stack space"
  "Failures must be reported back from ffiArgument:Spec:Class:in:.
  Should not fail from here on in."
  self assert: interpreterProxy failed not.
  self ffiLogCallout: externalFunction.
  (requiredStackSize < 0
  and: [self externalFunctionHasStackSizeSlot]) ifTrue:
  [stackSize := calloutState currentArg - calloutState argVector.
  interpreterProxy storeInteger: ExternalFunctionStackSizeIndex ofObject: externalFunction withValue: stackSize].
  "Go out and call this guy"
  result := self ffiCalloutTo: address SpecOnStack: argArrayOrNil notNil in: calloutState.
+ "Wrap atomic alias into own class"
+ retClass = interpreterProxy nilObject
+ ifFalse:
+ [(calloutState ffiRetHeader bitAnd: (FFIFlagAtomic + FFIFlagPointer + FFIFlagStructure)) = FFIFlagAtomic
+ ifTrue:
+ [self remapOop: result
+ in: [alias := interpreterProxy
+ instantiateClass: retClass
+ indexableSize: 0].
+ interpreterProxy storePointer: 0 ofObject: alias withValue: result.
+ result := alias]].
  self cleanupCalloutState: calloutState.
  "Can not safely use argumentCount (via e.g. methodReturnValue:) since it may have been changed by a callback."
  interpreterProxy pop: primNumArgs + 1 thenPush: result.
  ^result!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiHasPermissiveArgCheck (in category 'callout support') -----
+ ffiHasPermissiveArgCheck
+ "answer true if FFI type checking is permissive.
+ answer false if FFI type checking is strict.
+ By now, hardcode the preference"
+
+ ^false!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiPassAtomicArgumentByReference:Class:In: (in category 'callout support') -----
+ ffiPassAtomicArgumentByReference: oop Class: oopClass In: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+
+ "So we want to pass a reference to immediate value, which is possible from:
+ - ExternalData
+ - nil (representing NULL pointer)
+ - String in case of (unsigned) char * - we then pass a copy
+ - ByteArray/ExternalAddress/Alien in case of (unsigned) char *, (unsigned) byte *, void *
+ - DoubleByteArray in case of (unsigned) short *
+ - WordArray in case of (unsigned) int *, float *
+ - DoubleWordArray in case of (unsigned) long long *, double *
+ direct use of ExternalAddress or ByteArray memory zone might be considered unsafe.
+ They may have to be explicitely wrapped into an ExternalData and dressed with appropriate type in the future"
+
+ | atomicType handle ptrAddress ptrClass |
+ atomicType := self atomicTypeOf: calloutState ffiArgHeader.
+ (interpreterProxy includesBehavior: oopClass ThatOf: interpreterProxy classExternalData)
+ ifTrue:
+ ["Check: we handle pointer to an atomic type"
+ "no type checks for void pointers"
+ atomicType ~= FFITypeVoid ifTrue: [self ffiValidateExternalData: oop AtomicType: atomicType].
+ interpreterProxy failed ifTrue:[^nil].
+ "Get the handle, retrieve the address to which it points, and pass it as a pointer"
+ handle := interpreterProxy fetchPointer: 0 ofObject: oop.
+ ^self ffiPushPointerContentsOf: handle in: calloutState].
+ "allow passing nil pointer for any pointer type"
+ oop == interpreterProxy nilObject ifTrue:[^self ffiPushPointer: nil in: calloutState].
+ "Check String case"
+ ((atomicType >> 1) = (FFITypeSignedChar >> 1))
+ ifTrue:
+ ["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."
+ (interpreterProxy includesBehavior: oopClass ThatOf: interpreterProxy classString)
+ ifTrue: [^self ffiPushString: (interpreterProxy firstIndexableField: oop)
+ OfLength: (interpreterProxy byteSizeOf: oop)
+ in: calloutState].
+ "Fall through to byte* test"
+ atomicType := FFITypeUnsignedByte].
+
+ "Accept an ExternalAddress for whatever type"
+ ptrClass := interpreterProxy fetchClassOf: oop.
+ ptrClass = interpreterProxy classExternalAddress ifTrue:
+ [ptrAddress := (interpreterProxy fetchPointer: 0 ofObject: oop) asVoidPointer.
+ "Don't you dare to pass pointers into object memory"
+ (interpreterProxy isInMemory: ptrAddress) ifTrue:
+ [^FFIErrorInvalidPointer].
+ ^self ffiPushPointer: ptrAddress in: calloutState].
+
+ "same for Alien"
+ (interpreterProxy includesBehavior: ptrClass ThatOf: interpreterProxy classAlien) ifTrue:
+ [self cppIf: COGMTVM ifTrue:
+ [((calloutState callFlags anyMask: FFICallFlagThreaded)
+   and: [(self isDirectAlien: oop)
+   and: [interpreterProxy isYoung: oop]]) ifTrue:
+ [^PrimErrObjectMayMove negated]].
+
+ ptrAddress := self startOfData: oop.
+ ^self ffiPushPointer: ptrAddress in: calloutState].
+
+ 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: [interpreterProxy isYoung: oop]) ifTrue:
+ [^PrimErrObjectMayMove negated]].
+
+ "Accept ByteArray for void* or byte*. No other byte-oriented class (LargeInteger etc...) is accepted"
+ ((ptrClass = interpreterProxy classByteArray) and:
+ [atomicType = FFITypeVoid or:[(atomicType >> 1) = (FFITypeSignedByte >> 1)]]) ifTrue:
+ [^self ffiPushPointer: (interpreterProxy firstIndexableField: oop) in: calloutState].
+
+ "Check for double byte"
+ ((interpreterProxy isShorts: oop) and: [atomicType = FFITypeVoid or:[(atomicType >> 1) = (FFITypeSignedShort >> 1)]])
+ ifTrue: [^self ffiPushPointer: (interpreterProxy firstIndexableField: oop) in: calloutState].
+ "Check for word"
+ ((interpreterProxy isWords: oop) and: [atomicType = FFITypeVoid or: [atomicType == FFITypeSingleFloat or:[(atomicType >> 1) = (FFITypeSignedInt >> 1)]]])
+ ifTrue: [^self ffiPushPointer: (interpreterProxy firstIndexableField: oop) in: calloutState].
+ "Check for double word"
+ ((interpreterProxy isLong64s: oop) and: [atomicType = FFITypeVoid or: [atomicType == FFITypeDoubleFloat or:[(atomicType >> 1) = (FFITypeSignedLongLong >> 1)]]])
+ ifTrue: [^self ffiPushPointer: (interpreterProxy firstIndexableField: oop) in: calloutState].
+ ^FFIErrorCoercionFailed!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiPassAtomicArgumentByReference:Class:expectedClass:In: (in category 'callout support') -----
+ ffiPassAtomicArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+
+ "So we want to pass a reference to an ExternalTypeAlias, which is possible from:
+ - ExternalData if type referentClass is matching expected argClass
+ - nil (representing NULL pointer)
+ direct use of ExternalAddress or ByteArray memory zone is considered unsafe.
+ They have to be explicitely wrapped into an ExternalData and dressed with appropriate type"
+
+ | handle type referentClass |
+ (interpreterProxy includesBehavior: oopClass ThatOf: interpreterProxy classExternalData)
+ ifTrue:
+ ["Fetch the type specification and check against expectedClass"
+ type := interpreterProxy fetchPointer: 1 ofObject: oop.
+ ((interpreterProxy isPointers: type) and: [(interpreterProxy slotSizeOf: type) >= 2]) ifFalse:
+ [^FFIErrorWrongType].
+ referentClass := interpreterProxy fetchPointer: 1 ofObject: type.
+ (interpreterProxy includesBehavior: referentClass ThatOf: argClass) ifFalse: [^FFIErrorCoercionFailed].
+ "Get the handle, retrieve the address to which it points, and pass it as a pointer"
+ handle := interpreterProxy fetchPointer: 0 ofObject: oop.
+ ^self ffiPushPointerContentsOf: handle in: calloutState].
+ "allow passing nil pointer for any pointer type"
+ oop == interpreterProxy nilObject ifTrue:[^self ffiPushPointer: nil in: calloutState].
+ ^FFIErrorCoercionFailed!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiPassAtomicArgumentByValue:Class:In: (in category 'callout support') -----
+ ffiPassAtomicArgumentByValue: oop Class: oopClass In: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <var: #pointer type: #'void *'>
+
+ "So we want to pass an immediate value, which is possible from:
+ - nil,true,false
+ - Integer, Float, Character
+ - ExternalTypeAlias to an atomic
+ - ExternalData (dereferencing the pointer) typically case of a global variable
+
+ We do not handle ExternalAddress or RawBitsArray, here...
+ They shall be de-referenced at image side"
+
+ | atomicType handle ptrClass pointer |
+ (interpreterProxy includesBehavior: oopClass ThatOf: interpreterProxy classExternalData)
+ ifTrue:
+ ["Fetch the type specification and check: we handle pointer to an atomic type"
+ atomicType := self atomicTypeOf: calloutState ffiArgHeader.
+ self ffiValidateExternalData: oop AtomicType: atomicType.
+ interpreterProxy failed ifTrue:[^nil].
+ "Get the handle and check whether it is a correct pointer spec"
+ handle := interpreterProxy fetchPointer: 0 ofObject: oop.
+ ptrClass := interpreterProxy fetchClassOf: handle.
+ ptrClass = interpreterProxy classExternalAddress
+ ifTrue:
+ [pointer := interpreterProxy fetchPointer: 0 ofObject: handle.
+ "Don't you dare to pass pointers into object memory"
+ (interpreterProxy isInMemory: pointer)
+ ifTrue:[^FFIErrorInvalidPointer]]
+ ifFalse:
+ [ptrClass = interpreterProxy classByteArray
+ ifTrue: [pointer := self cCoerce: (interpreterProxy firstIndexableField: handle) to: 'void *']
+ ifFalse: [^FFIErrorBadArg]].
+ "Dereference the pointer"
+ ^self dispatchOn: atomicType
+ in: #(
+ ffiPushDereferenceVoid:in:
+ ffiPushDereferenceUnsignedInt:in:
+ ffiPushDereferenceUnsignedByte:in:
+ ffiPushDereferenceSignedByte:in:
+ ffiPushDereferenceUnsignedShort:in:
+ ffiPushDereferenceSignedShort:in:
+ ffiPushDereferenceUnsignedInt:in:
+ ffiPushDereferenceSignedInt:in:
+ ffiPushDereferenceUnsignedLongLong:in:
+ ffiPushDereferenceSignedLongLong:in:
+ ffiPushDereferenceUnsignedChar:in:
+ ffiPushDereferenceSignedChar:in:
+ ffiPushDereferenceSingleFloat:in:
+ ffiPushDereferenceDoubleFloat:in:)
+ with: pointer
+ with: calloutState].
+ (interpreterProxy includesBehavior: oopClass ThatOf: interpreterProxy classExternalStructure)
+ ifTrue:
+ ["We do not have any type specification easily available.
+ ExternalTypeAlias are wrapper around the handle, so just pass the handle"
+ handle := interpreterProxy fetchPointer: 0 ofObject: oop.
+ ^self ffiArgByValue: handle in: calloutState].
+ "handle other more trivial cases"
+ ^self ffiArgByValue: oop in: calloutState "Period or right bracket expected ->" "Period or right bracket expected ->"!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiPassAtomicArgumentByValue:Class:expectedClass:In: (in category 'callout support') -----
+ ffiPassAtomicArgumentByValue: oop Class: oopClass expectedClass: argClass In: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <var: #pointer type: #'void *'>
+
+ "So we want to pass an immediate value, if a given type alias
+ - ExternalTypeAlias of expectedClass (or eventually a subclass)
+ - ExternalData (dereferencing the pointer) typically case of a global variable
+
+ We do not handle ExternalAddress or RawBitsArray, here...
+ They shall be de-referenced at image side"
+
+ | atomicType handle ptrClass pointer type referentClass |
+ (interpreterProxy includesBehavior: oopClass ThatOf: argClass)
+ ifTrue:
+ ["We passed an object of the expectedClass (or a subclass of it) - pass its handle by value"
+ handle := interpreterProxy fetchPointer: 0 ofObject: oop.
+ ^self ffiArgByValue: handle in: calloutState].
+ (interpreterProxy includesBehavior: oopClass ThatOf: interpreterProxy classExternalData)
+ ifTrue:
+ ["Fetch the type specification and check against expectedClass"
+ type := interpreterProxy fetchPointer: 1 ofObject: oop.
+ ((interpreterProxy isPointers: type) and: [(interpreterProxy slotSizeOf: type) >= 2]) ifFalse:
+ [^FFIErrorWrongType].
+ referentClass := interpreterProxy fetchPointer: 1 ofObject: type.
+ (interpreterProxy includesBehavior: referentClass ThatOf: argClass) ifFalse: [^FFIErrorCoercionFailed].
+ "Get the handle and check whether it is a correct pointer spec"
+ handle := interpreterProxy fetchPointer: 0 ofObject: oop.
+ ptrClass := interpreterProxy fetchClassOf: handle.
+ ptrClass = interpreterProxy classExternalAddress
+ ifTrue:
+ [pointer := interpreterProxy fetchPointer: 0 ofObject: handle.
+ "Don't you dare to pass pointers into object memory"
+ (interpreterProxy isInMemory: pointer)
+ ifTrue:[^FFIErrorInvalidPointer]]
+ ifFalse:
+ [ptrClass = interpreterProxy classByteArray
+ ifTrue: [pointer := self cCoerce: (interpreterProxy firstIndexableField: handle) to: 'void *']
+ ifFalse: [^FFIErrorBadArg]].
+ "Dereference the pointer"
+ atomicType := self atomicTypeOf: calloutState ffiArgHeader.
+ ^self dispatchOn: atomicType
+ in: #(
+ ffiPushDereferenceVoid:in:
+ ffiPushDereferenceUnsignedInt:in:
+ ffiPushDereferenceUnsignedByte:in:
+ ffiPushDereferenceSignedByte:in:
+ ffiPushDereferenceUnsignedShort:in:
+ ffiPushDereferenceSignedShort:in:
+ ffiPushDereferenceUnsignedInt:in:
+ ffiPushDereferenceSignedInt:in:
+ ffiPushDereferenceUnsignedLongLong:in:
+ ffiPushDereferenceSignedLongLong:in:
+ ffiPushDereferenceUnsignedChar:in:
+ ffiPushDereferenceSignedChar:in:
+ ffiPushDereferenceSingleFloat:in:
+ ffiPushDereferenceDoubleFloat:in:)
+ with: pointer
+ with: calloutState].
+ (interpreterProxy includesBehavior: oopClass ThatOf: interpreterProxy classExternalStructure)
+ ifTrue:
+ ["We do not have any type specification easily available.
+ ExternalTypeAlias are wrapper around the handle, so just pass the handle"
+ handle := interpreterProxy fetchPointer: 0 ofObject: oop.
+ ^self ffiArgByValue: handle  in: calloutState].
+ "handle other more trivial cases only if we are permissive"
+ self ffiHasPermissiveArgCheck ifFalse: [^FFIErrorCoercionFailed].
+ ^self ffiArgByValue: oop in: calloutState!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiPassStructureArgumentByReference:Class:expectedClass:In: (in category 'callout support') -----
+ ffiPassStructureArgumentByReference: oop Class: oopClass expectedClass: argClass In: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+
+ "So we want to pass a reference to immediate value, which is possible from:
+ - ExternalStructure if class is matching expected argClass
+ - ExternalData if type is matching expected argClass
+ - nil (representing NULL pointer)
+ direct use of ExternalAddress or ByteArray memory zone is considered unsafe.
+ They have to be explicitely wrapped into an ExternalData and dressed with appropriate type"
+
+ | handle type referentClass |
+ (interpreterProxy includesBehavior: oopClass ThatOf: argClass)
+ ifTrue:
+ ["Get the handle, retrieve the address to which it points, and pass it as a pointer"
+ handle := interpreterProxy fetchPointer: 0 ofObject: oop.
+ ^self ffiPushPointerContentsOf: handle in: calloutState].
+ (interpreterProxy includesBehavior: oopClass ThatOf: interpreterProxy classExternalData)
+ ifTrue:
+ ["Fetch the type specification and check against expectedClass"
+ type := interpreterProxy fetchPointer: 1 ofObject: oop.
+ ((interpreterProxy isPointers: type) and: [(interpreterProxy slotSizeOf: type) >= 2]) ifFalse:
+ [^FFIErrorWrongType].
+ referentClass := interpreterProxy fetchPointer: 1 ofObject: type.
+ (interpreterProxy includesBehavior: referentClass ThatOf: argClass) ifFalse: [^FFIErrorCoercionFailed].
+ "Get the handle, retrieve the address to which it points, and pass it as a pointer"
+ handle := interpreterProxy fetchPointer: 0 ofObject: oop.
+ ^self ffiPushPointerContentsOf: handle in: calloutState].
+ "allow passing nil pointer for any pointer type"
+ oop == interpreterProxy nilObject ifTrue:[^self ffiPushPointer: nil in: calloutState].
+ ^FFIErrorCoercionFailed!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiPassStructureArgumentByValue:Class:expectedClass:In: (in category 'callout support') -----
+ ffiPassStructureArgumentByValue: oop Class: oopClass expectedClass: argClass In: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+
+ "So we want to pass a Structure by value, which is possible for:
+ - ExternalStructure of expectedClass (or eventually a subclass)
+ - ExternalData (dereferencing the pointer) of expectedClass
+ Every other case is considered unsafe"
+
+ | handle type referentClass |
+ (interpreterProxy includesBehavior: oopClass ThatOf: argClass)
+ ifTrue:
+ ["We passed an object of the expectedClass (or a subclass of it) - pass its handle by value"
+ handle := interpreterProxy fetchPointer: 0 ofObject: oop.
+ ^self ffiPushStructureContentsOf: handle in: calloutState].
+ (interpreterProxy includesBehavior: oopClass ThatOf: interpreterProxy classExternalData)
+ ifTrue:
+ ["Fetch the type specification and check against expectedClass"
+ type := interpreterProxy fetchPointer: 1 ofObject: oop.
+ ((interpreterProxy isPointers: type) and: [(interpreterProxy slotSizeOf: type) >= 2]) ifFalse:
+ [^FFIErrorWrongType].
+ referentClass := interpreterProxy fetchPointer: 1 ofObject: type.
+ (interpreterProxy includesBehavior: referentClass ThatOf: argClass) ifFalse: [^FFIErrorCoercionFailed].
+ "Get the handle and check whether it is a correct pointer spec"
+ handle := interpreterProxy fetchPointer: 0 ofObject: oop.
+ ^self ffiPushStructureContentsOf: handle in: calloutState].
+ "handle other more trivial cases only if we are permissive"
+ ^FFIErrorCoercionFailed!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiPushDereferenceDoubleFloat:in: (in category 'marshalling') -----
+ ffiPushDereferenceDoubleFloat: pointer in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <var: #pointer type: #'void *'>
+ <var: #floatValue type: #double>
+ <inline: true>
+ | floatValue |
+ floatValue := (self self cCoerce: pointer to: #'double *') at: 0.
+ ^self ffiPushDoubleFloat: floatValue in: calloutState!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiPushDereferenceSignedByte:in: (in category 'marshalling') -----
+ ffiPushDereferenceSignedByte: pointer in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <var: #pointer type: #'void *'>
+ <inline: true>
+ | intValue |
+ intValue := (self self cCoerce: pointer to: #'signed char *') at: 0.
+ ^self ffiPushSignedByte: intValue in: calloutState!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiPushDereferenceSignedChar:in: (in category 'marshalling') -----
+ ffiPushDereferenceSignedChar: pointer in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <var: #pointer type: #'void *'>
+ <inline: true>
+ | intValue |
+ intValue := (self self cCoerce: pointer to: #'signed char *') at: 0.
+ ^self ffiPushSignedChar: intValue in: calloutState!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiPushDereferenceSignedInt:in: (in category 'marshalling') -----
+ ffiPushDereferenceSignedInt: pointer in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <var: #pointer type: #'void *'>
+ <inline: true>
+ | intValue |
+ intValue := (self self cCoerce: pointer to: #'int *') at: 0.
+ ^self ffiPushSignedInt: intValue in: calloutState!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiPushDereferenceSignedLongLong:in: (in category 'marshalling') -----
+ ffiPushDereferenceSignedLongLong: pointer in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <var: #pointer type: #'void *'>
+ <var: #intValue type: #sqLong>
+ <inline: true>
+ | intValue |
+ intValue := (self self cCoerce: pointer to: #'sqLong *') at: 0.
+ ^self ffiPushSignedLongLong: intValue in: calloutState!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiPushDereferenceSignedShort:in: (in category 'marshalling') -----
+ ffiPushDereferenceSignedShort: pointer in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <var: #pointer type: #'void *'>
+ <inline: true>
+ | intValue |
+ intValue := (self self cCoerce: pointer to: #'short *') at: 0.
+ ^self ffiPushSignedShort: intValue in: calloutState!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiPushDereferenceSingleFloat:in: (in category 'marshalling') -----
+ ffiPushDereferenceSingleFloat: pointer in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <var: #pointer type: #'void *'>
+ <var: #floatValue type: #double>
+ <inline: true>
+ | floatValue |
+ floatValue := (self self cCoerce: pointer to: #'float *') at: 0.
+ ^self ffiPushSingleFloat: floatValue in: calloutState!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiPushDereferenceUnsignedByte:in: (in category 'marshalling') -----
+ ffiPushDereferenceUnsignedByte: pointer in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <var: #pointer type: #'void *'>
+ <inline: true>
+ | intValue |
+ intValue := (self self cCoerce: pointer to: #'unsigned char *') at: 0.
+ ^self ffiPushUnsignedByte: intValue in: calloutState!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiPushDereferenceUnsignedChar:in: (in category 'marshalling') -----
+ ffiPushDereferenceUnsignedChar: pointer in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <var: #pointer type: #'void *'>
+ <inline: true>
+ | intValue |
+ intValue := (self self cCoerce: pointer to: #'unsigned char *') at: 0.
+ ^self ffiPushUnsignedChar: intValue in: calloutState!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiPushDereferenceUnsignedInt:in: (in category 'marshalling') -----
+ ffiPushDereferenceUnsignedInt: pointer in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <var: #pointer type: #'void *'>
+ <inline: true>
+ | intValue |
+ intValue := (self self cCoerce: pointer to: #'unsigned int *') at: 0.
+ ^self ffiPushUnsignedInt: intValue in: calloutState!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiPushDereferenceUnsignedLongLong:in: (in category 'marshalling') -----
+ ffiPushDereferenceUnsignedLongLong: pointer in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <var: #pointer type: #'void *'>
+ <var: #intValue type: #usqLong>
+ <inline: true>
+ | intValue |
+ intValue := (self self cCoerce: pointer to: #'usqLong *') at: 0.
+ ^self ffiPushUnsignedLongLong: intValue in: calloutState!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiPushDereferenceUnsignedShort:in: (in category 'marshalling') -----
+ ffiPushDereferenceUnsignedShort: pointer in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <var: #pointer type: #'void *'>
+ <inline: true>
+ | intValue |
+ intValue := (self self cCoerce: pointer to: #'unsigned short *') at: 0.
+ ^self ffiPushUnsignedShort: intValue in: calloutState!

Item was added:
+ ----- Method: ThreadedFFIPlugin>>ffiPushDereferenceVoid:in: (in category 'marshalling') -----
+ ffiPushDereferenceVoid: pointer in: calloutState
+ <var: #calloutState type: #'CalloutState *'>
+ <var: #pointer type: #'void *'>
+ "This is a fallback in case somebody tries to pass a 'void' value.
+ We could simply ignore the argument but I think it's better to let
+ the caller know what he did"
+ ^FFIErrorAttemptToPassVoid!

Item was changed:
  ----- Method: ThreadedFFIPlugin>>ffiReturnPointer:ofType:in: (in category 'callout support') -----
  ffiReturnPointer: retVal ofType: retType in: calloutState
  <var: #calloutState type: #'CalloutState *'>
  <var: #retVal type: #usqLong>
  "Generic callout support. Create a pointer return value from an external function call"
+ | retClass atomicType retOop oop ptr |
- | retClass atomicType retOop oop ptr classOop |
  <var: #ptr type: #'sqInt *'>
  retClass := interpreterProxy fetchPointer: 1 ofObject: retType.
  retClass = interpreterProxy nilObject ifTrue:
  ["Create ExternalData upon return"
  atomicType := self atomicTypeOf: calloutState ffiRetHeader.
  (atomicType >> 1) = (FFITypeSignedChar >> 1) ifTrue: "String return"
  [retOop := self ffiReturnCStringFrom: (self cCoerceSimple: retVal to: #usqInt).
+ ^retOop]].
+
+ "generate external data"
+ self remapOop: retType in:
+ [oop := interpreterProxy
+ instantiateClass: interpreterProxy classExternalAddress
+ indexableSize: BytesPerWord.
+ ptr := interpreterProxy firstIndexableField: oop.
+ ptr at: 0 put: (self cCoerceSimple: retVal to: #sqInt).
+ self remapOop: oop in:
+ [retOop := interpreterProxy
+ instantiateClass: interpreterProxy classExternalData
+ indexableSize: 0].
+ interpreterProxy storePointer: 0 ofObject: retOop withValue: oop].
+ interpreterProxy storePointer: 1 ofObject: retOop withValue: retType.
- ^retOop].
- "generate external data"
- self remapOop: retType in:
- [oop := interpreterProxy
- instantiateClass: interpreterProxy classExternalAddress
- indexableSize: BytesPerWord.
- ptr := interpreterProxy firstIndexableField: oop.
- ptr at: 0 put: (self cCoerceSimple: retVal to: #sqInt).
- self remapOop: oop in:
- [retOop := interpreterProxy
- instantiateClass: interpreterProxy classExternalData
- indexableSize: 0].
- interpreterProxy storePointer: 0 ofObject: retOop withValue: oop].
- interpreterProxy storePointer: 1 ofObject: retOop withValue: retType.
- ^retOop].
- "non-atomic pointer return"
- classOop := (calloutState ffiRetHeader anyMask: FFIFlagStructure)
- ifTrue:[interpreterProxy classByteArray]
- ifFalse:[interpreterProxy classExternalAddress].
- self remapOop: retClass in:
- [oop := interpreterProxy
- instantiateClass: classOop
- indexableSize: BytesPerWord].
- ptr := interpreterProxy firstIndexableField: oop.
- ptr at: 0 put: (self cCoerceSimple: retVal to: #sqInt).
- self remapOop: oop in:
- [retOop := interpreterProxy instantiateClass: retClass indexableSize: 0].
- interpreterProxy storePointer: 0 ofObject: retOop withValue: oop.
  ^retOop!