[squeak-dev] FFI: FFI-Callbacks-mt.19.mczcommits at source.squeak.org commits at source.squeak.orgWed May 26 16:18:08 UTC 2021
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!
More information about the Squeak-dev mailing list |