FFI Inbox: FFI-Callbacks-mt.8.mcz

A new version of FFI-Callbacks was added to project FFI Inbox:
http://source.squeak.org/FFIinbox/FFI-Callbacks-mt.8.mcz

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

Name: FFI-Callbacks-mt.8
Author: mt
Time: 1 May 2021, 9:32:35.005521 am
UUID: c855a635-3cb2-1543-bb07-5c9d637df03d
Ancestors: FFI-Callbacks-mt.7

In callbacks. resolve one level of indirection so that callbacks can directly work with atomic values or instances of external structures.

This might conflict with the current lack of support for n-ary pointer types.

=============== Diff against FFI-Callbacks-mt.7 ===============

Item was changed:
  ----- Method: FFICallback class>>exampleCqsort (in category 'examples') -----
  exampleCqsort
  "Call the libc qsort function (which requires a callback)."
  "FFICallback exampleCqsort"
  "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0"
 
  | type cb rand nElements sizeofDouble values orig sort libcName knownLibcNames fn |
 
  knownLibcNames := #('libobjc.dylib' 'libgcc_s.1.dylib' 'libc.dylib' 'libc.so.6' 'libc.so' 'msvcrt.dll').
  libcName := Project uiManager chooseFrom: knownLibcNames title: 'Choose your libc'.
  libcName = 0 ifTrue: [^ self].
  libcName := knownLibcNames at: libcName.
 
  rand := Random new.
  type := ExternalType double.
  sizeofDouble := type byteSize.
  nElements := 10.
  values := ExternalData
  fromHandle: (ExternalAddress allocate: nElements * sizeofDouble)
  type: type asPointerType.
  "Initialize external data and set size for enumeration."
  1 to: nElements do: [:i| values at: i put: rand next].
  values size: nElements.
  "Fetch a local copy of the external data."
  orig := values collect: [:each | each].
 
  "Construct the callback structure."
  cb := FFICallback
  signature: '<callback: int (*)(double* double*)>'
  "signature: #(int 'double*' 'double*')"
  block: [ :arg1 :arg2 |
+ Transcript showln: ('Comparing {1} and {2}' format: {arg1. arg2}).
- | a  b |
- a := arg1 doubleAt: 1.
- b := arg2 doubleAt: 1.
- Transcript showln: ('Comparing {1} and {2}' format: {a. b}).
  self halt.
+ (arg1 - arg2) sign].
- (a - b) sign].
 
  "void qsort( void *base, size_t number, size_t width, int (__cdecl *compare )(const void *, const void *) );"
  fn := ExternalLibraryFunction
  name: 'qsort' module: libcName
  callType: ExternalLibraryFunction callTypeCDecl
  returnType: ExternalType void
  argumentTypes: (ExternalType lookupTypes: #('void*' size_t size_t 'void*')).
 
  "Invoke!!"
  fn invokeWith: values "getHandle" with: nElements with: sizeofDouble with: cb thunk "getHandle".
 
  sort := values collect: [:each | each].
  values getHandle free.
  ^orig -> sort!

Item was changed:
  ----- Method: FFICallback class>>exampleCqsortThree (in category 'examples') -----
  exampleCqsortThree
  "Call the libc qsort function (which requires a callback)."
  "
  FFICallback exampleCqsortThree
  "
  "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0"
 
  | type rand nElements sizeofDouble values orig sort cb |
 
  rand := Random new.
  type := ExternalType double.
  sizeofDouble := type byteSize.
  nElements := 10.
  values := ExternalData
  fromHandle: (ExternalAddress allocate: nElements * sizeofDouble)
  type: type asPointerType.
  "Initialize external data and set size for enumeration."
  1 to: nElements do: [:i| values at: i put: rand next].
  values size: nElements.
  "Fetch a local copy of the external data."
  orig := values collect: [:each | each].
 
  "Construct the callback structure."
  cb := FFICallback
  signature: '<callback: int (*)(double* double*)>'
  "signature: #(int 'double*' 'double*')"
  block: [ :arg1 :arg2 |
+ Transcript showln: ('Comparing {1} and {2}' format: {arg1. arg2}).
- | a  b |
- a := arg1 doubleAt: 1.
- b := arg2 doubleAt: 1.
- Transcript showln: ('Comparing {1} and {2}' format: {a. b}).
  self halt.
+ (arg1 - arg2) sign].
- (a - b) sign].
 
 
  "Invoke!!"
  self
  cdeclQsort: values  with: nElements with: sizeofDouble
  with: cb thunk.
 
  sort := values collect: [:each | each].
  values getHandle free.
  ^orig -> sort!

Item was changed:
  ----- Method: FFICallback class>>exampleCqsortTwo (in category 'examples') -----
  exampleCqsortTwo
  "Call the libc qsort function (which requires a callback)."
  "
  FFICallback exampleCqsortTwo
  "
  "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0"
 
  | type rand nElements sizeofDouble values orig sort |
 
  rand := Random new.
  type := ExternalType double.
  sizeofDouble := type byteSize.
  nElements := 10.
  values := ExternalData
  fromHandle: (ExternalAddress allocate: nElements * sizeofDouble)
  type: type asPointerType.
  "Initialize external data and set size for enumeration."
  1 to: nElements do: [:i| values at: i put: rand next].
  values size: nElements.
  "Fetch a local copy of the external data."
  orig := values collect: [:each | each].
 
  "Invoke!!"
  self
  qsort: values  with: nElements with: sizeofDouble
  with:  [ :arg1 :arg2 |
+ Transcript showln: ('Comparing {1} and {2}' format: {arg1. arg2}).
- | a  b |
- a := arg1 doubleAt: 1.
- b := arg2 doubleAt: 1.
- Transcript showln: ('Comparing {1} and {2}' format: {a. b}).
  self halt.
+ (arg1 - arg2) sign].
- (a - b) sign].
 
  sort := values collect: [:each | each].
  values getHandle free.
  ^orig -> sort!

Item was changed:
  ----- Method: FFICallback>>evaluateDynamic: (in category 'callback - evaluators') -----
  evaluateDynamic: callbackContext
  "Read all arguments and make the call(back). Assume that 'handle' and 'type' are set correctly. Only watch out for the sign. See field definition in FFICallbackContext to explore alternative ways to read the arguments."
 
  | byteOffset args intArgs intPos floatArgs floatPos |
 
  handle := callbackContext stackPtr getHandle.
  type := callbackContext stackPtr contentType.
  byteOffset := 1.
 
  intArgs := callbackContext integerArguments.
  intPos := 0.
  floatArgs := callbackContext floatArguments.
  floatPos := 0.
 
  args := Array new: argumentTypes size.
  1 to: args size do: [:argIndex |
  | argType data isPointer |
  argType := argumentTypes at: argIndex.
 
  "1) Try to read arguments from registers."
  data := (intPos < intArgs size and: [(isPointer := argType isPointerType) or: [argType isIntegerType]])
  ifTrue: [intPos := intPos + 1. intArgs at: intPos]
  ifFalse: [(floatPos < floatArgs size and: [argType isFloatType])
  ifTrue: [floatPos := floatPos + 1. floatArgs at: floatPos]].
 
  data
  ifNotNil: [ "1b) Materialize pointers from integers."
  isPointer ifTrue: [
  self flag: #designSmell. "mt: If we had a way to set, for example, double** as container type and double* as content type for intArgs, we would not have to construct the correct external object here but already had it."
- self flag: #discuss. "mt: Should we resolve atomic types? That is, double* to an actual float object etc? Well, for pointers to external structures (unions, ...) it would make sense to provide an actual instance of that structure to the callback... If so, we just need to send #value below."
  data := (ExternalData
  fromHandle: (ExternalAddress fromInteger: data)
+ type: argType) value ]]
- type: argType) size: 1; "value; " yourself]]
  ifNil: [ "2) If nothing was read, read the argument from the stack."
  data := argType handle: handle at: byteOffset.
  byteOffset := byteOffset
  + ((type byteSize max: argType byteSize) roundUpTo: type byteAlignment)].
 
  args at: argIndex put: data].
 
  ^ self
  setResult: (evaluableObject valueWithArguments: args)
  inContext: callbackContext!