Squeak-dev June 2020

squeak-dev@lists.squeakfoundation.org

43 participants
346 discussions

FFI: FFI-Kernel-mt.84.mcz
by commits＠source.squeak.org 01 Jun '20

01 Jun '20

Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.84.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.84 Author: mt Time: 1 June 2020, 10:11:15.683523 am UUID: f479d8e8-50e0-9c45-96f5-38138001b6c4 Ancestors: FFI-Kernel-mt.83 Moves more C code generation for typedefs to FFI-Tools package, because it is a debugging tool and not required to keep FFI working. =============== Diff against FFI-Kernel-mt.83 =============== Item was removed: - ----- Method: ExternalStructure class>>typedef (in category 'converting') ----- - typedef - ^self externalType typedef!

1 0

FFI: FFI-Tools-mt.6.mcz
by commits＠source.squeak.org 01 Jun '20

01 Jun '20

Marcel Taeumel uploaded a new version of FFI-Tools to project FFI: http://source.squeak.org/FFI/FFI-Tools-mt.6.mcz ==================== Summary ==================== Name: FFI-Tools-mt.6 Author: mt Time: 1 June 2020, 10:07:54.246523 am UUID: ecaa6159-1abb-7f4f-b725-22098f843230 Ancestors: FFI-Tools-mt.5 Complements FFI-Kernel-mt.83. =============== Diff against FFI-Tools-mt.5 =============== Item was added: + ----- Method: ExternalType>>printAtomicType:on: (in category '*FFI-Tools-printing') ----- + printAtomicType: spec on: aStream + self assert: (spec anyMask: FFIFlagAtomic). + aStream nextPutAll: (#( 'void' 'unsigned char' 'unsigned char' 'signed char' + 'unsigned short' 'short' 'unsigned long' 'long' + 'unsigned long long' 'long long' 'char' 'signed char' + 'float' 'double') at: ((spec bitAnd: FFIAtomicTypeMask) bitShift: FFIAtomicTypeShift negated) + 1). + aStream space. + (spec anyMask: FFIFlagPointer) ifTrue: + [aStream nextPut: $*]! Item was added: + ----- Method: ExternalType>>printStructureField:at:inClass:on:indent: (in category '*FFI-Tools-printing') ----- + printStructureField: typeTuple at: initialSpecIndex inClass: structureClass on: aStream indent: indent + "Print the structure's field starting at initialSpecIndex and answer the index in compiledSpec of the subsequent type." + | typeName spec subStructureClass | + aStream tab: indent. + typeName := typeTuple first. + spec := compiledSpec at: initialSpecIndex. + (spec anyMask: FFIFlagAtomic) ifTrue: + [self printAtomicType: spec on: aStream. + aStream nextPutAll: (typeName ifNotNil: [typeName] ifNil: ['foo']). + ^initialSpecIndex + 1]. + subStructureClass := self subStructureClassFor: typeName in: structureClass. + (spec bitClear: FFIStructSizeMask) = FFIFlagStructure ifTrue: + [| next | + next := initialSpecIndex + 1. + aStream + nextPutAll: subStructureClass compositeKindName; + nextPutAll: ' {'. + subStructureClass fields withIndexDo: + [:tuple :i| + aStream cr. + next := self printStructureField: tuple + at: next + inClass: subStructureClass + on: aStream + indent: indent + 1. + aStream nextPut: $;]. + aStream crtab: indent; nextPut: $}. + typeName ifNotNil: [aStream space; nextPutAll: typeName]. + self assert: (next - 1 = compiledSpec size or: [(compiledSpec at: next) = FFIFlagStructure]). + ^next <= compiledSpec size ifTrue: [next + 1] ifFalse: [next]]. + self assert: (spec anyMask: FFIFlagPointer). + (subStructureClass isKindOf: ExternalUnion) + ifTrue: [aStream nextPutAll: 'union '] + ifFalse: [aStream nextPutAll: 'struct ']. + aStream nextPutAll: subStructureClass name; nextPutAll: ' *'; nextPutAll: typeName. + ^initialSpecIndex + 1! Item was added: + ----- Method: ExternalType>>printTypedefOn: (in category '*FFI-Tools-printing') ----- + printTypedefOn: s + s nextPutAll: 'typedef '. + referentClass + ifNotNil: + [(compiledSpec first bitClear: FFIStructSizeMask) = FFIFlagStructure + ifTrue: + [| next | + next := 2. + s + nextPutAll: referentClass compositeKindName; + nextPutAll: ' {'. + referentClass fields withIndexDo: + [:tuple :i| + s cr. + next := self printStructureField: tuple + at: next + inClass: referentClass + on: s + indent: 1. + s nextPut: $;]. + s cr; nextPutAll: '} '. + self assert: (next - 1 = compiledSpec size or: [(compiledSpec at: next) = FFIFlagStructure])] + ifFalse: + [self assert: (compiledSpec first bitClear: FFIStructSizeMask) = FFIFlagPointer. + s nextPutAll: referentClass name; nextPutAll: ' *foo'. + ^self]] + ifNil: + [self printAtomicType: compiledSpec first on: s]. + s nextPutAll: (referentClass ifNotNil: [referentClass name] ifNil: ['foo'])! Item was added: + ----- Method: ExternalType>>typedef (in category '*FFI-Tools-printing') ----- + typedef + ^String streamContents: [:s| self printTypedefOn: s]!

1 0

FFI: FFI-Kernel-mt.83.mcz
by commits＠source.squeak.org 01 Jun '20

01 Jun '20

Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.83.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.83 Author: mt Time: 1 June 2020, 10:07:38.001523 am UUID: 6a3601c2-a649-2a4e-a6ad-ddba52738605 Ancestors: FFI-Kernel-mt.82 Moves C code generation for typedefs to FFI-Tools package. =============== Diff against FFI-Kernel-mt.82 =============== Item was removed: - ----- Method: ExternalType>>printAtomicType:on: (in category 'printing') ----- - printAtomicType: spec on: aStream - self assert: (spec anyMask: FFIFlagAtomic). - aStream nextPutAll: (#( 'void' 'unsigned char' 'unsigned char' 'signed char' - 'unsigned short' 'short' 'unsigned long' 'long' - 'unsigned long long' 'long long' 'char' 'signed char' - 'float' 'double') at: ((spec bitAnd: FFIAtomicTypeMask) bitShift: FFIAtomicTypeShift negated) + 1). - aStream space. - (spec anyMask: FFIFlagPointer) ifTrue: - [aStream nextPut: $*]! Item was removed: - ----- Method: ExternalType>>printStructureField:at:inClass:on:indent: (in category 'printing') ----- - printStructureField: typeTuple at: initialSpecIndex inClass: structureClass on: aStream indent: indent - "Print the structure's field starting at initialSpecIndex and answer the index in compiledSpec of the subsequent type." - | typeName spec subStructureClass | - aStream tab: indent. - typeName := typeTuple first. - spec := compiledSpec at: initialSpecIndex. - (spec anyMask: FFIFlagAtomic) ifTrue: - [self printAtomicType: spec on: aStream. - aStream nextPutAll: (typeName ifNotNil: [typeName] ifNil: ['foo']). - ^initialSpecIndex + 1]. - subStructureClass := self subStructureClassFor: typeName in: structureClass. - (spec bitClear: FFIStructSizeMask) = FFIFlagStructure ifTrue: - [| next | - next := initialSpecIndex + 1. - aStream - nextPutAll: subStructureClass compositeKindName; - nextPutAll: ' {'. - subStructureClass fields withIndexDo: - [:tuple :i| - aStream cr. - next := self printStructureField: tuple - at: next - inClass: subStructureClass - on: aStream - indent: indent + 1. - aStream nextPut: $;]. - aStream crtab: indent; nextPut: $}. - typeName ifNotNil: [aStream space; nextPutAll: typeName]. - self assert: (next - 1 = compiledSpec size or: [(compiledSpec at: next) = FFIFlagStructure]). - ^next <= compiledSpec size ifTrue: [next + 1] ifFalse: [next]]. - self assert: (spec anyMask: FFIFlagPointer). - (subStructureClass isKindOf: ExternalUnion) - ifTrue: [aStream nextPutAll: 'union '] - ifFalse: [aStream nextPutAll: 'struct ']. - aStream nextPutAll: subStructureClass name; nextPutAll: ' *'; nextPutAll: typeName. - ^initialSpecIndex + 1! Item was removed: - ----- Method: ExternalType>>printTypedefOn: (in category 'printing') ----- - printTypedefOn: s - s nextPutAll: 'typedef '. - referentClass - ifNotNil: - [(compiledSpec first bitClear: FFIStructSizeMask) = FFIFlagStructure - ifTrue: - [| next | - next := 2. - s - nextPutAll: referentClass compositeKindName; - nextPutAll: ' {'. - referentClass fields withIndexDo: - [:tuple :i| - s cr. - next := self printStructureField: tuple - at: next - inClass: referentClass - on: s - indent: 1. - s nextPut: $;]. - s cr; nextPutAll: '} '. - self assert: (next - 1 = compiledSpec size or: [(compiledSpec at: next) = FFIFlagStructure])] - ifFalse: - [self assert: (compiledSpec first bitClear: FFIStructSizeMask) = FFIFlagPointer. - s nextPutAll: referentClass name; nextPutAll: ' *foo'. - ^self]] - ifNil: - [self printAtomicType: compiledSpec first on: s]. - s nextPutAll: (referentClass ifNotNil: [referentClass name] ifNil: ['foo'])! Item was removed: - ----- Method: ExternalType>>typedef (in category 'printing') ----- - typedef - ^String streamContents: [:s| self printTypedefOn: s]!

1 0

FFI: FFI-Kernel-mt.82.mcz
by commits＠source.squeak.org 01 Jun '20

01 Jun '20

Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.82.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.82 Author: mt Time: 1 June 2020, 9:58:11.800523 am UUID: ace0c4b6-24ce-a847-ae5f-6f2e281592f4 Ancestors: FFI-Kernel-mt.81 Fixes bug in external type's #storeOn:. Removes ambiguous #externalTypeName, which actually generated a #storeString for the pointer type. =============== Diff against FFI-Kernel-mt.81 =============== Item was changed: ----- Method: ExternalStructure class>>defineAliasAccessorsFor:type: (in category 'field definition') ----- defineAliasAccessorsFor: fieldName type: type "Define read/write accessors for the given field" | code refClass argName | (type isVoid and:[type isPointerType not]) ifTrue:[^self]. refClass := type referentClass. code := String streamContents:[:s| s nextPutAll: fieldName; crtab; nextPutAll:'"This method was automatically generated"'; crtab; nextPut: $<; nextPutAll: #generated; nextPut: $>; crtab. refClass == nil ifTrue:[(type isAtomic and:[type isPointerType not]) ifTrue:[s nextPutAll:'^handle'] ifFalse:[s nextPutAll:'^ExternalData fromHandle: handle'. type isPointerType ifTrue:[s nextPutAll:' asExternalPointer']. s nextPutAll:' type: '; + nextPutAll: type asPointerType storeString]] - nextPutAll: type externalTypeName]] ifFalse:[s nextPutAll:'^', refClass name,' fromHandle: handle'. type isPointerType ifTrue:[s nextPutAll:' asExternalPointer']]]. self compile: code classified: 'accessing'. code := String streamContents:[:s| argName := refClass == nil ifTrue:[(type isAtomic and:[type isPointerType not]) ifTrue:['anObject'] ifFalse:['anExternalData']] ifFalse:['a',refClass name]. s nextPutAll: fieldName,': '; nextPutAll: argName; crtab; nextPutAll:'"This method was automatically generated"'; crtab; nextPut: $<; nextPutAll: #generated; nextPut: $>; crtab. (refClass == nil and:[type isAtomic and:[type isPointerType not]]) ifTrue:[s nextPutAll:'handle := ', argName] ifFalse:[s nextPutAll:'handle := ', argName,' getHandle'. type isPointerType ifTrue:[s nextPutAll:' asByteArrayPointer']]]. self compile: code classified: 'accessing'.! Item was removed: - ----- Method: ExternalType>>externalTypeName (in category 'private') ----- - externalTypeName - ^'ExternalType ', (AtomicTypeNames at: self atomicType), ' asPointerType'! Item was changed: ----- Method: ExternalType>>storeOn: (in category 'printing') ----- storeOn: aStream referentClass == nil ifTrue:[aStream nextPutAll: ExternalType name; space; nextPutAll: (AtomicTypeNames at: self atomicType)] ifFalse:[aStream nextPut: $(; nextPutAll: ExternalType name; space; nextPutAll: #structTypeNamed:; space; store: referentClass name; nextPut: $)]. + self isPointerType ifTrue: [aStream space; nextPutAll: #asPointerType].! - self isPointerType ifTrue: [aStream space; nextPutAll: #asPointer].!

1 0

FFI: FFI-Kernel-mt.81.mcz
by commits＠source.squeak.org 01 Jun '20

01 Jun '20

Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI: http://source.squeak.org/FFI/FFI-Kernel-mt.81.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.81 Author: mt Time: 1 June 2020, 9:06:23.085523 am UUID: 32229562-fe90-5b42-8d0d-926e8bc4da7a Ancestors: FFI-Kernel-mt.80 More flags to document #ffiLongVsInt -- which is an intersting clash of vocabularies. :-) =============== Diff against FFI-Kernel-mt.80 =============== Item was changed: ----- Method: ByteArray>>pointerAt: (in category '*FFI-Kernel') ----- pointerAt: byteOffset "Answer a pointer object stored at the given byte address" + self flag: #ffiLongVsInt. "mt: Here short means 'long', which is actually 'int', and long means 'longlong'. Sigh." ^ ExternalAddress wordSize caseOf: { [4] -> [self shortPointerAt: byteOffset]. [8] -> [self longPointerAt: byteOffset] }! Item was changed: ----- Method: ByteArray>>pointerAt:put: (in category '*FFI-Kernel') ----- pointerAt: byteOffset put: value "Store a pointer object at the given byte address" + self flag: #ffiLongVsInt. "mt: Here short means 'long', which is actually 'int', and long means 'longlong'. Sigh." ^ ExternalAddress wordSize caseOf: { [4] -> [self shortPointerAt: byteOffset put: value]. [8] -> [self longPointerAt: byteOffset put: value] }! Item was changed: ----- Method: ExternalType class>>initializeFFIConstants (in category 'class initialization') ----- initializeFFIConstants "ExternalType initialize" FFIConstants initialize. "ensure proper initialization" AtomicTypeNames := IdentityDictionary new. AtomicSelectors := IdentityDictionary new. AtomicTypeNames at: FFITypeVoid put: 'void'; at: FFITypeBool put: 'bool'; at: FFITypeUnsignedByte put: 'byte'; at: FFITypeSignedByte put: 'sbyte'; at: FFITypeUnsignedShort put: 'ushort'; at: FFITypeSignedShort put: 'short'; + flag: #ffiLongVsInt; at: FFITypeUnsignedInt put: 'ulong'; at: FFITypeSignedInt put: 'long'; at: FFITypeUnsignedLongLong put: 'ulonglong'; at: FFITypeSignedLongLong put: 'longlong'; at: FFITypeUnsignedChar put: 'char'; at: FFITypeSignedChar put: 'schar'; at: FFITypeSingleFloat put: 'float'; at: FFITypeDoubleFloat put: 'double'; yourself. AtomicSelectors at: FFITypeVoid put: #voidAt:; at: FFITypeBool put: #booleanAt:; at: FFITypeUnsignedByte put: #unsignedByteAt:; at: FFITypeSignedByte put: #signedByteAt:; at: FFITypeUnsignedShort put: #unsignedShortAt:; at: FFITypeSignedShort put: #signedShortAt:; + flag: #ffiLongVsInt; at: FFITypeUnsignedInt put: #unsignedLongAt:; at: FFITypeSignedInt put: #signedLongAt:; at: FFITypeUnsignedLongLong put: #unsignedLongLongAt:; at: FFITypeSignedLongLong put: #signedLongLongAt:; at: FFITypeUnsignedChar put: #unsignedCharAt:; at: FFITypeSignedChar put: #signedCharAt:; at: FFITypeSingleFloat put: #floatAt:; at: FFITypeDoubleFloat put: #doubleAt:; yourself! 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 | + self flag: #ffiLongVsInt. "mt: Here short means 'long', which is actually 'int', and long means 'longlong'. Sigh." accessor := self pointerSize caseOf: { [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 | + self flag: #ffiLongVsInt. "mt: Here short means 'long', which is actually 'int', and long means 'longlong'. Sigh." accessor := self pointerSize caseOf: { [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].!

1 0

FFI: FFI-Kernel-mt.80.mcz
by commits＠source.squeak.org 01 Jun '20

01 Jun '20

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-Squea… =============== 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.'!

1 0

Jump to page: