Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.80.mcz
==================== Summary ====================
Name: FFI-Kernel-mt.80 Author: mt Time: 30 May 2020, 6:39:07.324231 pm UUID: 4750dd07-8701-3146-9348-7a9064273fcf Ancestors: FFI-Kernel-mt.79
Assure that #pointerSize in an external type can never be nil. Make it more clear that #pointerAt:(put:) is just a shortcut to be used for pointer arithmetic (see ExternalAddress >> #+). Struct field methods must be recompiled because of the field alignment. So, emitting #pointerAt:(put:) is of no use at all. Now we emit #(short|long)PointerAt:(put:).
Note that we only support 4-byte and 8-byte pointers. Thus, fail as early as possible if -- at some day -- #wordSize would be bigger than 8.
See discussion on vm-dev: http://forum.world.st/Re-squeak-dev-64-bit-FFI-was-porting-Croquet-to-Squeak...
=============== Diff against FFI-Kernel-mt.79 ===============
Item was changed: ----- Method: ByteArray>>pointerAt: (in category '*FFI-Kernel') ----- pointerAt: byteOffset "Answer a pointer object stored at the given byte address" + + ^ ExternalAddress wordSize caseOf: { + [4] -> [self shortPointerAt: byteOffset]. + [8] -> [self longPointerAt: byteOffset] }! - | addr | - addr := ExternalAddress new. - 1 to: ExternalAddress wordSize do: - [:i| - addr basicAt: i put: (self unsignedByteAt: byteOffset+i-1)]. - ^addr!
Item was changed: ----- Method: ByteArray>>pointerAt:put: (in category '*FFI-Kernel') ----- pointerAt: byteOffset put: value "Store a pointer object at the given byte address" + + ^ ExternalAddress wordSize caseOf: { + [4] -> [self shortPointerAt: byteOffset put: value]. + [8] -> [self longPointerAt: byteOffset put: value] }! - value isExternalAddress ifFalse: - [^self error:'Only external addresses can be stored']. - 1 to: ExternalAddress wordSize do: - [:i| - self unsignedByteAt: byteOffset+i-1 put: (value basicAt: i)]. - ^value!
Item was changed: ----- Method: ExternalStructure class>>compileFields:withAccessors: (in category 'field definition') ----- compileFields: specArray withAccessors: aSymbol "Compile a type specification for the FFI machinery. Return the newly compiled spec. Eventually generate the field accessors according to following rules: - aSymbol = #always always generate the accessors - aSymbol = #never never generate the accessors - aSymbol = #generated only generate the auto-generated accessors - aSymbol = #absent only generate the absent accessors" | newByteAlignment byteOffset typeSpec newCompiledSpec | (specArray size > 0 and: [specArray first class ~~ Array]) ifTrue: [^ self compileAlias: specArray withAccessors: aSymbol]. byteOffset := 0. newByteAlignment := self minStructureAlignment. typeSpec := WriteStream on: (WordArray new: 10). typeSpec nextPut: FFIFlagStructure. "dummy for size" specArray do: [:spec | | fieldName fieldType isPointerField externalType typeSize fieldAlignment selfRefering | fieldName := spec first. fieldType := spec second. isPointerField := fieldType last = $*. fieldType := (fieldType findTokens: '*') first withBlanksTrimmed. externalType := ExternalType atomicTypeNamed: fieldType. selfRefering := isPointerField and: [externalType isNil and: [fieldType = self asString]]. selfRefering ifTrue: [ externalType := ExternalType void asPointerType ] ifFalse:[ + externalType ifNil: ["non-atomic" + (Symbol lookup: fieldType) ifNotNil: [:sym | + externalType := ExternalType structTypeNamed: sym]. - externalType == nil ifTrue: ["non-atomic" - Symbol - hasInterned: fieldType - ifTrue: [:sym | externalType := ExternalType structTypeNamed: sym]. ]. + externalType ifNil: [ - externalType == nil ifTrue:[ Transcript show: '(' , fieldType , ' is void)'. externalType := ExternalType void. ]. + isPointerField ifTrue: [externalType := externalType asPointerType]]. - isPointerField ifTrue: [externalType := externalType asPointerType: self pointerSize]]. typeSize := externalType byteSize. fieldAlignment := (externalType byteAlignment max: self minFieldAlignment) min: self maxFieldAlignment. byteOffset := byteOffset alignedTo: fieldAlignment. newByteAlignment := newByteAlignment max: fieldAlignment. spec size > 2 ifTrue: ["extra size" spec third < typeSize ifTrue: [^ self error: 'Explicit type size is less than expected']. typeSize := spec third. ]. (fieldName notNil and: [self shouldGenerate: fieldName policy: aSymbol]) ifTrue: [ self defineFieldAccessorsFor: fieldName startingAt: byteOffset + 1 type: externalType. ]. typeSpec nextPutAll: (externalType embeddedSpecWithSize: typeSize). byteOffset := byteOffset + typeSize. ]. newByteAlignment := newByteAlignment min: self maxStructureAlignment. byteOffset := byteOffset alignedTo: newByteAlignment. newCompiledSpec := typeSpec contents. newCompiledSpec at: 1 put: (byteOffset bitOr: FFIFlagStructure). byteAlignment := newByteAlignment. ^ newCompiledSpec!
Item was removed: - ----- Method: ExternalStructure class>>pointerSize (in category 'accessing') ----- - pointerSize - "Answer the size of pointers for this class. By default answer nil. - Subclasses that contain pointers must define the size of a pointer if the code is to operate on 64-bit and 32-bit platforms. - Currently we have no way of converting a type between 32- and 64- bit versions beyond recompiling it." - ^nil!
Item was changed: Object subclass: #ExternalType + instanceVariableNames: 'compiledSpec referentClass referencedType byteAlignment' - instanceVariableNames: 'compiledSpec referentClass referencedType pointerSize byteAlignment' classVariableNames: 'AtomicSelectors AtomicTypeNames AtomicTypes StructTypes' poolDictionaries: 'FFIConstants' category: 'FFI-Kernel'!
!ExternalType commentStamp: 'eem 6/25/2019 10:39' 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 pointerSize <Integer | nil> The size of a pointer if the external type is a pointer or is a structure containing a pointer. 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 removed: - ----- Method: ExternalType>>asPointerType: (in category 'converting') ----- - asPointerType: anotherPointerSize - "convert the receiver into a pointer type" - | type | - type := self asPointerType. - ^type pointerSize = anotherPointerSize - ifTrue: [type] - ifFalse: - [type copy pointerSize: anotherPointerSize; yourself]!
Item was changed: ----- Method: ExternalType>>pointerSize (in category 'accessing') ----- pointerSize + + ^ self asPointerType headerWord bitAnd: FFIStructSizeMask! - "Answer the pointer size of the receiver, if specified." - ^pointerSize!
Item was changed: ----- Method: ExternalType>>readFieldAt: (in category 'private') ----- readFieldAt: byteOffset "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset. Private. Used for field definition only." self isPointerType ifTrue: [| accessor | accessor := self pointerSize caseOf: { - [nil] -> [#pointerAt:]. [4] -> [#shortPointerAt:]. [8] -> [#longPointerAt:] }. ^String streamContents: [:s| referentClass ifNil: [s nextPutAll: '^ExternalData fromHandle: (handle ', accessor, ' '; print: byteOffset; nextPutAll: ') type: ExternalType '; nextPutAll: (AtomicTypeNames at: self atomicType); nextPutAll: ' asPointerType'] ifNotNil: [s nextPutAll: '^'; print: referentClass; nextPutAll: ' fromHandle: (handle ', accessor, ' '; print: byteOffset; nextPut: $)]]].
self isAtomic ifFalse: "structure type" [^String streamContents:[:s| s nextPutAll:'^'; print: referentClass; nextPutAll:' fromHandle: (handle structAt: '; print: byteOffset; nextPutAll:' length: '; print: self byteSize; nextPutAll:')']].
"Atomic non-pointer types" ^String streamContents: [:s| s nextPutAll:'^handle '; nextPutAll: (AtomicSelectors at: self atomicType); space; print: byteOffset].!
Item was changed: ----- Method: ExternalType>>writeFieldAt:with: (in category 'private') ----- writeFieldAt: byteOffset with: valueName "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset. Private. Used for field definition only." self isPointerType ifTrue: [| accessor | accessor := self pointerSize caseOf: { - [nil] -> [#pointerAt:]. [4] -> [#shortPointerAt:]. [8] -> [#longPointerAt:] }. ^String streamContents: [:s| s nextPutAll:'handle ', accessor, ' '; print: byteOffset; nextPutAll:' put: '; nextPutAll: valueName; nextPutAll:' getHandle.']].
self isAtomic ifFalse:[ ^String streamContents:[:s| s nextPutAll:'handle structAt: '; print: byteOffset; nextPutAll:' put: '; nextPutAll: valueName; nextPutAll:' getHandle'; nextPutAll:' length: '; print: self byteSize; nextPutAll:'.']].
^String streamContents:[:s| s nextPutAll:'handle '; nextPutAll: (AtomicSelectors at: self atomicType); space; print: byteOffset; nextPutAll:' put: '; nextPutAll: valueName].!
Item was changed: ----- Method: ExternalUnion class>>compileFields:withAccessors: (in category 'field definition') ----- compileFields: specArray withAccessors: aSymbol "Compile a type specification for the FFI machinery. Return the newly compiled spec. Eventually generate the field accessors according to the policy defined in aSymbol." | byteOffset maxByteSize typeSpec newCompiledSpec newByteAlignment | (specArray size > 0 and: [specArray first class ~~ Array]) ifTrue: [^ self error: 'unions must have fields defined by sub-Array']. byteOffset := 1. newByteAlignment := 1. maxByteSize := 0. typeSpec := WriteStream on: (WordArray new: specArray size + 1). typeSpec nextPut: FFIFlagStructure. "dummy for size" specArray do: [:spec | | fieldName fieldType isPointerField externalType typeSize typeAlignment selfRefering | fieldName := spec first. fieldType := spec second. isPointerField := fieldType last = $*. fieldType := (fieldType findTokens: '*') first withBlanksTrimmed. externalType := ExternalType atomicTypeNamed: fieldType. selfRefering := isPointerField and: [externalType isNil and: [fieldType = self asString]]. selfRefering ifTrue: [ externalType := ExternalType void asPointerType ] ifFalse:[ + externalType ifNil: ["non-atomic" + (Symbol lookup: fieldType) ifNotNil: [:sym | + externalType := ExternalType structTypeNamed: sym]. - externalType == nil ifTrue: ["non-atomic" - Symbol - hasInterned: fieldType - ifTrue: [:sym | externalType := ExternalType structTypeNamed: sym]. ]. + externalType ifNil: [ - externalType == nil ifTrue:[ Transcript show: '(' , fieldType , ' is void)'. externalType := ExternalType void. ]. + isPointerField ifTrue: [externalType := externalType asPointerType]]. - isPointerField ifTrue: [externalType := externalType asPointerType: self pointerSize]]. typeSize := externalType byteSize. typeAlignment := externalType byteAlignment. spec size > 2 ifTrue: ["extra size" spec third < typeSize ifTrue: [^ self error: 'Explicit type size is less than expected']. typeSize := spec third. ]. (fieldName notNil and: [self shouldGenerate: fieldName policy: aSymbol]) ifTrue: [ self defineFieldAccessorsFor: fieldName startingAt: byteOffset type: externalType. ]. typeSpec nextPutAll: (externalType embeddedSpecWithSize: typeSize). maxByteSize := maxByteSize max: typeSize. newByteAlignment := newByteAlignment max: typeAlignment ]. maxByteSize := maxByteSize alignedTo: newByteAlignment. newCompiledSpec := typeSpec contents. newCompiledSpec at: 1 put: (maxByteSize bitOr: FFIFlagStructure). byteAlignment := newByteAlignment. ^ newCompiledSpec!
Item was changed: (PackageInfo named: 'FFI-Kernel') postscript: 'Smalltalk removeFromStartUpList: ExternalAddress. + Smalltalk removeFromStartUpList: ExternalObject. + + "Since #pointerSize in ExternalType is never nil anymore, make the code generated for fields more specific, i.e., #shortPointerAt:(put:) or #longPointerAt:(put:). + ExternalStructure withAllSubclassesDo: [:cls | cls defineFields]. + '! - Smalltalk removeFromStartUpList: ExternalObject.'!