Squeak-dev May 2021

squeak-dev@lists.squeakfoundation.org

32 participants
344 discussions

FFI: FFI-Tools-mt.22.mcz
by commits＠source.squeak.org 01 May '21

01 May '21

Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.22.mcz ==================== Summary ==================== Name: FFI-Tools-mt.22 Author: mt Time: 1 May 2021, 6:32:23.937408 pm UUID: 6c3060d1-8b56-c74a-99be-d36a04e838cb Ancestors: FFI-Tools-mt.21 Adds interface to enumerate fields (name and type) in structure types. Use that interface to show more structure in ObjectExplorer on such types. I could not really decide on whether to prepend or append those new fields in the object explorer. For a larger structure type, you might have to scroll down to discover the basic "compiledSpec" etc. ... =============== Diff against FFI-Tools-mt.21 =============== Item was added: + ----- Method: ExternalStructureType>>allTypesDo:seen: (in category '*FFI-Tools-enumerating') ----- + allTypesDo: aBlock seen: seenObjects + "Overridden to support cyclic typedefs." + + (seenObjects ifAbsentAdd: self) ifFalse: [^ self]. + super allTypesDo: aBlock seen: seenObjects.! Item was changed: ----- Method: ExternalStructureType>>explorerContents (in category '*FFI-Tools') ----- explorerContents + | basicExplorerFields originalTypeField fieldTypeFields | - | basicExplorerFields originalTypeField | basicExplorerFields := super explorerContents. + + self isTypeAlias ifTrue: [ + originalTypeField := ObjectExplorerWrapper + with: self originalType + name: '_originalType' + model: self. + ^ {originalTypeField}, basicExplorerFields]. + + fieldTypeFields := Array streamContents: [:s | + self typesDo: [:type :fieldName | + s nextPut: (ObjectExplorerWrapper + with: type + name: (fieldName ifNil: ['__'] ifNotNil: ['_', fieldName]) + model: self)]]. + + ^ fieldTypeFields, basicExplorerFields! - self isTypeAlias ifFalse: [^ basicExplorerFields]. - originalTypeField := ObjectExplorerWrapper - with: self originalType - name: '_originalType' - model: self. - ^ {originalTypeField}, basicExplorerFields! Item was added: + ----- Method: ExternalStructureType>>typesDo: (in category '*FFI-Tools-enumerating') ----- + typesDo: block + + self assert: [self isPointerType not]. + self assert: [self referentClass notNil]. + + (self isTypeAlias + ifTrue: [ + "Add a custom role to emphasize it in #allTypes." + {{#'_aliasFor' . self referentClass fields second}}] + ifFalse: [self referentClass fields]) + do: [:spec | + | fieldName typeName type | + fieldName := spec first. + typeName := spec second. + type := ExternalType typeNamed: typeName. + block cull: type cull: fieldName].! Item was added: + ----- Method: ExternalType>>allTypes (in category '*FFI-Tools-enumerating') ----- + allTypes + + ^ Array streamContents: [:s | + self allTypesDo: [:type :fieldName | + s nextPut: fieldName -> type]]! Item was added: + ----- Method: ExternalType>>allTypesDo: (in category '*FFI-Tools-enumerating') ----- + allTypesDo: block + + self allTypesDo: block seen: IdentitySet new.! Item was added: + ----- Method: ExternalType>>allTypesDo:seen: (in category '*FFI-Tools-enumerating') ----- + allTypesDo: aBlock seen: seenObjects + + self typesDo: [:type :fieldName | + aBlock cull: type cull: fieldName. + type allTypesDo: aBlock seen: seenObjects].! Item was added: + ----- Method: ExternalType>>types (in category '*FFI-Tools-enumerating') ----- + types + + ^ Array streamContents: [:s | + self typesDo: [:type :fieldName | s nextPut: fieldName -> type]]! Item was added: + ----- Method: ExternalType>>typesDo: (in category '*FFI-Tools-enumerating') ----- + typesDo: block + + self isPointerType + ifTrue: [ self asNonPointerType typesDo: block ] + ifFalse: [ "Atomic. There are no more types here." ].!

1 0

FFI: FFI-Kernel-mt.124.mcz
by commits＠source.squeak.org 01 May '21

01 May '21

Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.124.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.124 Author: mt Time: 1 May 2021, 6:29:01.295408 pm UUID: 7c619637-8c9f-5648-b752-5043a9a455c9 Ancestors: FFI-Kernel-mt.123 Removes deprecated collection interface from ExternalData. Nukes unused instVar 'fieldTypes' in structure types. I could not remember what I planned to do with it. Could not find it on squeak-dev either. Extends print-string for external types with byteSize and byteAlignment. It does not look too noisy. I hope it will help remind programmers about the bytes they are working with. Well, if it becomes too noisy, we could make it a preference. =============== Diff against FFI-Kernel-mt.123 =============== Item was removed: - ----- Method: ExternalData>>collectWithIndex: (in category 'enumerating') ----- - collectWithIndex: elementAndIndexBlock - "See SequenceableCollection >> #collectWithIndex:." - - ^ self collectWithIndex: elementAndIndexBlock! Item was removed: - ----- Method: ExternalData>>doWithIndex: (in category 'enumerating') ----- - doWithIndex: elementAndIndexBlock - "See SequenceableCollection >> #doWithIndex:." - - self withIndexDo: elementAndIndexBlock.! Item was changed: ExternalType subclass: #ExternalStructureType + instanceVariableNames: '' - instanceVariableNames: 'fieldTypes' classVariableNames: '' poolDictionaries: '' category: 'FFI-Kernel'! !ExternalStructureType commentStamp: 'mt 6/18/2020 08:54' prior: 0! I am specializing types for external structures. While compiledSpec and referentClass are still paramount when the FFI plugin is processing FFI calls, this specialization can help untangle in-image processing of external structures and their data. In terms of plugin compatibility, you could still use instances of ExternalType as, for example, argument types in ExternalFunction -- given that compiledSpec and referentClass are correct. Argument coercing in FFI calls would still work. However, you could no longer use in-image facilities such as #readFieldAt: / #writeFieldAt:width, which is used for generating struct-field accessors. And the dynamic access through #handle:at: / #handle:at:put: would fail. Also, #printOn: would not be very helpful anymore. So, having this specialization of ExternalType for ExternalStructure helps packaging code. :-) Of course, this type can also be used for ExternalUnion, ExternalPackagedStructure, and ExternalTypeAlias.! Item was changed: ----- Method: ExternalStructureType>>printOn: (in category 'printing') ----- printOn: aStream self isTypeAlias ifTrue: [ aStream nextPutAll: referentClass name. aStream nextPutAll: '~>'; print: self originalType. self isEmpty ifTrue: [aStream nextPutAll: ' ???']. ^ self]. referentClass == nil ifTrue:[aStream nextPutAll: '<unknown struct type>'] ifFalse:[ + super printOn: aStream. - aStream nextPutAll: referentClass name. self isEmpty ifTrue: [aStream nextPutAll: ' { void }']].! Item was changed: ----- Method: ExternalType>>printOn: (in category 'printing') ----- printOn: aStream aStream nextPutAll: (referentClass ifNil: [self atomicTypeName] ifNotNil: [referentClass name]). + self isPointerType ifTrue: [aStream nextPut: $*]. + + aStream + space; + nextPut: $(; + nextPutAll: self byteSize asString; + space; + nextPutAll: self byteAlignment asString; + nextPut: $).! - self isPointerType ifTrue: [aStream nextPut: $*].!

1 0

The Inbox: Morphic-ct.1586.mcz
by commits＠source.squeak.org 01 May '21

01 May '21

A new version of Morphic was added to project The Inbox: http://source.squeak.org/inbox/Morphic-ct.1586.mcz ==================== Summary ==================== Name: Morphic-ct.1586 Author: ct Time: 10 November 2019, 4:06:17.228559 pm UUID: d752eb23-2116-0945-b043-aff08fed94fd Ancestors: Morphic-mt.1584 Proposal: Style printIt results as a pluggable link that can be clicked to inspect the result. To enable this behavior, this commit also extends #insertAndSelect:at: to allow for inserting both strings and texts. =============== Diff against Morphic-mt.1584 =============== Item was changed: ----- Method: PluggableTextMorph>>printIt (in category 'menu commands') ----- printIt | oldEditor | textMorph editor selectFrom: selectionInterval first to: selectionInterval last; model: model. "For, eg, evaluateSelection" textMorph handleEdit: [(oldEditor := textMorph editor) evaluateSelectionAndDo: [:result | selectionInterval := oldEditor selectionInterval. textMorph installEditorToReplace: oldEditor. + textMorph handleEdit: [ oldEditor afterSelectionInsertAndSelect: + (oldEditor printTextFor: result)]. - textMorph handleEdit: [oldEditor afterSelectionInsertAndSelect: result printString]. selectionInterval := oldEditor selectionInterval. textMorph editor selectFrom: selectionInterval first to: selectionInterval last. self scrollSelectionIntoView]]! Item was changed: ----- Method: TextEditor>>afterSelectionInsertAndSelect: (in category 'new selection') ----- + afterSelectionInsertAndSelect: aStringOrText - afterSelectionInsertAndSelect: aString + self insertAndSelect: aStringOrText at: self stopIndex ! - self insertAndSelect: aString at: self stopIndex ! Item was changed: ----- Method: TextEditor>>insertAndSelect:at: (in category 'new selection') ----- + insertAndSelect: aStringOrText at: anInteger - insertAndSelect: aString at: anInteger + aStringOrText isString ifTrue: [ + ^ self + insertAndSelect: (Text string: aStringOrText attributes: emphasisHere) + at: anInteger]. - self closeTypeIn. + self closeTypeIn. self selectInvisiblyFrom: anInteger to: anInteger - 1. self openTypeIn. self replace: self selectionInterval + with: (Text string: ' ' attributes: emphasisHere), aStringOrText - with: (Text string: (' ', aString) attributes: emphasisHere) and: []. - self closeTypeIn.! Item was changed: ----- Method: TextEditor>>printIt (in category 'do-its') ----- printIt self evaluateSelectionAndDo: [:result | (model respondsTo: #printIt:result:) ifTrue: [model perform: #printIt:result: with: self selection with: result] + ifFalse: [self afterSelectionInsertAndSelect: (self printTextFor: result)]]! - ifFalse: [self afterSelectionInsertAndSelect: result printString]]! Item was added: + ----- Method: TextEditor>>printTextFor: (in category 'do-its') ----- + printTextFor: anObject + + ^ Text + string: anObject printString + attributes: {PluggableTextAttribute evalBlock: [anObject inspect]}!

8 34

The Trunk: Monticello-ct.746.mcz
by commits＠source.squeak.org 01 May '21

01 May '21

Marcel Taeumel uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-ct.746.mcz ==================== Summary ==================== Name: Monticello-ct.746 Author: ct Time: 1 May 2021, 2:41:51.667049 pm UUID: 6079f513-f9db-2245-9e92-878ae823e5ee Ancestors: Monticello-nice.745 Fixes and cleans up snapshot creation in MCVersionHistoryBrowser. Instead of scanning the global repository group for a version, ask the current package for its specific repository group. Make sure to always pass the package. Nuke unused instvar repositoryGroup. =============== Diff against Monticello-nice.745 =============== Item was changed: MCTool subclass: #MCVersionHistoryBrowser + instanceVariableNames: 'ancestry index package infos' - instanceVariableNames: 'ancestry index repositoryGroup package infos' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! Item was changed: ----- Method: MCVersionHistoryBrowser>>repositoryGroup (in category 'accessing') ----- repositoryGroup + + ^ self package workingCopy repositoryGroup! - ^ MCRepositoryGroup default! Item was changed: ----- Method: MCVersionInspector>>history (in category 'accessing') ----- history + (MCVersionHistoryBrowser new + package: self version package; + ancestry: self versionInfo) show! - (MCVersionHistoryBrowser new ancestry: self versionInfo) show!

1 0

The Inbox: Monticello-ct.746.mcz
by commits＠source.squeak.org 01 May '21

01 May '21

A new version of Monticello was added to project The Inbox: http://source.squeak.org/inbox/Monticello-ct.746.mcz ==================== Summary ==================== Name: Monticello-ct.746 Author: ct Time: 1 May 2021, 2:41:51.667049 pm UUID: 6079f513-f9db-2245-9e92-878ae823e5ee Ancestors: Monticello-nice.745 Fixes and cleans up snapshot creation in MCVersionHistoryBrowser. Instead of scanning the global repository group for a version, ask the current package for its specific repository group. Make sure to always pass the package. Nuke unused instvar repositoryGroup. =============== Diff against Monticello-nice.745 =============== Item was changed: MCTool subclass: #MCVersionHistoryBrowser + instanceVariableNames: 'ancestry index package infos' - instanceVariableNames: 'ancestry index repositoryGroup package infos' classVariableNames: '' poolDictionaries: '' category: 'Monticello-UI'! Item was changed: ----- Method: MCVersionHistoryBrowser>>repositoryGroup (in category 'accessing') ----- repositoryGroup + + ^ self package workingCopy repositoryGroup! - ^ MCRepositoryGroup default! Item was changed: ----- Method: MCVersionInspector>>history (in category 'accessing') ----- history + (MCVersionHistoryBrowser new + package: self version package; + ancestry: self versionInfo) show! - (MCVersionHistoryBrowser new ancestry: self versionInfo) show!

1 0

FFI Inbox: FFI-Callbacks-mt.10.mcz
by commits＠source.squeak.org 01 May '21

01 May '21

A new version of FFI-Callbacks was added to project FFI Inbox: http://source.squeak.org/FFIinbox/FFI-Callbacks-mt.10.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.10 Author: mt Time: 1 May 2021, 11:01:07.42119 am UUID: f1cd0f2a-9e6b-ec40-9d68-d2a72e0ad829 Ancestors: FFI-Callbacks-mt.9 Maybe, at some point, we will be able to configure blocks as FFI callbacks more conveniently. Here is an example of how to invoke the block with example objects to derive the signature to be used for FFI. (Not working; just a sketch) =============== Diff against FFI-Callbacks-mt.9 =============== Item was added: + ----- Method: BlockClosure>>signature: (in category '*FFI-Callbacks') ----- + signature: signature + + ^ FFICallback + signature: signature + block: self! Item was added: + ----- Method: BlockClosure>>signatureByValue: (in category '*FFI-Callbacks') ----- + signatureByValue: arg1 + + ^ self signatureByValueWithArguments: {arg1}! Item was added: + ----- Method: BlockClosure>>signatureByValue:value: (in category '*FFI-Callbacks') ----- + signatureByValue: arg1 value: arg2 + + ^ self signatureByValueWithArguments: {arg1. arg2}! Item was added: + ----- Method: BlockClosure>>signatureByValue:value:value: (in category '*FFI-Callbacks') ----- + signatureByValue: arg1 value: arg2 value: arg3 + + ^ self signatureByValueWithArguments: {arg1. arg2. arg3}! Item was added: + ----- Method: BlockClosure>>signatureByValue:value:value:value: (in category '*FFI-Callbacks') ----- + signatureByValue: arg1 value: arg2 value: arg3 value: arg4 + + ^ self signatureByValueWithArguments: {arg1. arg2. arg3. arg4}! Item was added: + ----- Method: BlockClosure>>signatureByValue:value:value:value:value: (in category '*FFI-Callbacks') ----- + signatureByValue: arg1 value: arg2 value: arg3 value: arg4 value: arg5 + + ^ self signatureByValueWithArguments: {arg1. arg2. arg3. arg4. arg5}! Item was added: + ----- Method: BlockClosure>>signatureByValueWithArguments: (in category '*FFI-Callbacks') ----- + signatureByValueWithArguments: someObjects + + | result signature | + self flag: #todo. "mt: Consider #wordSize, the use of (non-atomic) ExternalStructure or ExternalData as arguments etc. This unsafe mapping from smalltalk objects ot external types might be related to the ongoing discussion on how to improve type checks in the Squeak FFI plugin. See http://forum.world.st/FFI-Inbox-FFI-Kernel-nice-119-mcz-tp5118848.html" + + result := self valueWithArguments: someObjects. + signature := Array streamContents: [:s | + {result}, someObjects do: [:each | + each isInteger ifTrue: [ s nextPut: 'int32_t' ]. + each isFloat ifTrue: [ s nextPut: 'double' ]. + "..." + ]]. + + self flag: #pointerOrNot. "mt: While it might be hidden in Squeak, the call must now whether to pass the arguments by value or by reference." + self notYetImplemented. + + ^ FFICallback + signature: signature + block: self!

1 0

FFI: FFI-Callbacks-mt.9.mcz
by commits＠source.squeak.org 01 May '21

01 May '21

Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.9.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.9 Author: mt Time: 1 May 2021, 10:24:12.802394 am UUID: 937a46d5-7f6d-9344-8165-515cc5a54b55 Ancestors: FFI-Callbacks-mt.7 Restructure callback examples. Adds a fourth example that sorts integers. Complements FFI-Kernel-mt.123. =============== Diff against FFI-Callbacks-mt.7 =============== Item was removed: - ----- 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 | - | a b | - a := arg1 doubleAt: 1. - b := arg2 doubleAt: 1. - Transcript showln: ('Comparing {1} and {2}' format: {a. b}). - self halt. - (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 added: + ----- 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 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 | + | a b | + a := arg1 doubleAt: 1. + b := arg2 doubleAt: 1. + Transcript showln: ('Comparing {1} and {2}' format: {a. b}). + self halt. + (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 added: + ----- 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 := 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 | + | a b | + a := arg1 doubleAt: 1. + b := arg2 doubleAt: 1. + Transcript showln: ('Comparing {1} and {2}' format: {a. b}). + self halt. + (a - b) sign]. + + sort := values collect: [:each | each]. + values getHandle free. + ^orig -> sort! Item was added: + ----- 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 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 | + | a b | + a := arg1 doubleAt: 1. + b := arg2 doubleAt: 1. + Transcript showln: ('Comparing {1} and {2}' format: {a. b}). + self halt. + (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 added: + ----- 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 signedLongAt: 1. + b := arg2 signedLongAt: 1. + Transcript showln: ('Comparing {1} and {2}' format: {a. b}). + "self halt." + (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". + + out := in collect: [:each | each]. + in free. + ^ out! Item was removed: - ----- 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 | - | a b | - a := arg1 doubleAt: 1. - b := arg2 doubleAt: 1. - Transcript showln: ('Comparing {1} and {2}' format: {a. b}). - self halt. - (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 removed: - ----- 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 | - | a b | - a := arg1 doubleAt: 1. - b := arg2 doubleAt: 1. - Transcript showln: ('Comparing {1} and {2}' format: {a. b}). - self halt. - (a - b) sign]. - - sort := values collect: [:each | each]. - values getHandle free. - ^orig -> sort!

1 0

FFI: FFI-Kernel-mt.123.mcz
by commits＠source.squeak.org 01 May '21

01 May '21

Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.123.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.123 Author: mt Time: 1 May 2021, 10:22:08.119394 am UUID: 8a1725e7-90a1-2348-9e01-3ce391c4036f Ancestors: FFI-Kernel-mt.122 Given that we usually talk to external types or external structures (and unions ...) where #allocate: is the current pattern to prepare a list of such things, use #allocateExternal: to allocate external memory, not internal object memory. While this conflicts with ExternalAddress class #allocate:, clients might not notice because they should usually not deal with the difference between handles being either ByteArray or ExternalAddress (or atomics). I suppose. Let #free for handles being ExternAdress also null that address. Maybe we could establish a common prototype for a null-address? (Removes duplicate #isExternalAddress.) =============== Diff against FFI-Kernel-mt.122 =============== Item was removed: - ----- Method: ByteArray>>isExternalAddress (in category '*FFI-Kernel-testing') ----- - isExternalAddress - "Return true if the receiver describes the address of an object in the outside world" - ^false! Item was added: + ----- Method: ExternalStructure class>>allocateExternal: (in category 'instance creation') ----- + allocateExternal: anInteger + "Create an ExternalData with enough room for storing an array of size anInteger of such structure. Don't forget to free the allocated memory!!!!!!" + ^self externalType allocateExternal: anInteger! Item was changed: ----- Method: ExternalStructure>>free (in category 'initialize-release') ----- free "Free the handle pointed to by the receiver" + + handle isExternalAddress + ifTrue: [handle free; beNull] + ifFalse: [handle := nil].! - (handle ~~ nil and:[handle isExternalAddress]) ifTrue:[handle free]. - handle := nil.! Item was added: + ----- Method: ExternalType>>allocateExternal: (in category 'external data') ----- + allocateExternal: anInteger + "Allocate space for containing an array of size anInteger of this dataType" + + | handle | + handle := ExternalAddress allocate: self byteSize * anInteger. + ^(ExternalData fromHandle: handle type: self) size: anInteger!

1 0

FFI Inbox: FFI-Callbacks-mt.8.mcz
by commits＠source.squeak.org 01 May '21

01 May '21

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!

1 0

FFI: FFI-Callbacks-mt.7.mcz
by commits＠source.squeak.org 01 May '21

01 May '21

Marcel Taeumel uploaded a new version of FFI-Callbacks to project FFI: http://source.squeak.org/FFI/FFI-Callbacks-mt.7.mcz ==================== Summary ==================== Name: FFI-Callbacks-mt.7 Author: mt Time: 1 May 2021, 9:06:54.87419 am UUID: 1094c754-1e24-d342-8822-31dce676cd6a Ancestors: FFI-Callbacks-mt.6 Fixes regression. I forgot to resolve materialize pointers from integers when reading intRegArgs. (For debugging, adds #mostRecent shortcut to FFICallbackContext class.) =============== Diff against FFI-Callbacks-mt.6 =============== 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 data | argType := argumentTypes at: argIndex. "1) Try to read arguments from registers." + data := (intPos < intArgs size and: [(isPointer := argType isPointerType) or: [argType isIntegerType]]) - data := (intPos < intArgs size and: [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) 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)]. - "2) If nothing was read, read the argument from the stack." - data ifNil: [ - 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! Item was added: + ----- Method: FFICallbackContext class>>mostRecent (in category 'instance lookup') ----- + mostRecent + + ^ FFICallbackMemory mostRecentCallbackContext!

1 0

Jump to page: