Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.231.mcz
==================== Summary ====================
Name: FFI-Kernel-mt.231 Author: mt Time: 16 June 2023, 4:39:58.761813 pm UUID: 321ca604-4a55-a64b-bcd6-2643c59bf71a Ancestors: FFI-Kernel-mt.230
Revise FFI-Kernel-eem.227 by using a simple mutex to make #structTypeNamed: thread-safe.
Note that there is still the preference #useTypePool to speed up calls to #externalType. This is only slightly related to type-safety as it introduces strong references even for types not used in any call-out signature.
Also note that it is not problematic if two subsequent calls à la "MyStruct new" work with different temporary type objects as long as their information (e.g., byteAlignment, compiledSpec) is the same.
=============== Diff against FFI-Kernel-mt.230 ===============
Item was changed: ExternalObject subclass: #ExternalStructure instanceVariableNames: '' classVariableNames: 'LogAccessorSourceCode' poolDictionaries: 'ExternalTypePool FFIConstants' category: 'FFI-Kernel'! ExternalStructure class + instanceVariableNames: 'compiledSpec byteAlignment'! - instanceVariableNames: 'compiledSpec byteAlignment externalType'!
!ExternalStructure commentStamp: 'eem 6/26/2019 15:26' prior: 0! An ExternalStructure is for representing external data that is - either a structure composed of different fields (a struct of C language) - or an alias for another type (like a typedef of C language)
It reserves enough bytes of data for representing all the fields.
The data is stored into the handle instance variable which can be of two different types: - ExternalAddress If the handle is an external address then the object described does not reside in the Smalltalk object memory. - ByteArray If the handle is a byte array then the object described resides in Smalltalk memory.
Instance Variables (class side) byteAlignment: <Integer> compiledSpec: <WordArray>
byteAlignment - the required alignment for the structure
compiledSpec - the bit-field definiton of the structure in the ExternalType encoding understood by the VM's FFI call marshalling machinery.
A specific structure is defined by subclassing ExternalStructure and specifying its #fields via a class side method. For example if we define a subclass: ExternalStructure subclass: #StructExample instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'garbage'. Then declare the fields like this: StructExample class compile: 'fields ^#( (name ''char*'') (color ''ulong'') )' classified: 'garbage'.
It means that this type is composed of two different fields: - a string (accessed thru the field #name) - and an unsigned 32bit integer (accessed thru the field #color). It represents the following C type: struct StructExample {char *name; uint32_t color; };
The accessors for those fields can be generated automatically like this: StructExample defineFields. As can be verified in a Browser: StructExample browse. We see that name and color fields are stored sequentially in different zones of data.
The total size of the structure can be verified with: StructExample byteSize = (Smalltalk wordSize + 4).
An ExternalStructure can also be used for defining an alias. The fields definition must contain only 2 elements: an eventual accessor (or nil) and the type. For example, We can define a machine dependent 'unsigned long' like this: ExternalStructure subclass: #UnsignedLong instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'garbage'. Then set the fields like this: UnsignedLong class compile: 'fields ^(Smalltalk wordSize=4 or: [Smalltalk platformName=''Win64'']) ifTrue: [#(nil ''ulong'')] ifFalse: [#(nil ''ulonglong'')]' classified: 'garbage'. And verify the size on current platform: UnsignedLong byteSize. Then, the class names 'UnsignedLong' and 'StructExamples' acts as a type specification. They can be used for composing other types, and for defining prototype of external functions:
LibraryExample>>initMyStruct: aStructExample name: name color: anInteger <cdecl: void 'init_my_struct'( StructExample * char * UnsignedLong )> self externalCallFailed
! ExternalStructure class + instanceVariableNames: 'compiledSpec byteAlignment'! - instanceVariableNames: 'compiledSpec byteAlignment externalType'!
Item was removed: - ----- Method: ExternalStructure class>>addSelectorSilently:withMethod: (in category 'accessing method dictionary') ----- - addSelectorSilently: selector withMethod: compiledMethod - "Override to void the strong reference to the externalType" - self voidExternalType. - ^super addSelectorSilently: selector withMethod: compiledMethod!
Item was changed: ----- Method: ExternalStructure class>>externalType (in category 'external type') ----- externalType + "Return an external type describing the receiver as a structure" + ^ExternalType structTypeNamed: self name! - "Answer an external type describing the receiver as a structure. - Keep a strong reference to it so that it doesn't get garbage collected - from StructTypes immediately." - ^externalType := ExternalType structTypeNamed: self name!
Item was removed: - ----- Method: ExternalStructure class>>removeSelector: (in category 'accessing method dictionary') ----- - removeSelector: selector - "Override to void the strong reference to the externalType" - self voidExternalType. - ^super removeSelector: selector!
Item was removed: - ----- Method: ExternalStructure class>>voidExternalType (in category 'private') ----- - voidExternalType - externalType := nil. - ExternalType voidStructTypeFor: self!
Item was changed: Object subclass: #ExternalType instanceVariableNames: 'compiledSpec referentClass referencedType byteAlignment arrayClass' + classVariableNames: 'ArrayTypes AtomicTypeCodes AtomicTypes ExtraTypeChecks StructTypes StructTypesLock UseArrayClasses UseTypePool' - classVariableNames: 'ArrayTypes AtomicTypeCodes AtomicTypes ExtraTypeChecks StructTypes UseArrayClasses UseTypePool' poolDictionaries: 'ExternalTypePool FFIConstants' category: 'FFI-Kernel'!
!ExternalType commentStamp: 'mt 6/5/2020 18:25' prior: 0! An external type represents the type of external objects.
Instance variables: compiledSpec <WordArray> Compiled specification of the external type referentClass <Behavior | nil> Class type of argument required referencedType <ExternalType> Associated (non)pointer type with the receiver byteAlignment <Integer | nil> The desired alignment for a field of the external type within a structure. If nil it has yet to be computed.
Compiled Spec: The compiled spec defines the type in terms which are understood by the VM. Each word is defined as: bits 0...15 - byte size of the entity bit 16 - structure flag (FFIFlagStructure) This flag is set if the following words define a structure bit 17 - pointer flag (FFIFlagPointer) This flag is set if the entity represents a pointer to another object bit 18 - atomic flag (FFIFlagAtomic) This flag is set if the entity represents an atomic type. If the flag is set the atomic type bits are valid. bits 19...23 - unused bits 24...27 - atomic type (FFITypeVoid ... FFITypeDoubleFloat) bits 28...31 - unused
Note that all combinations of the flags FFIFlagPointer, FFIFlagAtomic, and FFIFlagStructure are invalid, EXCEPT from the following:
FFIFlagPointer + FFIFlagAtomic: This defines a pointer to an atomic type (e.g., 'char*', 'int*'). The actual atomic type is represented in the atomic type bits.
FFIFlagPointer + FFIFlagStructure: This defines a structure which is a typedef of a pointer type as in typedef void* VoidPointer; typedef Pixmap* PixmapPtr; It requires a byte size of four or eight (e.g. a 32-bit or 64-bit pointer) to work correctly.
[Note: Other combinations may be allowed in the future] !
Item was changed: ----- Method: ExternalType class>>newTypeNamed: (in category 'instance creation') ----- newTypeNamed: aTypeName + "Create a new struct type or array type. Not needed for atomic types; see #initializeAtomicTypes." - "Create a new struct type or array type. Not needed for atomic types; see #initializeDefaultTypes." | structClass arraySpec | self assert: [aTypeName last ~~ $*] description: 'Pointer type will be created automatically'. self assert: [aTypeName first ~~ $*] description: 'Non-pointer type for alias-to-pointer types will be created automatically'. aTypeName last == $] ifTrue: [ "array type, e.g., char[50]" arraySpec := self parseArrayTypeName: aTypeName. arraySpec second ifNil: [arraySpec at: 2 put: (self newTypeNamed: arraySpec first)]. ^ self newTypeForContentType: arraySpec second size: arraySpec third]. structClass := (self environment classNamed: aTypeName) ifNotNil: [:class | (class includesBehavior: ExternalStructure) ifTrue: [class]].
^ (structClass isNil or: [structClass isSkipped "i.e., not yet ready, see ExternalTypeAlias"]) ifTrue: [self newTypeForUnknownNamed: aTypeName] ifFalse: [self newTypeForStructureClass: structClass]!
Item was changed: ----- Method: ExternalType class>>structTypeNamed: (in category 'instance lookup') ----- structTypeNamed: typeName + "Thread-safe. Answers the external type for the struct named typeName. If there is no type yet, create a new one but only if typeName can be matched to an existing class in the system already. If you still need a type even if there is no such class present, use #newTypeNamed: to create a type with an unknown referent class." - "Answers the external type for the struct named typeName. If there is no type yet, create a new one but only if typeName can be matched to an existing class in the system already. If you still need a type even if there is no such class present, use #newTypeNamed: to create a type with an unknown referent class." + ^ (StructTypes at: typeName ifAbsent: [nil]) ifNil: [ + (StructTypesLock ifNil: [StructTypesLock := Mutex new]) + critical: [ "Make temporary type creation thread-safe for operations such as 'MyStruct new' called from different processes. Note that if you need better performance and/or strong type references, consider using that type either in a call-out signature (see ExternalLibraryFunction) or enable the preference #useTypePool." + (StructTypes at: typeName ifAbsent: [nil]) ifNil: [ + "Create struct types for existing struct classes on-the-fly." + StructTypes removeKey: typeName ifAbsent: []. + (self environment classNamed: typeName) + ifNotNil: [:cls | (cls includesBehavior: ExternalStructure) ifTrue: [ + self newTypeNamed: typeName]]] ]]! - ^ (StructTypes at: typeName ifAbsent: [nil]) - ifNil: [ "Create struct types for existing struct classes on-the-fly." - StructTypes removeKey: typeName ifAbsent: []. - (self environment classNamed: typeName) - ifNotNil: [:cls | (cls includesBehavior: ExternalStructure) ifTrue: [ - self newTypeNamed: typeName]]]!
Item was changed: ----- Method: ExternalType class>>typeNamed: (in category 'instance lookup') ----- typeNamed: typeName + "Thread-safe. Answer a type object for the given typeName or nil if that name cannot be a type (yet). See commentary in #structTypeNamed:. + Supports pointer-type lookup for both atomic and structure types. - "Supports pointer-type lookup for both atomic and structure types. Examples: 'long', 'long*', 'long *' or 'MyStruct', 'MyStruct*', 'MyStruct *', 'IntPtr', '*IntPtr' " | isPointerType isNonPointerType isArrayType actualTypeName type | isArrayType := false. isNonPointerType := false. actualTypeName := typeName copyWithoutAll: ' '.
(isPointerType := actualTypeName last == $*) "e.g. MyStruct*" ifTrue: [actualTypeName := actualTypeName allButLast]. actualTypeName last == $) "e.g. (char[])* -- pointer type for array type" ifTrue: [actualTypeName := (actualTypeName copyFrom: 2 to: actualTypeName size - 1)]. (isNonPointerType := actualTypeName first == $*) "e.g. *DoublePtr" ifTrue: [actualTypeName := actualTypeName allButFirst].
(isArrayType := actualTypeName last == $]) ifTrue: [ type := self arrayTypeNamed: actualTypeName ] ifFalse: [ (Symbol lookup: actualTypeName) ifNotNil: [:sym | actualTypeName := sym]. type := (self atomicTypeNamed: actualTypeName) ifNil: [self structTypeNamed: actualTypeName]].
^ type ifNotNil: [ isPointerType ifTrue: [type asPointerType "e.g. int* MyStruct* "] ifFalse: [isNonPointerType ifTrue: [type asNonPointerType "e.g. *IntPtr *MyStructPtr "] ifFalse: [type "e.g. int IntPtr MyStruct MyStructPtr "]]]!
Item was removed: - ----- Method: ExternalType class>>voidStructTypeFor: (in category 'housekeeping') ----- - voidStructTypeFor: anExternalStructureClass - (StructTypes associationAt: anExternalStructureClass name ifAbsent: [^self]) value: nil!