Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.195.mcz
==================== Summary ====================
Name: FFI-Kernel-mt.195 Author: mt Time: 11 August 2021, 1:30:23.066115 pm UUID: d9aefbbe-fac7-0145-871f-ac636df7ffe7 Ancestors: FFI-Kernel-mt.194
Fixes bug about "Cannot compute byteAlignment" that occurred when opening an image on one platform that was saved on another.
You can now both use #initialize or #resetAllTypes to update all types when atomics changed. The former preserves object identity, the later needs to be used when changing the amount of atomics or when migrating from a rather old FFI installation.
=============== Diff against FFI-Kernel-mt.194 ===============
Item was changed: ----- Method: ExternalArrayType class>>newTypeForContentType:size: (in category 'instance creation') ----- newTypeForContentType: contentType size: numElements "!!!!!! Be aware that only the pointer type can be used in calls. As of SqueakFFIPrims VMMaker.oscog-eem.2950, there is no actual support for array types in the FFI plugin !!!!!!"
| type pointerType headerWord byteSize | self flag: #contentVsContainer; assert: [contentType isTypeAlias or: [contentType isArrayType not]] description: 'No support for direct multi-dimensional containers yet. Use type aliases.'.
self assert: [contentType isVoid not] description: 'No array types for void type!!'.
self assert: [ (ArrayTypes at: contentType typeName ifPresent: [:sizes | sizes at: numElements ifAbsent: [nil]] ifAbsent: [nil] ) isNil] description: 'Array type already exists. Use #typeNamed: to access it.'.
type := ExternalArrayType basicNew. pointerType := ExternalPointerType basicNew. "1) Regular type" byteSize := numElements ifNil: [0] ifNotNil: [numElements * contentType byteSize]. headerWord := contentType headerWord. headerWord := headerWord bitClear: FFIStructSizeMask. headerWord := headerWord bitOr: (byteSize min: FFIStructSizeMask). type setReferencedType: pointerType; compiledSpec: (WordArray with: headerWord); + byteAlignment: contentType byteAlignment; - byteAlignment: (numElements ifNil: [0] ifNotNil: [contentType byteAlignment]); setReferentClass: nil; "Like atomics and pointers-to-atomics, no dedicated class exists." setContentType: contentType; setSize: numElements; setByteSize: byteSize.
"2) Pointer type. Reuse the compiledSpec of the content-type's pointer type." pointerType setReferencedType: type; + flag: #pointerToArray; compiledSpec: (WordArray with: (self pointerSpec bitOr: FFIFlagAtomic "HACK!! To deceive the FFI plugin :)")); byteAlignment: self pointerAlignment; setReferentClass: nil. "3) Remember this new array type." (ArrayTypes at: contentType typeName ifAbsentPut: [WeakValueDictionary new]) at: numElements put: type. ^ type!
Item was added: + ----- Method: ExternalArrayType>>invalidate (in category 'private') ----- + invalidate + "Preserve size." + + compiledSpec := WordArray with: (self headerWord bitClear: FFIStructSizeMask). + byteAlignment := nil. + byteSize := nil.!
Item was added: + ----- Method: ExternalPointerType>>invalidate (in category 'private') ----- + invalidate + "We can directly initialize this type again." + + self asNonPointerType isArrayType + ifTrue: [ + self flag: #pointerToArray. + compiledSpec := (WordArray with: (self class pointerSpec bitOr: FFIFlagAtomic "HACK!! To deceive the FFI plugin :)")). + byteAlignment := self class pointerAlignment + ] + ifFalse: [ + compiledSpec := WordArray with: self class pointerSpec. + byteAlignment := self class pointerAlignment].!
Item was changed: ----- Method: ExternalStructure class>>allStructuresInCompilationOrder (in category 'system startup') ----- allStructuresInCompilationOrder "Answers a list of all known structure (and packed structures and unions) in ascending order of field compilation." | unordered ordered | self == ExternalStructure ifFalse: [self error: 'Correct compilation order cannot be guaranteed for a partial list of structure classes.']. unordered := self allSubclasses reject: [:ea | ea isSkipped]. ordered := OrderedCollection new: unordered size. [unordered notEmpty] whileTrue: [ | structClass prevStructClass references | structClass := unordered anyOne.
[references := structClass referencedTypeNames. + references := references collect: [:ea | ExternalType parseBasicTypeName: ea]. - references := references collect: [:ea | ea copyWithoutAll: '([0123456789])*']. prevStructClass := unordered detect: [:c | c ~~ structClass and: [references includes: c name]] ifNone: [nil]. prevStructClass isNil] whileFalse: [structClass := prevStructClass].
"we found a structure/alias which does not depend on other structures/aliases" ordered add: (unordered remove: structClass)]. ^ ordered!
Item was added: + ----- Method: ExternalStructureType>>invalidate (in category 'private') ----- + invalidate + "Make this type invalid to be re-initialized. This could happen when platform-characteristics change." + + compiledSpec := WordArray with: self class structureSpec. + byteAlignment := nil.!
Item was added: + ----- Method: ExternalType class>>basicInitializeAtomicTypes (in category 'class initialization') ----- + basicInitializeAtomicTypes + + AtomicTypes ifNil: [ + AtomicTypes := Dictionary new. "Strong references required because there is no lazy atomic type initialization like there is for struct types and array types." + AtomicTypeNames valuesDo: [:typeName | + self newTypeForAtomicNamed: typeName]].!
Item was added: + ----- Method: ExternalType class>>basicInitializeStructureTypes (in category 'class initialization') ----- + basicInitializeStructureTypes + + StructTypes ifNil: [ + StructTypes := WeakValueDictionary new]. + ArrayTypes ifNil: [ + ArrayTypes := Dictionary new].!
Item was added: + ----- Method: ExternalType class>>checkTypeIntegrity (in category 'housekeeping') ----- + checkTypeIntegrity + " + self initialize. + self checkTypeIntegrity. + " + #(atomicTypesDo: atomic structTypesDo: struct pointerTypesDo: pointer arrayTypesDo: array typeAliasTypesDo: alias) + groupsDo: [:enumerator :label | + Transcript showln: ('Checking integrity of {1} types ...' format: { label }). + self perform: enumerator with: [:type | + type compiledSpec ifNil: [Transcript showln: '...', type typeName, ' has invalid compiledSpec!!']. + type byteAlignment ifNil: [Transcript showln: '...', type typeName, ' has invalid byteAlignment!!']]].!
Item was changed: ----- Method: ExternalType class>>initialize (in category 'class initialization') ----- initialize " ExternalType initialize " self initializeFFIConstants. + + self initializeAtomicTypes. + self initializeAtomicSends. + + self initializeStructureTypes. + - self initializeDefaultTypes. self initializeArrayClasses.!
Item was changed: ----- Method: ExternalType class>>initializeAtomicTypes (in category 'class initialization') ----- initializeAtomicTypes + "(Re-)initialize all atomic types. Preserves object identity of all involved types. If the amount of types changed, use #resetAllAtomicTypes instead." + - "Initializes atomic types if not already initialized. NOTE that if you want to reset already initialized atomic types, use #resetAllAtomicTypes instead." - | atomicType byteSize type typeName byteAlignment | self flag: #ffiLongVsInt. "For a discussion about long vs. int see http://forum.world.st/Re-squeak-dev-64-bit-FFI-was-porting-Croquet-to-Squeak...." + + self basicInitializeAtomicTypes. + self invalidateAtomicTypes. #( "name atomic id byte size byte alignment" ('void' 0 0 0) "No non-pointer support in calls. Duh. ;-)" ('bool' 1 1 1) "No pointer support in calls." ('byte' 2 1 1) ('sbyte' 3 1 1) ('ushort' 4 2 2) ('short' 5 2 2) "!!!!!!" ('ulong' 6 4 "!!!!!!" 4) "!!!!!!" ('long' 7 4 "!!!!!!" 4) ('ulonglong' 8 8 8) "v.i." ('longlong' 9 8 8) "v.i." ('char' 10 1 1) ('schar' 11 1 1) ('float' 12 4 4) ('double' 13 8 8) "v.i." "TODO: ('longdouble' 14 10 16? 4?)" ) do:[:typeSpec| | compiled | typeName := typeSpec first. atomicType := typeSpec second. byteSize := typeSpec third. byteAlignment := typeSpec fourth. "0) On 32-bits Windows and MacOS, double and long long have an alignment of 8. But on 32-bit Linux, their alignment is 4. But not on a 32-bit Raspberry Pi OS." (FFIPlatformDescription current wordSize = 4 and: [FFIPlatformDescription current isUnix and: [FFIPlatformDescription current isARM not]]) ifTrue: [ (#('double' 'longlong' 'ulonglong') includes: typeName) ifTrue: [ byteAlignment := 4]]. "1) Regular type" type := (AtomicTypes at: typeName). compiled := WordArray with: ((byteSize bitOr: FFIFlagAtomic) bitOr: (atomicType bitShift: FFIAtomicTypeShift)). compiled ~= type compiledSpec "Preserve the identity of #compiledSpec." ifTrue: [type compiledSpec: compiled]. type byteAlignment: byteAlignment. "2) Pointer type" type := type asPointerType. compiled := WordArray with: ((self pointerSpec bitOr: FFIFlagAtomic) bitOr: (atomicType bitShift: FFIAtomicTypeShift)). compiled ~= type compiledSpec "Preserve the identity of #compiledSpec." ifTrue: [type compiledSpec: compiled]. type byteAlignment: self pointerAlignment. ].!
Item was removed: - ----- Method: ExternalType class>>initializeDefaultTypes (in category 'class initialization') ----- - initializeDefaultTypes - "Initializes atomic types and structure types. NOTE THAT if you want to reset already initialized types, use #resetAllTypes isntead." - - AtomicTypes ifNil: [ - AtomicTypes := Dictionary new. "Strong references required because there is no lazy atomic type initialization like there is for struct types and array types." - AtomicTypeNames valuesDo: [:typeName | - self newTypeForAtomicNamed: typeName]]. - - self initializeAtomicTypes. - self initializeAtomicSends. - self initializeStructureTypes.!
Item was changed: ----- Method: ExternalType class>>initializeStructureTypes (in category 'class initialization') ----- initializeStructureTypes + "(Re-)initialize all structure types and all array types. Preserves object identity of all involved types. If the amount of types changed, use #resetAllStructureTypes instead." - "Reset all non-pointer struct types to zero and their pointer companions to the appropriate pointer size. NOTE THAT if you want to reset already initialized structure types, use #resetAllStructureTypes instead."
+ self basicInitializeStructureTypes. + self invalidateStructureTypes. - StructTypes ifNil: [ - StructTypes := WeakValueDictionary new]. - ArrayTypes ifNil: [ - ArrayTypes := Dictionary new]. + "1) Initialize all array types that have an atomic-or-pointer type as their content type." + self arrayTypesDo: [:arrayType | + (arrayType contentType isAtomic or: [arrayType contentType isPointerType]) ifTrue: [ + arrayType newContentType: arrayType contentType]]. - self cleanupUnusedTypes. + "2) Trigger #noticeModificationOf: callback to actually initialize all structure types." + ExternalStructure defineAllFields. + + "Finally do some garbage collection." + self cleanupUnusedTypes.! - StructTypes valuesDo:[:structType | - structType "asNonPointerType" - compiledSpec: (WordArray with: self structureSpec); - byteAlignment: nil. - structType asPointerType - compiledSpec: (WordArray with: self pointerSpec); - byteAlignment: nil]. - ArrayTypes valuesDo: [:sizes | sizes do: [:arrayType | - arrayType - compiledSpec: (WordArray with: (arrayType headerWord bitClear: FFIStructSizeMask)); - byteAlignment: nil. - arrayType asPointerType - compiledSpec: (WordArray with: self pointerSpec); - byteAlignment: nil]].!
Item was added: + ----- Method: ExternalType class>>invalidateAtomicTypes (in category 'class initialization') ----- + invalidateAtomicTypes + + self atomicTypesDo: [:atomicType | + atomicType "asNonPointerType" invalidate. + atomicType asPointerType invalidate].!
Item was added: + ----- Method: ExternalType class>>invalidateStructureTypes (in category 'class initialization') ----- + invalidateStructureTypes + + self structTypesDo:[:structType | + structType "asNonPointerType" invalidate. + structType asPointerType invalidate]. + + self arrayTypesDo: [:arrayType | + arrayType "asNonPointerType" invalidate. + arrayType asPointerType invalidate].!
Item was changed: ----- Method: ExternalType class>>noticeModificationOf: (in category 'housekeeping') ----- noticeModificationOf: aClass "A subclass of ExternalStructure has been redefined."
aClass withAllSubclassesDo: [:cls | | typeName type | typeName := cls name. (type := StructTypes at: typeName ifAbsent: []) ifNotNil: [ type newReferentClass: cls. type asPointerType newReferentClass: cls. type newTypeAlias]. ArrayTypes at: typeName ifPresent: [:sizes | sizes do: [:arrayType | arrayType ifNotNil: [ arrayType newContentType: type]]]. "Alias-to-array types, which are stored in StructTypes, will not update via #newContentType:. We scan StructTypes for #isArrayType to find such aliases to then call #newContentType:." + self flag: #performance. StructTypes do: [:each | (each notNil and: [each isArrayType and: [each contentType == type]]) ifTrue: [each newContentType: type]]].!
Item was added: + ----- Method: ExternalType class>>parseBasicTypeName: (in category 'instance lookup') ----- + parseBasicTypeName: typeName + "Answers the name of the basic type needed to resolve the given typeName." + + | actualTypeName | + actualTypeName := typeName copyWithoutAll: ' '. + + 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)]. + actualTypeName first == $* "e.g. *DoublePtr" + ifTrue: [actualTypeName := actualTypeName allButFirst]. + + ^ actualTypeName last == $] + ifTrue: [self parseBasicTypeName: (self parseArrayTypeName: actualTypeName) first] + ifFalse: [actualTypeName]!
Item was changed: ----- Method: ExternalType class>>platformChangedFrom:to: (in category 'system startup') ----- platformChangedFrom: lastPlatform to: currentPlatform "Byte size or byte alignment for atomic types might be different on the new platform." "1) Update all atomic types for platform-specifc byte size and alignment." self initializeAtomicTypes. "2) Discard all compiled specs for all structure types." self initializeStructureTypes. + "3) Update all critical aliases for atomic types, i.e., intptr_t, uintptr_t. But what about 'c_long' between 64-bit platforms?!!" - "3) Update all type-name mappings for all FFI calls." lastPlatform wordSize ~= currentPlatform wordSize ifTrue: [self recompileAllLibraryFunctions].!
Item was added: + ----- Method: ExternalType class>>resetAllArrayClasses (in category 'housekeeping') ----- + resetAllArrayClasses + + ArrayClasses := nil. + self initializeArrayClasses.!
Item was changed: ----- Method: ExternalType class>>resetAllAtomicTypes (in category 'housekeeping') ----- resetAllAtomicTypes "Warning: This call is only required if you change the initialization for AtomicTypes."
AtomicTypes := nil. + self initializeAtomicTypes. + AtomicSends := nil. + self initializeAtomicSends. - ArrayClasses := nil. + "Now also reset everything that depends on atomic types." - StructTypes := nil. - ArrayTypes := nil. - - self initializeDefaultTypes. - self initializeArrayClasses. self resetAllStructureTypes.!
Item was changed: ----- Method: ExternalType class>>resetAllStructureTypes (in category 'housekeeping') ----- resetAllStructureTypes "Warning: This call is only required if you change the container for StructTypes!! Note that (2) and (3) can be swapped but that puts unnecessary pressure on the GC."
StructTypes := nil. ArrayTypes := nil. "1) Initialize the container for structure types." self initializeStructureTypes. - - "2) Recompile all FFI calls to create and persist structure types." - self recompileAllLibraryFunctions. + "2) Trigger #noticeModificationOf: callback to actually initialize all structure types." - "3) Update all structure types' spec and alignment." ExternalTypePool reset. + ExternalStructure defineAllFields. "Even if unchanged, we need to fill the type pool." - ExternalStructure defineAllFields. ExternalTypePool cleanUp. + + "3) Recompile all FFI calls to create and persist structure types." + self recompileAllLibraryFunctions. + + "4) Just in case, we also lookup available array classes. Maybe we have one for a specific struct type, right? :-)" + self resetAllArrayClasses. !
Item was changed: ----- Method: ExternalType>>byteAlignment (in category 'accessing') ----- byteAlignment - byteAlignment ifNil: [self computeAlignment]. ^ byteAlignment!
Item was changed: + ----- Method: ExternalType>>byteAlignment: (in category 'private') ----- - ----- Method: ExternalType>>byteAlignment: (in category 'accessing') ----- byteAlignment: anInteger byteAlignment := anInteger!
Item was removed: - ----- Method: ExternalType>>computeAlignment (in category 'private') ----- - computeAlignment - self isPointerType - ifTrue: - [byteAlignment := ExternalType pointerAlignment] - ifFalse: - [byteAlignment := referentClass - ifNil: [self isAtomic - ifTrue: - [byteAlignment ifNil: [ExternalType initialize]. - byteAlignment] - ifFalse: [self error: 'Cannot compute type alignment']] - ifNotNil: - [referentClass byteAlignment]]!
Item was added: + ----- Method: ExternalType>>invalidate (in category 'private') ----- + invalidate + "Make this type invalid to be re-initialized. This could happen when platform-characteristics change." + + compiledSpec := nil. + byteAlignment := nil.!
Item was changed: ----- Method: ExternalUnknownType class>>newTypeForUnknownNamed: (in category 'instance creation') ----- newTypeForUnknownNamed: label | typeName type pointerType | typeName := label asSymbol. self assert: [(StructTypes includesKey: typeName) not] description: 'Type already exists. Use #typeNamed: to access it.'. type := ExternalUnknownType basicNew compiledSpec: (WordArray with: self structureSpec); byteAlignment: 0; "dummy until #newReferentClass: is called" setReferentClass: typeName; yourself. self assert: [type isEmpty]. pointerType := ExternalPointerType basicNew compiledSpec: (WordArray with: self pointerSpec); byteAlignment: self pointerAlignment; yourself. self assert: [pointerType isPointerType].
"Connect non-pointer type with pointer type." type setReferencedType: pointerType. pointerType setReferencedType: type. + "Remember this new struct type, even if still unknown." - "Remember this new struct type." StructTypes at: typeName put: type. ^ type!
Item was added: + ----- Method: ExternalUnknownType>>invalidate (in category 'private') ----- + invalidate + "We can directly initialize this type again." + + compiledSpec := WordArray with: self structureSpec. + byteAlignment := 0.!
squeak-dev@lists.squeakfoundation.org