FFI: FFI-Callbacks-mt.20.mcz

Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI:
http://source.squeak.org/FFI/FFI-Callbacks-mt.20.mcz

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

Name: FFI-Callbacks-mt.20
Author: mt
Time: 26 May 2021, 6:46:25.775386 pm
UUID: f8235d1d-8848-d04d-80c9-868dbc5f3f20
Ancestors: FFI-Callbacks-mt.19

Some preparations for code-generation in FFICallback to speed up callback evaluation.

Fixes callback test #test05SortArrayOfPointers.

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

Item was changed:
  ExternalObject subclass: #FFICallback
+ instanceVariableNames: 'abi evaluableObject evaluator thunk argumentTypes resultType'
- instanceVariableNames: 'abi type evaluableObject thunk argumentTypes resultType'
  classVariableNames: 'ThunkToCallbackMap'
  poolDictionaries: ''
  category: 'FFI-Callbacks'!

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 type |
- | byteOffset args intArgs intPos floatArgs floatPos |
 
  handle := callbackContext stackPtr getHandle.
  type := callbackContext stackPtr contentType.
  byteOffset := 1.
 
  intArgs := callbackContext intRegArgs.
  intPos := 0.
  floatArgs := callbackContext floatRegArgs.
  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) Read pointers from register value."
  isPointer ifFalse: ["data is already an integer"] ifTrue: [
  data := (ExternalData
  fromHandle: (ExternalAddress fromInteger: data)
+ type: argType asNonPointerType "contentType") value]]
- type: argType asNonPointerType "contentType" size: 1) value]]
  ifNil: [ "2) If nothing was read, read the argument from the stack."
  data := (argType handle: handle at: byteOffset) value.
  byteOffset := byteOffset
  + ((type byteSize max: argType byteSize) roundUpTo: type byteAlignment)].
 
  args at: argIndex put: data].
 
  ^ self
  setResult: (evaluableObject valueWithArguments: args)
  inContext: callbackContext!

Item was removed:
- ----- Method: FFICallback>>setArgData: (in category 'callback') -----
- setArgData: externalData
-
- handle := externalData getHandle.
- type := externalData contentType. !

Item was changed:
  ----- Method: FFICallback>>setResultType:argumentTypes:evaluableObject: (in category 'initialization') -----
  setResultType: anExternalType argumentTypes: moreExternalTypes evaluableObject: blockOrMessage
 
 
  abi := FFIPlatformDescription current abi.
- handle := nil.
- type := nil.
 
  evaluableObject := blockOrMessage.
  argumentTypes := moreExternalTypes.
  resultType := anExternalType.
 
 
 
 
  "Support for callee pop callbacks (Pascal calling convention such as the Win32 stdcall: convention) are supported using the <calleepops: N> pragma which specifies how many bytes to pop. See http://forum.world.st/Pharo-FFI-on-aarch64-arm64-td5096777.html#a5096786."
  thunk := FFICallbackMemory allocateExecutableBlock.
  self init__ccall.
  "self init__stdcall: 0."
  "(method pragmaAt: #calleepops:)
  ifNil: [self init__ccall]
  ifNotNil: [:pragma | self init__stdcall: (pragma argumentAt: 1)]."
 
  "numEvaluatorArgs := (evaluator := method selector) numArgs.
  self addToThunkTable"
  ThunkToCallbackMap at: thunk getHandle put: self!

Item was changed:
  ----- Method: FFICallback>>valueInContext: (in category 'callback') -----
  valueInContext: callbackContext "<FFICallbackContext> ^<Integer>"
 
+ ^ evaluator
+ ifNil: [self evaluateDynamic: callbackContext]
+ ifNotNil: [evaluator perform: callbackContext]!
- ^ self evaluateDynamic: callbackContext!