FFI: FFI-Callbacks-mt.19.mcz

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

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

Name: FFI-Callbacks-mt.19
Author: mt
Time: 26 May 2021, 6:18:08.303788 pm
UUID: 07f5dc26-d1f1-6549-932e-42693011e920
Ancestors: FFI-Callbacks-mt.18

Adds callback-convenience for bsearch and qsort, which also serve as commentary and examples for other callbacks. Complements FFI-Kernel-mt.171.

Moves qsort examples to new FFI-CallbacksTests package.

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

Item was added:
+ ----- Method: BlockClosure>>signature: (in category '*FFI-Callbacks') -----
+ signature: signature
+
+ ^ FFICallback
+ signature: signature
+ block: self!

Item was added:
+ ----- Method: CStandardLibrary>>bsearch:in:compare: (in category '*FFI-Callbacks') -----
+ bsearch: key in: array compare: block
+
+ | result |
+ result := self
+ bsearch: key
+ with: array
+ with: array size
+ with: array contentType byteSize
+ with: (self compare: array contentType through: block) thunk.
+ result
+ setContentType: array contentType;
+ setSize: 1.
+ ^ result!

Item was added:
+ ----- Method: CStandardLibrary>>compare:through: (in category '*FFI-Callbacks') -----
+ compare: contentType through: evaluable
+ "Answers a callback for comparing the given contentType through the given evaluable, i.e., messages sends or blocks. Supports pointer types as contentType."
+
+ <callback: int32_t (*)(const void*, const void*)>
+
+ | argType signature |
+ self assert: [evaluable numArgs = 2].
+
+ argType := contentType isPointerType
+ ifTrue: [(contentType asArrayType: nil)]
+ ifFalse: [contentType].
+
+ signature := ((thisContext method pragmaAt: #callback:) argumentAt: 1) copy.
+ signature at: 2 put: argType asPointerType.
+ signature at: 3 put: argType asPointerType.
+
+ ^ evaluable signature: signature!

Item was added:
+ ----- Method: CStandardLibrary>>qsort:compare: (in category '*FFI-Callbacks') -----
+ qsort: array compare: block
+
+ ^ self
+ qsort: array
+ with: array size
+ with: array contentType byteSize
+ with: (self compare: array contentType through: block) thunk!

Item was removed:
- ----- Method: FFICallback class>>cdeclQsort:with:with:with: (in category 'examples') -----
- cdeclQsort: values with: number with: width with: callback
-
- <cdecl: void 'qsort' (void* size_t size_t void*) module: 'msvcrt.dll'>
- ^ self externalCallFailed!

Item was removed:
- ----- Method: FFICallback class>>exampleCqsort01 (in category 'examples') -----
- exampleCqsort01
- "Call the libc qsort function (which requires a callback)."
- "FFICallback exampleCqsort01"
- "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0"
-
- | type cb rand nElements 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.
- nElements := 10.
- values := type allocateExternal: nElements.
- "Initialize external data and set size for enumeration."
- 1 to: nElements do: [:i| values at: i put: rand next].
- "Fetch a local copy of the external data."
- orig := values copy.
-
- "Construct the callback structure."
- cb := FFICallback
- signature: '<callback: int (*)(double* double*)>'
- "signature: #(int 'double*' 'double*')"
- block: [ :arg1 :arg2 |
- | a  b |
- a := arg1.
- b := arg2.
- (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: type byteSize
- with: cb thunk "getHandle".
-
- sort := values collect: [:each | each].
- values free.
- ^orig -> sort!

Item was removed:
- ----- Method: FFICallback class>>exampleCqsort02 (in category 'examples') -----
- exampleCqsort02
- "Call the libc qsort function (which requires a callback)."
- "
- FFICallback exampleCqsort02
- "
- "(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 := type allocateExternal: nElements.
- "Initialize external data and set size for enumeration."
- 1 to: nElements do: [:i| values at: i put: rand next].
-
- "Fetch a local copy of the external data."
- orig := values copy.
-
- "Invoke!!"
- self
- qsort: values  with: values size with: values contentType byteSize
- with:  [ :arg1 :arg2 |
- | a  b |
- a := arg1.
- b := arg2.
- (a - b) sign].
-
- sort := values copy.
- values free.
- ^orig -> sort!

Item was removed:
- ----- Method: FFICallback class>>exampleCqsort03 (in category 'examples') -----
- exampleCqsort03
- "Call the libc qsort function (which requires a callback)."
- "
- FFICallback exampleCqsort03
- "
- "(Time millisecondsToRun: [100 timesRepeat: [FFICallback exampleCqsort]]) / 100.0"
-
- | type rand nElements values orig sort cb |
-
- rand := Random new.
- type := ExternalType double.
- nElements := 10.
- values := type allocateExternal: nElements.
- "Initialize external data and set size for enumeration."
- 1 to: nElements do: [:i| values at: i put: rand next].
-
- "Fetch a local copy of the external data."
- orig := values copy.
-
- "Construct the callback structure."
- cb := FFICallback
- signature: '<callback: int (*)(double* double*)>'
- "signature: #(int 'double*' 'double*')"
- block: [ :arg1 :arg2 |
- | a  b |
- a := arg1.
- b := arg2.
- (a - b) sign].
-
-
- "Invoke!!"
- self
- cdeclQsort: values  with: values size with: values contentType byteSize
- with: cb thunk.
-
- sort := values collect: [:each | each].
- values free.
- ^orig -> sort!

Item was removed:
- ----- Method: FFICallback class>>exampleCqsort04 (in category 'examples') -----
- exampleCqsort04
- "
- FFICallback exampleCqsort04
- "
-
- | type in out fn cb |
- type := ExternalType int32_t.
- in := type allocateExternal: 10.
- 1 to: in size do: [:each |
- in at: each put: 100 atRandom].
-
- cb := FFICallback
- signature: '<callback: int (*)(int32_t* int32_t*)>'
- "signature: #(int 'double*' 'double*')"
- block: [ :arg1 :arg2 |
- | a  b |
- a := arg1.
- b := arg2.
- (a - b) sign].
-
- fn := ExternalLibraryFunction
- name: 'qsort' module: 'msvcrt.dll'
- callType: ExternalLibraryFunction callTypeCDecl
- returnType: ExternalType void
- argumentTypes: (ExternalType lookupTypes: #('void*' size_t size_t 'void*')).
-
- "Invoke!!"
- [fn
- invokeWith: in "getHandle"
- with: in size
- with: in contentType byteSize
- with: cb thunk "getHandle"]
- ifCurtailed: [in free].
-
- out := in copy.
- in free.
- ^ out!

Item was removed:
- ----- Method: FFICallback class>>qsort:with:with:with: (in category 'examples') -----
- qsort: values with: number with: width with: block
- "Indirection to define the signature for the provided block."
- <callback: int (*)(double* double*)>
-
- | callback |
- callback := FFICallback
- signature: ((thisContext method pragmaAt: #callback:) argumentAt: 1)
- block: block.
-
- ^ self cdeclQsort: values with: number with: width with: callback thunk!