FFI: FFI-Callbacks-mt.2.mcz

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

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

Name: FFI-Callbacks-mt.2
Author: mt
Time: 18 June 2020, 1:26:27.021543 pm
UUID: 4baf5374-6606-fb49-876a-f097fdf20b57
Ancestors: FFI-Callbacks-mt.1

Improves basic logic of #evaluateDynamic:. Still needs either some ABI-specific rules to dynamically dispatch, e.g., floats into floatRegArgs or support for calling other evaluator methods if present to manually read the arguments.

Also fixes initial package loading by adding the missing #lookupTypes: and comment-out the example signatures for now.

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

Item was added:
+ ----- Method: ExternalType class>>lookupTypes: (in category '*FFI-Callbacks') -----
+ lookupTypes: signature
+ "
+ Supported arguments:
+ '<callback: int (*) (double* double*)>' ... pragma as string
+ #(int 'double*' 'double*') ... array with type names
+ { ExternalType int. ExternalType double asPointerType. ExternalType double asPointerType } ... array with external types
+ "
+
+ (signature isString and: [signature first == $<]) ifTrue: [
+ ^ (Parser new parse: 'foo', String cr, signature class: Object)
+ properties pragmas first argumentAt: 1].
+
+ signature first isString ifTrue: [
+ ^ signature collect: [:typeName | self typeNamed: typeName]].
+
+ signature first class == ExternalType ifTrue: [
+ ^ signature].
+
+ self error: 'Could not lookup external types from signature'.!

Item was changed:
  ----- Method: FFICallback class>>getIntWithData:withData: (in category 'examples - signatures') -----
  getIntWithData: anExternalData1 withData: anExternalData2
  "
  (FFICallback class >> #getIntWithData:withData:) pragmaAt: #callback:
  "
+ "<callback: int (*)(void* void*)>"
- <callback: int (*)(void* void*)>
 
  self shouldNotImplement.!

Item was changed:
  ----- Method: FFICallback class>>getIntWithData:withData:withInt:withInt: (in category 'examples - signatures') -----
  getIntWithData: anExternalData1 withData: anExternalData2 withInt: anInteger1 withInt: anInteger2
  "
  (FFICallback class >> #getIntWithData:withData:withInt:withInt:) pragmaAt: #callback:
  "
+ "<callback: int (*)(void* void* uint32_t intptr_t)>"
- <callback: int (*)(void* void* uint32_t intptr_t)>
 
  self shouldNotImplement.
 
 
  self flag: #todo: "Ignore macros, const, and '*,' comma"
  "<signature: #(int CALLBACK (*)(const LOGFONT *, const TEXTMETRIC *, DWORD, LPARAM))>"
  !

Item was changed:
  ----- Method: FFICallback class>>getIntWithInt:withString: (in category 'examples - signatures') -----
  getIntWithInt: anInteger withString: aString
  "
  (FFICallback class >> #getIntWithInt:withString:) pragmaAt: #callback:
  "
+ "<callback: int (*)(int char *)>"
- <callback: int (*)(int char *)>
 
  self shouldNotImplement.!

Item was changed:
  ----- Method: FFICallback class>>getVoidWithData:withDouble:withDouble: (in category 'examples - signatures') -----
  getVoidWithData: anExternalData withDouble: aFloat withDouble: anotherFloat
  "
  (FFICallback class >> #getVoidWithData:withDouble:withDouble:) pragmaAt: #callback:
  "
+ "<callback: void (*)(void* double double)>"
- <callback: void (*)(void* double double)>
 
  self shouldNotImplement.!

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."
 
  | offset args |
  offset := 1.
  args := Array new: argTypes size - 1. "Skip return type"
 
  1 to: args size do: [:argIndex |
+ | argType data |
- | argType unsigned data |
  argType := argTypes at: argIndex + 1. "Skip return type"
 
  argType isPointerType
  ifTrue: [
  data := (type handle: handle at: offset).
 
  argType referentClass "pointer to atomic"
  ifNil: [data := data asType: argType]
  ifNotNil: [:structClass | "pointer to external structure or union"
  argType isTypeAliasToPointer
  ifTrue: [data := structClass fromHandle: data getHandle asByteArrayPointer]
  ifFalse: [data := structClass fromHandle: data getHandle]] ]
  ifFalse: [ "non-pointer type"
  self flag: #floats. "mt: When should we switch to callbackContext floatRegArgs?"
+ data := argType handle: handle at: offset.
- self flag: #todo. "mt: How to make boolean out of integer here? Would it work with floats, too?"
- unsigned := argType isIntegerType ==> [argType isUnsigned].
- data := unsigned
- ifTrue: [type asUnsigned handle: handle at: offset]
- ifFalse: [type asSigned handle: handle at: offset].
 
  argType isAtomic
  ifFalse: ["structure type, most likely type alias to pointer"
  data := argType referentClass
  fromHandle: (ExternalAddress fromInteger: data) asByteArrayPointer]
  ifTrue: [ argType isTypeAlias
  ifTrue: [ "alias to atomic type"
  data := argType referentClass fromHandle: data]
  ifFalse: [ "atomic, non-pointer type"
  data := data ";-)"]] ].
+
-
  args at: argIndex put: data.
+ offset := offset + ((type byteSize max: argType byteSize) roundUpTo: type byteSize)].
- offset := offset + type byteSize].
 
  ^ self
  setResult: (evaluableObject valueWithArguments: args)
  inContext: callbackContext.!

Item was changed:
  ----- Method: FFICallback>>setArgTypes:evaluableObject: (in category 'initialization') -----
  setArgTypes: externalTypes evaluableObject: blockOrMessage
 
 
  abi := FFIPlatformDescription current abi.
  handle := nil.
  type := nil.
 
  evaluableObject := blockOrMessage.
  argTypes := externalTypes.
 
 
 
 
 
  "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!