Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI:
http://source.squeak.org/FFI/FFI-Kernel-mt.142.mcz ==================== Summary ==================== Name: FFI-Kernel-mt.142 Author: mt Time: 14 May 2021, 3:00:14.59076 pm UUID: 4fc40176-45b1-d345-9664-dd4f0dd6cb81 Ancestors: FFI-Kernel-mt.141 Refactors the type system. Makes the support for type aliases (i.e. typedefs) more robust. There are tests, which I will commit ASAP. To learn more about this commit, take a look at the class hierarchy of ExternalType. Then look where ExternalUnknownType will be constructed and how #becomeKnownType works. Note that there is still an issue with alias-to-pointer types, where the FFI plugin insists on returning a byte array as handle instead of ExternalAddress. And FFI calls with an external address will even fail. There seems to be some kind of magic going on. Anyway, it is not necessary for the in-image handling of types, not even for type checking because alias=typedef=invisible ;-) See #checkHandle and #checkHandleUndo for the current workaround. Also browse the flag #pointerAliasCompatibility. We now support up to 2-dimensional array types via alias-to-array types. Note that both pointer arithmetic (ExternalAddress class >> #fromAddress:movedBy:) and zero'ed allocation (#allocateZero:) should both be available from the FFI plugin the future because performance and security. :-) =============== Diff against FFI-Kernel-mt.141 =============== Item was removed: - ----- Method: ByteArray>>asByteArrayPointer (in category '*FFI-Kernel-pointers') ----- - asByteArrayPointer - "Return a ByteArray describing a pointer to the contents of the receiver." - ^self shouldNotImplement! Item was removed: - ----- Method: ByteArray>>asExternalPointer (in category '*FFI-Kernel-pointers') ----- - asExternalPointer - "Convert the receiver assuming that it describes a pointer to an object." - ^ self pointerAt: 1 length: self size! Item was changed: + ----- Method: ByteArray>>isNull (in category '*FFI-Kernel-pointers') ----- - ----- Method: ByteArray>>isNull (in category '*FFI-Kernel-testing') ----- isNull + "Answer false since only pointers (i.e. external addresses) can be null." - "Answer false since only pointers can be null, which is easy for external addresses but unknown for byte arrays without a proper external type for interpretation. See #isTypeAliasForPointer." ^ false! Item was removed: - ----- Method: ByteArray>>isNull: (in category '*FFI-Kernel-testing') ----- - isNull: externalType - "Given the external type, answer whether the receiver holds all null bytes representing a null pointer." - - "self assert: [self isInternalMemory]." - ^ externalType isTypeAliasForPointer - and: [externalType byteSize = self size] - and: [self allSatisfy: [:byte | byte = 0]]! Item was changed: ----- Method: ByteArray>>longPointerAt: (in category '*FFI-Kernel-pointers') ----- longPointerAt: byteOffset "Answer an 8-byte pointer object stored at the given byte address" + self deprecated: 'Use #pointerAt:length:'. ^ self pointerAt: byteOffset length: 8! Item was changed: ----- Method: ByteArray>>longPointerAt:put: (in category '*FFI-Kernel-pointers') ----- longPointerAt: byteOffset put: value "Store an 8-byte pointer object at the given byte address" + + self deprecated: 'Use #pointerAt:put:length:'. - ^ self pointerAt: byteOffset put: value length: 8! Item was changed: ----- Method: ByteArray>>pointerAt:length: (in category '*FFI-Kernel-pointers') ----- + pointerAt: byteOffset length: numBytes "^ <ExternalAddress>" - pointerAt: byteOffset length: numBytes "Answer a pointer object of numBytes length stored at the given byte address" | addr | addr := ExternalAddress basicNew: numBytes. + 1 to: numBytes do: [:index | + addr + basicAt: index + put: (self unsignedByteAt: byteOffset+index-1)]. - 1 to: numBytes do: - [:i| - addr basicAt: i put: (self unsignedByteAt: byteOffset+i-1)]. ^addr! Item was changed: ----- Method: ByteArray>>pointerAt:put:length: (in category '*FFI-Kernel-pointers') ----- pointerAt: byteOffset put: value length: numBytes "Store a pointer object with numBytes lengeth at the given byte address" + + self assert: [value isExternalAddress]. + + 1 to: numBytes do: [:index | + self + unsignedByteAt: byteOffset + index - 1 + put: (value basicAt: index)]. + ^ value! - value isExternalAddress ifFalse: - [^self error:'Only external addresses can be stored']. - 1 to: numBytes do: - [:i| - self unsignedByteAt: byteOffset+i-1 put: (value basicAt: i)]. - ^value! Item was changed: ----- Method: ByteArray>>shortPointerAt: (in category '*FFI-Kernel-pointers') ----- shortPointerAt: byteOffset "Answer a 4-byte pointer object stored at the given byte address" + self deprecated: 'Use #pointerAt:length:'. ^ self pointerAt: byteOffset length: 4! Item was changed: ----- Method: ByteArray>>shortPointerAt:put: (in category '*FFI-Kernel-pointers') ----- shortPointerAt: byteOffset put: value "Store a 4-byte pointer object at the given byte address" + self deprecated: 'Use #pointerAt:put:length:'. ^ self pointerAt: byteOffset put: value length: 4! Item was added: + ----- Method: ByteArray>>withoutReadWriter (in category '*FFI-Kernel-comparing') ----- + withoutReadWriter + "Workaround to make #= and #== work through ByteArrayReadWriter." + + ^ self! Item was removed: - ----- Method: ByteArray>>zeroMemory (in category '*FFI-Kernel') ----- - zeroMemory - - self atAllPut: 0.! Item was changed: + ----- Method: ByteArrayReadWriter>>structAt:length: (in category 'structs') ----- - ----- Method: ByteArrayReadWriter>>structAt:length: (in category 'accessing') ----- structAt: newByteOffset length: newLength ^ ByteArrayReadWriter new setArray: byteArray offset: byteOffset + newByteOffset - 1 size: newLength! Item was changed: + ----- Method: ByteArrayReadWriter>>structAt:put:length: (in category 'structs') ----- - ----- Method: ByteArrayReadWriter>>structAt:put:length: (in category 'accessing') ----- structAt: newByteOffset put: value length: newLength (newByteOffset + newLength > byteSize) ifTrue: [self errorSubscriptBounds: newByteOffset + newLength]. ^ byteArray structAt: byteOffset + newByteOffset - 1 put: value length: newLength! Item was added: + ----- Method: ByteArrayReadWriter>>withoutReadWriter (in category 'initialization') ----- + withoutReadWriter + + ^ byteArray! Item was changed: ----- Method: CompiledMethod>>externalLibraryName (in category '*FFI-Kernel') ----- externalLibraryName "Try to answer the effective name of the external library involved. Might be ambiguous for external libraries if function's module was set, too, and handle not null." ^ self externalLibraryFunction ifNotNil: [:extFun | self methodClass ifNil: [extFun module "Method not installed. Rely on external function data."] ifNotNil: [:extLib | (extLib inheritsFrom: ExternalLibrary) ifFalse: [extFun module "Class is no external library. Rely on external function data."] ifTrue: [ extFun module ifNil: [extLib moduleName "External function has no data. Rely on external library data."] ifNotNil: [:extFunModName | extLib moduleName ifNil: [extFunModName "External library has no data. Rely on external function data."] ifNotNil: [:extLibModName | "Now we have two options: module name from function or from library." + extFun isNull - extFun getHandle isNull ifTrue: [extFunModName "Function has higher priority than library on first call."] ifFalse: [ {extFunModName. extLibModName} "We cannot know. It is likely to be from the function's module name. So put that first."]]]]]]! Item was changed: ----- Method: CompiledMethod>>externalLibraryName: (in category '*FFI-Kernel') ----- externalLibraryName: libraryName "Reset the library to look for the external function. Also reset the function's handle in case it has been called before. The next call should definitely go to the new library." ^ self externalLibraryFunction ifNotNil: [:extFun | extFun setModule: libraryName. + self flag: #todo. "mt: Maybe actually #free the handle here?" extFun getHandle beNull]! Item was changed: ----- Method: ExternalAddress class>>allocate: (in category 'instance creation') ----- allocate: byteSize + "Primitive. Allocates byteSize bytes on the external heap. Answers an address pointing to those bytes. WARNING bytes might not be zero'ed!!" - "Primitive. Allocate an object on the external heap." <primitive:'primitiveFFIAllocate' module:'SqueakFFIPrims'> + + self flag: #todo. "mt: Ensure zero'ed memory." + ^ self primitiveFailed! - ^self primitiveFailed! Item was added: + ----- Method: ExternalAddress class>>allocateZero: (in category 'instance creation') ----- + allocateZero: byteSize + + ^ (self allocate: byteSize) + zeroMemory: byteSize; + yourself! Item was added: + ----- Method: ExternalAddress class>>fromAddress:movedBy: (in category 'support') ----- + fromAddress: externalAddress movedBy: delta + "Do pointer arithmetic. This might better be done in the plugin." + + delta = 0 ifTrue: [^ externalAddress]. + ^ self fromInteger: externalAddress asInteger + delta! Item was added: + ----- Method: ExternalAddress class>>fromByteArray: (in category 'instance creation') ----- + fromByteArray: aByteArray + + self flag: #pointerAliasCompatibility. "mt: Bug in FFI plugin, which fails to answer ExternalAddress as handle for alias-to-pointer types." + self assert: [aByteArray size = ExternalAddress wordSize]. + ^ aByteArray changeClassTo: self! Item was added: + ----- Method: ExternalAddress class>>fromInteger: (in category 'instance creation') ----- + fromInteger: anInteger + "Read the given interger as an address pointing to an external memory area." + + | bytes | + bytes := ByteArray basicNew: self wordSize. + bytes integerAt: 1 put: anInteger size: bytes size signed: false. + ^ bytes changeClassTo: self! Item was changed: ----- Method: ExternalAddress>>+ (in category 'arithmetic') ----- + offset + "Answer a new address that is offset by the given number of bytes." - "Create an address that is offset by the given number of bytes. - More tricky than one would think due to the FFI's handling of ExternalAddress - as pointer to an object so that 'self unsignedLongAt: ' would dereference." + ^ ExternalAddress fromAddress: self movedBy: offset! - | bytes | - offset = 0 ifTrue: [^ self]. - "Convert xaddr -> bytes" - bytes := self asByteArrayPointer. - "Update bytes using platform dependent accessors" - self size = 4 - ifTrue: [bytes unsignedLongAt: 1 put: (bytes unsignedLongAt: 1) + offset] - ifFalse: [bytes unsignedLongLongAt: 1 put: (bytes unsignedLongLongAt: 1) + offset]. - "Convert bytes -> xaddr" - ^bytes asExternalPointer! Item was removed: - ----- Method: ExternalAddress>>asByteArrayPointer (in category 'private') ----- - asByteArrayPointer - "Answer a ByteArray containing a copy of pointer to the contents of the receiver." - | sz | - ^(ByteArray basicNew: (sz := self size)) - replaceFrom: 1 to: sz with: self startingAt: 1 "answers self"! Item was removed: - ----- Method: ExternalAddress>>asExternalPointer (in category 'private') ----- - asExternalPointer - "No need to convert." - ^self! Item was changed: + ----- Method: ExternalAddress>>asInteger (in category 'arithmetic') ----- - ----- Method: ExternalAddress>>asInteger (in category 'converting') ----- asInteger + "Convert address to integer. Change class to not follow the address when reading bytes." + + | result | + [self changeClassTo: ByteArray. + result := self integerAt: 1 size: self size signed: false] + ensure: [self changeClassTo: ExternalAddress]. + + ^ result! - "convert address to integer" - ^ self asByteArrayPointer integerAt: 1 size: self size signed: false! Item was removed: - ----- Method: ExternalAddress>>fromInteger: (in category 'converting') ----- - fromInteger: address - "set my handle to point at address." - "Do we really need this? bf 2/21/2001 23:48" - - | sz pointer | - sz := self size. - pointer := ByteArray new: sz. - pointer integerAt: 1 put: address size: sz signed: false. . - self basicAt: 1 put: (pointer byteAt: 1); - basicAt: 2 put: (pointer byteAt: 2); - basicAt: 3 put: (pointer byteAt: 3); - basicAt: 4 put: (pointer byteAt: 4). - sz = 8 ifTrue: - [self basicAt: 5 put: (pointer byteAt: 5); - basicAt: 6 put: (pointer byteAt: 6); - basicAt: 7 put: (pointer byteAt: 7); - basicAt: 8 put: (pointer byteAt: 8)]! Item was changed: + ----- Method: ExternalAddress>>isExternalAddress (in category 'testing') ----- - ----- Method: ExternalAddress>>isExternalAddress (in category 'accessing') ----- isExternalAddress "Return true if the receiver describes the address of an object in the outside world" ^true! Item was removed: - ----- Method: ExternalAddress>>isNull: (in category 'testing') ----- - isNull: externalType - "Overridden to make use of #isNull. This fails if the provided pointer size does not match, which indicates an inconsistency in the system's type objects for the current platform. See 'housekeeping' protocol in ExternalType." - - self assert: [externalType pointerSize = self size]. - ^ self isNull! Item was removed: - ----- Method: ExternalAddress>>zeroMemory (in category 'initialize-release') ----- - zeroMemory - "We need length information in bytes." - self shouldNotImplement.! Item was changed: ExternalType subclass: #ExternalArrayType + instanceVariableNames: 'contentType size' - instanceVariableNames: 'size' classVariableNames: '' poolDictionaries: '' category: 'FFI-Kernel'! 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.'. - assert: [contentType isPointerType not and: [contentType isArrayType not]] - description: 'No support for multi-dimensional containers yet!!'. self + assert: [contentType byteSize > 0] "No arrays of empty structs or void type." + description: 'No array types for empty structs or void type!!'. - assert: [numElements > 0] - description: 'Empty array types are not supported!!'. self + assert: [ + (ArrayTypes at: contentType typeName + ifPresent: [:sizes | sizes at: numElements ifAbsent: [nil]] + ifAbsent: [nil] ) isNil] - assert: [contentType byteSize > 0] - description: 'Invalid byte size!!'. - - self - assert: [(ArrayTypes includesKey: contentType typeName -> numElements) not] description: 'Array type already exists. Use #typeNamed: to access it.'. + type := ExternalArrayType basicNew. + pointerType := ExternalPointerType basicNew. - type := self "ExternalArrayType" basicNew. - pointerType := ExternalType basicNew. "1) Regular type" + byteSize := numElements + ifNil: [0] ifNotNil: [numElements * contentType byteSize]. - byteSize := numElements * contentType byteSize. self assert: [byteSize <= FFIStructSizeMask]. headerWord := contentType headerWord. headerWord := headerWord bitClear: FFIStructSizeMask. headerWord := headerWord bitOr: byteSize. type setReferencedType: pointerType; compiledSpec: (WordArray with: headerWord); + byteAlignment: (numElements ifNil: [0] ifNotNil: [contentType byteAlignment]); - byteAlignment: contentType byteAlignment; setReferentClass: contentType referentClass; + setContentType: contentType; setSize: numElements. "2) Pointer type. Reuse the compiledSpec of the content-type's pointer type." pointerType setReferencedType: type; + compiledSpec: (WordArray with: (self pointerSpec bitOr: FFIFlagAtomic "HACK!! To deceive the FFI plugin :)")); + byteAlignment: self pointerAlignment; + setReferentClass: nil. - compiledSpec: contentType asPointerType compiledSpec copy; - byteAlignment: contentType asPointerType byteAlignment; - setReferentClass: contentType asPointerType referentClass. "3) Remember this new array type." + (ArrayTypes at: contentType typeName ifAbsentPut: [WeakValueDictionary new]) + at: numElements put: type. + - ArrayTypes - at: contentType typeName -> numElements - put: type. - ^ type! Item was changed: ----- Method: ExternalArrayType>>allocate: (in category 'external data') ----- allocate: anInteger "No support for n-dimensional containers." + self isTypeAlias ifTrue: [^ super allocate: anInteger]. + - self flag: #contentVsContainer. self notYetImplemented.! Item was changed: ----- Method: ExternalArrayType>>allocateExternal: (in category 'external data') ----- allocateExternal: anInteger "No support for n-dimensional containers." + + self isTypeAlias ifTrue: [^ super allocateExternal: anInteger]. + - - self flag: #contentVsContainer. self notYetImplemented.! Item was added: + ----- Method: ExternalArrayType>>asArrayType: (in category 'converting') ----- + asArrayType: numElements + "N-dimensional containers only possible via type alias for now." + + self isTypeAlias ifTrue: [^ super asArrayType: numElements]. + + self notYetImplemented. + ! Item was added: + ----- Method: ExternalArrayType>>byteSize (in category 'accessing') ----- + byteSize + "For array types with an unknown size, also answer an unknown byte size." + + ^ size ifNotNil: [super byteSize]! Item was removed: - ----- Method: ExternalArrayType>>checkType (in category 'external structure') ----- - checkType - - self class extraTypeChecks ifFalse: [^ self]. - - self - assert: [self isPointerType not] - description: 'Convert to ExternalType to use this feature'.! Item was changed: ----- Method: ExternalArrayType>>contentType (in category 'external data') ----- contentType "^ <ExternalType>" - "We are an array of things. Our content type is encoded in the compiledSpec's headerWord. The super implementation of #typeName can figure that out." + ^ contentType! - self flag: #contentVsContainer. "mt: For n-dimensional containers, we might have to adapt this." - ^ ExternalType typeNamed: super typeName! Item was added: + ----- Method: ExternalArrayType>>contentTypeName (in category 'external data') ----- + contentTypeName + + ^ self contentType typeName! Item was changed: ----- Method: ExternalArrayType>>handle:at: (in category 'external data') ----- handle: handle at: byteOffset - "Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:." - self checkType. - ^ ExternalData fromHandle: (handle structAt: byteOffset length: self byteSize) type: self! Item was changed: ----- Method: ExternalArrayType>>handle:at:put: (in category 'external data') ----- handle: handle at: byteOffset put: value - "Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:." + ^ handle - self checkType. - - handle structAt: byteOffset put: value getHandle + length: self byteSize! - length: self byteSize.! Item was added: + ----- Method: ExternalArrayType>>isArrayOfArrays (in category 'testing') ----- + isArrayOfArrays + "Limited support for 2-dimensional arrays through type aliases possible." + + ^ self contentType isArrayType! Item was added: + ----- Method: ExternalArrayType>>isAtomic (in category 'testing') ----- + isAtomic + + ^ false! Item was added: + ----- Method: ExternalArrayType>>isPointerType (in category 'testing') ----- + isPointerType + + ^ false! Item was added: + ----- Method: ExternalArrayType>>isStructureType (in category 'testing') ----- + isStructureType + + ^ false! Item was added: + ----- Method: ExternalArrayType>>isTypeAlias (in category 'testing') ----- + isTypeAlias + + ^ self isArrayOfArrays not + and: [referentClass notNil + and: [referentClass isTypeAlias + and: [referentClass originalType isArrayType]]]! Item was added: + ----- Method: ExternalArrayType>>isUnknownType (in category 'testing') ----- + isUnknownType + + ^ false! Item was changed: ----- Method: ExternalArrayType>>newReferentClass: (in category 'private') ----- newReferentClass: classOrNil "The class I'm referencing has changed, which affects arrays of structs. Update my byteSize." | newByteSize newHeaderWord | (referentClass := classOrNil) ifNil: [ "my class has been removed - make me empty" compiledSpec := WordArray with: self class structureSpec. byteAlignment := 1] ifNotNil: [ "my class has been changed - update my compiledSpec" newHeaderWord := referentClass compiledSpec first. + newByteSize := size ifNil: [0] ifNotNil: [size * (newHeaderWord bitAnd: FFIStructSizeMask)]. - newByteSize := size * (newHeaderWord bitAnd: FFIStructSizeMask). newHeaderWord := newHeaderWord bitClear: FFIStructSizeMask. newHeaderWord := newHeaderWord bitOr: newByteSize. compiledSpec := WordArray with: newHeaderWord. + byteAlignment := referentClass byteAlignment]! - byteAlignment := referentClass byteAlignment].! Item was added: + ----- Method: ExternalArrayType>>newTypeAlias (in category 'private') ----- + newTypeAlias + "A little bit expensive but easy to implement. Once the size information is encoded in the headerWord, we might be able to do some cheap update like for the alias-to-pointer type." + + | newUnknownType | + self isTypeAlias ifFalse: [^ self]. + + newUnknownType := ExternalUnknownType basicNew + compiledSpec: self compiledSpec; + byteAlignment: self byteAlignment; + setReferentClass: referentClass; + setReferencedType: referencedType; + yourself. + + "Make my pointer type common again by setting the referentClass." + newUnknownType setReferencedType: referencedType. + referencedType setReferentClass: referentClass. + + self becomeForward: newUnknownType. + newUnknownType becomeKnownType.! Item was added: + ----- Method: ExternalArrayType>>readAlias (in category 'external structure') ----- + readAlias + + ^ '^ {1} fromHandle: handle{2}' + format: { + (referentClass ifNil: [ExternalData]) name. + referentClass ifNotNil: [''] ifNil: [ + ' type: ', self storeString]}! Item was changed: ----- Method: ExternalArrayType>>readFieldAt: (in category 'external structure') ----- 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." + ^ '^ ExternalData fromHandle: (handle structAt: {1} length: {2}) type: {3}' + format: { + byteOffset. + self byteSize. + self storeString}! - self checkType. - - ^ String streamContents:[:s | - s nextPutAll:'^ ExternalData fromHandle: (handle structAt: '; - print: byteOffset; - nextPutAll: ' length: '; - print: self byteSize; - nextPutAll: ') type: '. - - self contentType isAtomic - ifTrue: [s nextPutAll: 'ExternalType ', self contentType typeName] - ifFalse: [s nextPutAll: self contentType typeName, ' externalType']. - - s nextPutAll: ' size: '; print: self size]! Item was added: + ----- Method: ExternalArrayType>>setContentType: (in category 'private') ----- + setContentType: type + + contentType := type.! Item was changed: ----- Method: ExternalArrayType>>storeOn: (in category 'printing') ----- storeOn: aStream + + self isTypeAlias ifTrue: [ + ^ aStream + nextPutAll: referentClass name; + nextPutAll: ' externalType']. + + aStream nextPut: $(. + self contentType storeOn: aStream. + aStream nextPutAll: ' asArrayType: '. + aStream nextPutAll: self size asString. + aStream nextPut: $).! - - aStream - nextPut: $(; - nextPutAll: ExternalType name; space; - nextPutAll: #arrayTypeNamed:; space; - store: self typeName; - nextPut: $).! Item was changed: ----- Method: ExternalArrayType>>typeName (in category 'accessing') ----- typeName + self isTypeAlias + ifTrue: [^ super typeName]. + + ^ String streamContents: [:stream | | inParentheses | + (inParentheses := self contentType isPointerType not + and: [self contentType asPointerType isTypeAlias]) + ifTrue: [stream nextPut: $(. "e.g. (*DoublePtr)[5]"]. + + stream nextPutAll: self contentType typeName. + + inParentheses ifTrue: [stream nextPut: $)]. + + stream nextPut: $[. + self size ifNotNil: [stream nextPutAll: self size asString]. + stream nextPut: $]. ]! - ^ String streamContents: [:stream | - stream - nextPutAll: super typeName; - nextPut: $[; - nextPutAll: self size asString; - nextPut: $]]! Item was added: + ----- Method: ExternalArrayType>>writeAliasWith: (in category 'external structure') ----- + writeAliasWith: valueName + + ^ 'handle := {1} getHandle.' + format: {valueName}! Item was changed: ----- Method: ExternalArrayType>>writeFieldArgName (in category 'external structure') ----- writeFieldArgName + ^ 'anExternalData'! - ^ 'anExternalData_', self contentType typeName, self size! Item was changed: ----- Method: ExternalArrayType>>writeFieldAt:with: (in category 'external structure') ----- writeFieldAt: byteOffset with: valueName + ^ 'handle stuctAt: {1} put: {2} length: {3}' + format: { + byteOffset. + valueName. + self byteSize}! - self checkType. - - ^ String streamContents:[:s | - s nextPutAll:'handle structAt: '; - print: byteOffset; - nextPutAll: ' put: '; - nextPutAll: valueName; - nextPutAll: ' getHandle length: '; - print: self byteSize]! Item was added: + ExternalType subclass: #ExternalAtomicType + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Kernel'! Item was added: + ----- Method: ExternalAtomicType class>>newTypeForAtomicNamed: (in category 'instance creation') ----- + newTypeForAtomicNamed: atomicTypeName + + | type pointerType | + type := ExternalAtomicType basicNew. + pointerType := ExternalPointerType basicNew. + + type setReferencedType: pointerType. + pointerType setReferencedType: type. + + AtomicTypes at: atomicTypeName put: type. + + ^ type! Item was added: + ----- Method: ExternalAtomicType>>handle:at: (in category 'external data') ----- + handle: handle at: byteOffset + + | result | + result := handle + perform: (AtomicSelectors at: self atomicType) + with: byteOffset. + ^ referentClass + ifNotNil: [referentClass fromHandle: result] + ifNil: [result]! Item was added: + ----- Method: ExternalAtomicType>>handle:at:put: (in category 'external data') ----- + handle: handle at: byteOffset put: value + + ^ handle + perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol + with: byteOffset + with: (referentClass ifNil: [value] ifNotNil: [value getHandle])! Item was added: + ----- Method: ExternalAtomicType>>isArrayType (in category 'testing') ----- + isArrayType + + ^ false! Item was added: + ----- Method: ExternalAtomicType>>isAtomic (in category 'testing') ----- + isAtomic + + ^ true! Item was added: + ----- Method: ExternalAtomicType>>isPointerType (in category 'testing') ----- + isPointerType + + ^ false! Item was added: + ----- Method: ExternalAtomicType>>isStructureType (in category 'testing') ----- + isStructureType + + ^ false! Item was added: + ----- Method: ExternalAtomicType>>isTypeAlias (in category 'testing') ----- + isTypeAlias + + ^ referentClass notNil + and: [referentClass isTypeAlias + and: [referentClass originalType isAtomic]]! Item was added: + ----- Method: ExternalAtomicType>>isUnknownType (in category 'testing') ----- + isUnknownType + + ^ false! Item was added: + ----- Method: ExternalAtomicType>>newTypeAlias (in category 'testing') ----- + newTypeAlias + + "self isTypeAlias ifFalse: [^ self]." + "Nothing to do. My referentClass was already upated." + ! Item was added: + ----- Method: ExternalAtomicType>>originalType (in category 'accessing - type alias') ----- + originalType + "Overwritten to look into my referencedType. See #isTypeAliasReferenced." + + ^ self "e.g. *DoublePtr" asPointerType isTypeAlias "e.g. DoublePtr" + ifTrue: [super originalType asNonPointerType "e.g. double, not double*"] + ifFalse: [super originalType]! Item was added: + ----- Method: ExternalAtomicType>>readAlias (in category 'external structure') ----- + readAlias + + ^ '^ {1}handle{2}' + format: { + referentClass ifNil: [''] ifNotNil: [ + referentClass name, ' fromHandle: ']. + referentClass ifNotNil: [''] ifNil: [ + ' "', self writeFieldArgName, '"'] }! Item was added: + ----- Method: ExternalAtomicType>>readFieldAt: (in category 'external structure') ----- + readFieldAt: byteOffset + + ^ '^ {1}handle {2} {3}{4}' + format: { + referentClass ifNil: [''] ifNotNil: [ + referentClass name, ' fromHandle: (']. + AtomicSelectors at: self atomicType. + byteOffset. + referentClass ifNil: [''] ifNotNil: [')']}! Item was added: + ----- Method: ExternalAtomicType>>storeOn: (in category 'printing') ----- + storeOn: aStream + + referentClass + ifNil: [ + aStream + nextPutAll: 'ExternalType '; + nextPutAll: self atomicTypeName] + ifNotNil: [ + aStream + nextPutAll: referentClass name; + nextPutAll: ' externalType'].! Item was added: + ----- Method: ExternalAtomicType>>writeAliasWith: (in category 'external structure') ----- + writeAliasWith: valueName + + ^ 'handle := {1}{2}.' + format: { + valueName. + referentClass ifNil: [''] ifNotNil: [' getHandle']}! Item was added: + ----- Method: ExternalAtomicType>>writeFieldArgName (in category 'external structure') ----- + writeFieldArgName + + self isTypeAlias ifTrue: [ + ^ super writeFieldArgName]. + + self isIntegerType ifTrue: [ + ^ 'anInteger']. + + ^ self atomicTypeName caseOf: { + ['bool'] -> ['aBoolean']. + ['char'] -> ['aCharacter']. + ['schar'] -> ['aCharacter']. + ['float'] -> ['aFloat']. + ['double'] -> ['aFloat'] }! Item was added: + ----- Method: ExternalAtomicType>>writeFieldAt:with: (in category 'external structure') ----- + writeFieldAt: byteOffset with: valueName + + ^ 'handle {1} {2} put: {3}{4}.' + format: { + AtomicSelectors at: self atomicType. + byteOffset. + valueName. + referentClass ifNil: [''] ifNotNil: [' getHandle']}! Item was changed: ExternalStructure subclass: #ExternalData + instanceVariableNames: 'type' - instanceVariableNames: 'type size' classVariableNames: 'AllowDetectForUnknownSize' poolDictionaries: '' category: 'FFI-Kernel'! !ExternalData commentStamp: 'mt 6/13/2020 17:26' prior: 0! Instances of ExternalData explicitly describe objects with associated type. They can be used for describing atomic C types like arrays of atomic types (e.g., 'int[]') or pointer to atomic types (e.g., 'int *'). Instance variables: type <ExternalType> The external type of the receiver. Always a pointer type. The encoding of type is equivalent to that of the basic type in class ExternalType. The interpretation of whether the receiver describes an array of data or a pointer to data depends on the contents of the instance variable 'handle'. If handle contains an ExternalAddress the receiver is treated as pointer to type. If the handle contains a ByteArray the receiver is interpreted as describing an array of type. Note that both interpretations are treated equivalent in external calls, e.g., if one describes an argument to an external call as taking 'int*' then, depending on the type of handle either the actual contents (if ExternalAddress) or a pointer to the contents (if ByteArray) is passed. ! Item was changed: ----- Method: ExternalData class>>fromHandle: (in category 'instance creation') ----- fromHandle: aHandle + + ^ self fromHandle: aHandle type: ExternalType void! - "We need type information. See #fromHandle:type:" - self shouldNotImplement.! Item was added: + ----- Method: ExternalData>>allSatisfy: (in category 'enumerating') ----- + allSatisfy: aBlock + + self do: [:each | (aBlock value: each) ifFalse: [^ false]]. + ^ true! Item was added: + ----- Method: ExternalData>>anySatisfy: (in category 'enumerating') ----- + anySatisfy: aBlock + + self do: [:each | (aBlock value: each) ifTrue: [^ true]]. + ^ false! Item was removed: - ----- Method: ExternalData>>asString (in category 'converting') ----- - asString - - ^ size - ifNil: [self fromCString] - ifNotNil: [self fromStringBounded]! Item was changed: ----- Method: ExternalData>>at: (in category 'accessing') ----- at: index + ((1 > index) or: [self size notNil and: [index > self size]]) - ((1 > index) or: [size notNil and: [index > size]]) ifTrue: [^ self errorSubscriptBounds: index]. ^ self contentType handle: handle at: ((index-1) * self contentType byteSize) + 1! Item was changed: ----- Method: ExternalData>>at:put: (in category 'accessing') ----- at: index put: value + ((1 > index) or: [self size notNil and: [index > self size]]) - ((1 > index) or: [size notNil and: [index > size]]) ifTrue: [^ self errorSubscriptBounds: index]. ^ self contentType handle: handle at: ((index-1) * self contentType byteSize) + 1 put: value! Item was changed: ----- Method: ExternalData>>byteSize (in category 'accessing') ----- byteSize "Answer how many bytes the receiver manages." + | ct myBytes | + self isNull ifTrue: [^ 0]. + self size ifNil: [^ nil "We don't know"]. + + myBytes := self size * (ct := self contentType) byteSize. + + ^ ct isPointerType + ifTrue: [ "Locally managed pointers do not ocunt. See ByteArray >> #isNull." + (handle isExternalAddress ifTrue: [myBytes] ifFalse: [0]) + + (self reader collect: [:each | each byteSize]) sum ] + ifFalse: [ myBytes ]! - self sizeCheck. - ^ self size * self contentType byteSize! Item was added: + ----- Method: ExternalData>>checkHandle (in category 'compatibility') ----- + checkHandle + "Not needed here."! Item was changed: ----- Method: ExternalData>>containerType (in category 'accessing - types') ----- + containerType "^ <ExternalArrayType>" + "Answer the current container type, which may or may not have a known #size and #byteSize." - containerType "^ <ExternalType | #undefined >" - "Answer the current containter type. Note that pointer types with unknown size cannot serve as container type." + "Check type. If you happen to have a regular pointer type here, convert it into array type of unknown size. This can happen for result values of FFI calls." + type asNonPointerType isArrayType + ifFalse: [self setType: type]. + + ^ type! - ^ size isNil - ifTrue: [ - self flag: #contentVsContainer. "mt: Maybe we should have an actual type for this kind of container?" - self assert: [type isPointerType]. - #undefined] - ifFalse: [ - self assert: [type asNonPointerType isArrayType]. - type asNonPointerType]! Item was changed: ----- Method: ExternalData>>contentType (in category 'accessing - types') ----- contentType "^ <ExternalType>" + "Answer the content type for the current container type." - "Answer the content type for the current container type. Handle the special case for pointer types with an unknown number of elements (i.e. #size)." + ^ self containerType asNonPointerType contentType! - | containerType contentType | - containerType := self containerType. - - containerType = #undefined - flag: #contentVsContainer; "mt: Our best guess is the non-pointer type." - assert: [type isPointerType]; - ifTrue: [ - (contentType := type asNonPointerType) isArrayType - flag: #initializationOnly; "mt: We are in the middle of initializing this external data. See #setType and #setSize: to learn more." - ifTrue: [contentType := contentType contentType]] - ifFalse: [ - contentType := containerType contentType]. - - ^ contentType! Item was changed: ----- Method: ExternalData>>detect:ifFound: (in category 'enumerating') ----- detect: aBlock ifFound: foundBlock "DANGEROUS for unknown size!!" self class allowDetectForUnknownSize ifFalse: [self sizeCheck]. + self size - size ifNotNil: [ self detect: aBlock ifFound: foundBlock ifNone: nil] ifNil: [ | index each | index := 1. [each := self at: index. (aBlock value: each) ifTrue: [^ foundBlock value: each] ifFalse: [index := index + 1. false]] whileFalse].! Item was changed: ----- Method: ExternalData>>externalType (in category 'accessing - types') ----- externalType "^ <ExternalType>" "Overwritten to answer our #containerType, which is important so that clients can then send #byteSize to the result." + ^ self containerType! - | result | - ^ (result := self containerType) = #undefined - ifFalse: [result] - ifTrue: [ - self flag: #contentVsContainer. "mt: Avoid leaking #undefined to the outside." - ExternalType void]! Item was changed: ----- Method: ExternalData>>free (in category 'initialize-release') ----- free + | ct | + self size ifNil: [^ super free "We don't know better"]. + + self flag: #todo. "mt: Add support for cycles. This simplification relies on the reuse of ExternalAddress and ByteArrayPointer, which is not the case. Double-free might happen for cycling structures." + ((ct := self contentType) isPointerType) + ifTrue: [self reader collect: [:each | each free]]. + super free. + self setSize: nil.! - size := nil.! Item was changed: ----- Method: ExternalData>>from:to: (in category 'accessing') ----- from: firstIndex to: lastIndex "Only copy data if already in object memory, that is, as byte array. Only check size if configured." | byteOffset numElements byteSize contentType | + ((1 > firstIndex) or: [self size notNil and: [lastIndex > self size]]) - ((1 > firstIndex) or: [size notNil and: [lastIndex > size]]) ifTrue: [^ self errorSubscriptBounds: lastIndex]. contentType := self contentType. byteOffset := ((firstIndex-1) * contentType byteSize)+1. numElements := lastIndex - firstIndex + 1 max: 0. byteSize := numElements * contentType byteSize. ^ ExternalData fromHandle: (handle structAt: byteOffset length: byteSize) type: contentType size: numElements! Item was removed: - ----- Method: ExternalData>>fromStringBounded (in category 'converting - support') ----- - fromStringBounded - "Read byte* as bounded string. You have to set a #size first." - - | offset step | - self - assert: [self contentType = ExternalType byte] - description: 'Wrong content type'. - - self sizeCheck. - - offset := 1. - step := self contentType byteSize. - - ^ String streamContents: [:s | - size timesRepeat: [ - s nextPut: (handle unsignedCharAt: offset). - offset := offset + step]]! Item was removed: - ----- Method: ExternalData>>getExternalData (in category 'accessing - external structures') ----- - getExternalData - "Reads all bytes into object memory. Note that this does not flatten all bytes into a single array by repeatedly calling it. Also note that this does only work for an external address. It does not copy what's already in object memory. Use #copy if you want to get a another copy in the object memory. Also see ExternalStructure >> #postCopy." - - | data | - handle isExternalAddress ifFalse: [^ self]. - - data := ByteArray new: self byteSize. - 1 to: data size do: [:index | - data unsignedByteAt: index put: (handle unsignedByteAt: index)]. - - ^ ExternalData - fromHandle: data - type: type - size: size! Item was removed: - ----- Method: ExternalData>>getExternalStructure (in category 'accessing - external structures') ----- - getExternalStructure - "Reads an external structure from this external data. If the receiver's handle is an external address, the structure's fields will be copied into object memory. Use #asExternalStructure if you want to avoid this copy." - - self - assert: [self contentType referentClass includesBehavior: ExternalStructure] - description: 'Wrong content type'. - - ^ handle isExternalAddress - ifTrue: [self getExternalData asExternalStructure] - ifFalse: [self asExternalStructure]! Item was removed: - ----- Method: ExternalData>>getExternalUnion (in category 'accessing - external structures') ----- - getExternalUnion - "Reads an external union from this external data. If the receiver's handle is an external address, the union's fields will be copied into object memory. Use #asExternalUnion if you want to avoid this copy." - - self - assert: [self contentType referentClass includesBehavior: ExternalUnion] - description: 'Wrong content type'. - - ^ handle isExternalAddress - ifTrue: [self getExternalData asExternalUnion] - ifFalse: [self asExternalUnion]! Item was added: + ----- Method: ExternalData>>isArray (in category 'testing') ----- + isArray + + ^ true! Item was added: + ----- Method: ExternalData>>isNull (in category 'testing') ----- + isNull + + handle isNil ifTrue:[^ true "internal memory already free'd"]. + handle isNull ifTrue: [^ true "external address already free'd"]. + + self size ifNil: [^ false "we don't know better"]. + + ^ false! Item was changed: ----- Method: ExternalData>>mightBeCString (in category 'testing') ----- mightBeCString + ^ self contentType = ExternalType char and: [self size isNil]! - self - assert: [(ExternalType char asArrayType: 1) asPointerType ~= ExternalType char asPointerType] - description: 'Unexpected reuse of pointer type char* for both atomic type and array type!!'. - - ^ type = ExternalType string "char*"! Item was changed: ----- Method: ExternalData>>pointerAt: (in category 'accessing - pointers') ----- pointerAt: index - | byteOffset | - byteOffset := ((index - 1) * ExternalAddress wordSize) + 1. - - self flag: #contentVsContainer. "mt: We should adjust this once we can support n-ary pointer types." - ^ handle pointerAt: byteOffset - - " self assert: [self contentType isPointerType]. + ^ self at: index! - ^ self at: index - "! Item was changed: ----- Method: ExternalData>>pointerAt:put: (in category 'accessing - pointers') ----- pointerAt: index put: value - | byteOffset | - byteOffset := ((index - 1) * ExternalAddress wordSize) + 1. - - self flag: #contentVsContainer. "mt: We should adjust this once we can support n-ary pointer types." - ^ handle pointerAt: byteOffset put: value - - " self assert: [self contentType isPointerType]. + ^ self at: index put: value! - ^ self at: index put: value - "! Item was added: + ----- Method: ExternalData>>postCopy (in category 'copying') ----- + postCopy + "Reads all bytes into object memory. Note that this does not flatten all bytes into a single array by repeatedly calling it. Also note that this does only work for an external address. It does not copy what's already in object memory." + + | bytes | + handle isExternalAddress ifFalse: [^ self]. + self sizeCheck. + + bytes := ByteArray new: self byteSize. + 1 to: bytes size do: [:index | + bytes basicAt: index put: (handle unsignedByteAt: index)]. + + handle := bytes. + self setType: type.! Item was changed: ----- Method: ExternalData>>setHandle:type:size: (in category 'private') ----- setHandle: aHandle type: contentType size: numElements + self + setHandle: aHandle + type: (contentType asArrayType: numElements).! - self setHandle: aHandle. - self setType: contentType. - self setSize: numElements.! Item was changed: ----- Method: ExternalData>>setSize: (in category 'private') ----- setSize: numElements "Set the size for the receiver, which will be used when enumerating its elements." + self setType: (self contentType asArrayType: numElements).! - | ct | - ct := self contentType. - size := numElements. - - self flag: #contentVsContainer. "mt: If we have a size, change the array type. If not, just hold on to the pointer type of the prior content type." - size - ifNil: [type := ct asPointerType] - ifNotNil: [type := (ct asArrayType: size) asPointerType].! Item was changed: ----- Method: ExternalData>>setType: (in category 'private') ----- + setType: containerType + "Private. Set the type used to derive content and container types." - setType: contentOrContainerType - "Private. Set the type used to derive content and container types. If we get an array type, also remember its size to distinguish its pointer type from other pointer types." + containerType asNonPointerType isArrayType + ifTrue: [type := containerType] + ifFalse: [type := (containerType asArrayType: nil)]. + + handle isExternalAddress + ifTrue: [type := type asPointerType] + ifFalse: [type := type asNonPointerType].! - type := contentOrContainerType asPointerType. - - contentOrContainerType isArrayType ifTrue: [ - self flag: #contentVsContainer. "mt: Note that we do not have to check whether the argument is actually the pointer type for an array type because those will usually be supplied with an extra call to #setSize: from the outside. See senders of #fromHandle:type:size:." - self setSize: contentOrContainerType size].! Item was changed: ----- Method: ExternalData>>size (in category 'accessing') ----- size "Answer how many elements the receiver contains." + ^ self containerType asNonPointerType size - ^ size ! Item was changed: ----- Method: ExternalData>>sizeCheck (in category 'private') ----- sizeCheck + self size ifNil: [self error: 'Size is unknown for this data pointer'].! - size ifNil: [self error: 'Size is unknown for this data pointer'].! Item was changed: + ----- Method: ExternalData>>value (in category 'accessing - globals') ----- - ----- Method: ExternalData>>value (in category 'accessing - external globals') ----- value "For convenience. Assume that the external data is just one global variable. Answer the value of that global variable." ^ self at: 1! Item was changed: + ----- Method: ExternalData>>value: (in category 'accessing - globals') ----- - ----- Method: ExternalData>>value: (in category 'accessing - external globals') ----- value: aValue "For convenience. Assume that the external data is just one global variable. Set the value of that global variable." self at: 1 put: aValue.! Item was changed: ----- Method: ExternalData>>writer (in category 'accessing') ----- writer + "Overwritten to preserve type." + + ^ handle isInternalMemory + ifTrue: [self class fromHandle: (ByteArrayReadWriter on: handle) type: type] + ifFalse: [self]! - "Overwritten to preserve type and size." - handle isInternalMemory ifFalse: [^ self]. - - ^ self class - fromHandle: (ByteArrayReadWriter on: handle) - type: type - size: size! Item was changed: ----- Method: ExternalData>>zeroMemory (in category 'initialize-release') ----- zeroMemory + "Remove all information but keep the memory allocated. Supports an array of pointers." - "Remove all information but keep the memory allocated." + | ct | + self isNull ifTrue: [^ self]. self sizeCheck. + + ((ct := self contentType) isPointerType) + ifTrue: [self writer do: [:each | each zeroMemory]] + ifFalse: [handle zeroMemory: self size * ct byteSize].! - - handle isExternalAddress - ifTrue: [handle zeroMemory: self size * self contentType byteSize] - ifFalse: [ "ByteArray" handle zeroMemory].! Item was added: + ----- Method: ExternalObject>>isExternalObject (in category 'testing') ----- + isExternalObject + + ^ true! Item was added: + ExternalType subclass: #ExternalPointerType + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Kernel'! Item was added: + ----- Method: ExternalPointerType>>handle:at: (in category 'external data') ----- + handle: handle at: byteOffset + + ^ referentClass + ifNotNil: [ + referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)] + ifNil: [ + ExternalData + fromHandle: (handle pointerAt: byteOffset length: self byteSize) + type: self asNonPointerType "content type"]! Item was added: + ----- Method: ExternalPointerType>>handle:at:put: (in category 'external data') ----- + handle: handle at: byteOffset put: value + + ^ handle + pointerAt: byteOffset + put: value getHandle + length: self byteSize! Item was added: + ----- Method: ExternalPointerType>>isArrayType (in category 'testing') ----- + isArrayType + + ^ false! Item was added: + ----- Method: ExternalPointerType>>isAtomic (in category 'testing') ----- + isAtomic + + ^ false! Item was added: + ----- Method: ExternalPointerType>>isPointerType (in category 'testing') ----- + isPointerType + + ^ true! Item was added: + ----- Method: ExternalPointerType>>isPointerTypeForArray (in category 'testing') ----- + isPointerTypeForArray + + ^ self asNonPointerType isArrayType! Item was added: + ----- Method: ExternalPointerType>>isStructureType (in category 'testing') ----- + isStructureType + + ^ false! Item was added: + ----- Method: ExternalPointerType>>isTypeAlias (in category 'testing') ----- + isTypeAlias + + ^ self headerWord allMask: ExternalType pointerAliasSpec! Item was added: + ----- Method: ExternalPointerType>>isUnknownType (in category 'testing') ----- + isUnknownType + + ^ false! Item was added: + ----- Method: ExternalPointerType>>newReferentClass: (in category 'private') ----- + newReferentClass: classOrNil + "The class I'm referencing has changed. Keep pointer types for array types free of the referentClass so that FFI calls return ExternalData." + + self isPointerTypeForArray + ifTrue: [referentClass := nil] + ifFalse: [referentClass := classOrNil].! Item was added: + ----- Method: ExternalPointerType>>newTypeAlias (in category 'private') ----- + newTypeAlias + "We should update our referencedType. No need to update the compiledSpec because there is no information encoded that would change if we change the kind of pointer type." + + self isTypeAlias ifFalse: [^ self]. + + referencedType := referentClass originalType asNonPointerType copy. + referencedType setReferencedType: self. + referencedType setReferentClass: referentClass.! Item was added: + ----- Method: ExternalPointerType>>originalType (in category 'accessing - type alias') ----- + originalType + "Overwritten to look into my referencedType. See #isTypeAliasReferenced." + + self isPointerTypeForArray ifTrue: [ + ^ self asNonPointerType originalType asPointerType]. + + ^ self "e.g. MyStructPtr" asNonPointerType isTypeAlias "e.g. *MyStructPtr" + ifTrue: [super originalType asPointerType "e.g. MyStruct*, not MyStruct"] + ifFalse: [super originalType]! Item was added: + ----- Method: ExternalPointerType>>readAlias (in category 'external structure') ----- + readAlias + " + ExternalStructure defineAllFields. + " + ^ 'self checkHandle. "Fix bug in FFI plugin."\ ^ {1} fromHandle: handle{2}' withCRs + format: { + (referentClass ifNil: [ExternalData]) name. + referentClass ifNotNil: [''] ifNil: [ + ' type: ', self asNonPointerType "content type" storeString]}! Item was added: + ----- Method: ExternalPointerType>>readFieldAt: (in category 'external structure') ----- + readFieldAt: byteOffset + " + ExternalStructure defineAllFields. + " + ^ '^ {1} fromHandle: (handle pointerAt: {2} length: {3}){4}' + format: { + (referentClass ifNil: [ExternalData]) name. + byteOffset. + self byteSize. + referentClass ifNotNil: [''] ifNil: [ + ' type: ', self asNonPointerType "content type" storeString]}! Item was added: + ----- Method: ExternalPointerType>>storeOn: (in category 'printing') ----- + storeOn: aStream + + self isTypeAlias + ifTrue: [ + aStream + nextPutAll: referentClass name; + nextPutAll: ' externalType'] + ifFalse: [ + self asNonPointerType storeOn: aStream. + aStream nextPutAll: ' asPointerType'].! Item was added: + ----- Method: ExternalPointerType>>typeName (in category 'accessing') ----- + typeName + + self asNonPointerType isArrayType + ifFalse: [^ super typeName]. + + "Special case for an array-type's pointer type. Answer would be void* if not treated. Also watch out for type alias. End with a $* to mark it a pointer type." + ^ String streamContents: [:stream | | inParentheses | + (inParentheses := self asNonPointerType isTypeAlias not) + ifTrue: [stream nextPut: $(]. + stream nextPutAll: self asNonPointerType typeName. + inParentheses ifTrue: [stream nextPut: $)]. + stream nextPut: $*]! Item was added: + ----- Method: ExternalPointerType>>writeAliasWith: (in category 'external structure') ----- + writeAliasWith: valueName + + ^ 'handle := {1} getHandle.' + format: {valueName}! Item was added: + ----- Method: ExternalPointerType>>writeFieldAt:with: (in category 'external structure') ----- + writeFieldAt: byteOffset with: valueName + + ^ 'handle pointerAt: {1} put: {2} getHandle length: {3}.' + format: { + byteOffset. + valueName. + self byteSize}! Item was changed: ExternalObject subclass: #ExternalStructure instanceVariableNames: '' classVariableNames: 'PreviousPlatform' poolDictionaries: 'FFIConstants' category: 'FFI-Kernel'! ExternalStructure class + instanceVariableNames: 'compiledSpec byteAlignment'! - instanceVariableNames: 'type compiledSpec byteAlignment'! !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: 'type compiledSpec byteAlignment'! Item was changed: ----- Method: ExternalStructure class>>compileTypeAliasSpec:withAccessors: (in category 'field definition - support') ----- compileTypeAliasSpec: spec withAccessors: aSymbol "Define all the fields in the receiver. Return the newly compiled spec." | fieldName fieldTypeName externalType | fieldName := spec first. fieldTypeName := spec second. externalType := (ExternalType typeNamed: fieldTypeName) ifNil: [self errorTypeNotFound: spec second]. (fieldName notNil and:[self shouldGenerate: fieldName policy: aSymbol]) ifTrue:[ self generateTypeAliasAccessorsFor: fieldName type: externalType]. externalType isPointerType ifTrue: ["Special case. Typedef for a pointer type, e.g., typedef char* LPSTR in Win32 API. Mark it as both structure and pointer. Note that #isPointerType will only answer true for the in-image pointer type, not the non-pointer alias for the pointer." self + setCompiledSpec: (WordArray with: ExternalType pointerAliasSpec) + byteAlignment: ExternalType pointerAliasAlignment] - flag: #isTypeAliasForPointer; - setCompiledSpec: (WordArray with: (ExternalType structureSpec bitOr: ExternalType pointerSpec)) - byteAlignment: ExternalType pointerAlignment] ifFalse: ["Usual case. Typedef for another struct type or atomic type. Just re-use compiled spec and extras from the aliased type." self flag: #isTypeAlias; setCompiledSpec: externalType compiledSpec byteAlignment: externalType byteAlignment].! Item was changed: ----- Method: ExternalStructure class>>doneCompiling (in category 'class management') ----- doneCompiling - "Base class changed to something that is an external structure now." + + [self compileFields] ifError: [ "Ignore unfinished field specs" ].! - self compiledSpec ifNil: [self compileFields].! Item was added: + ----- Method: ExternalStructure class>>originalType (in category 'type alias') ----- + originalType + + ^ ExternalType typeNamed: self originalTypeName! Item was added: + ----- Method: ExternalStructure>>asArray (in category 'converting') ----- + asArray + "Convert the receiver into an array. Note that pointer types need to be elevated as pointer type of the array type. The content type MUST be a non-pointer type because the handle will decide between internal memory or external address." + + | contentType arrayType | + contentType := self externalType asNonPointerType. + + contentType isAtomic ifTrue: [ + ^ (contentType allocate: 1) + at: 1 put: handle; + yourself]. + + arrayType := contentType asArrayType: 1. + self externalType isPointerType + ifTrue: [arrayType := arrayType asPointerType]. + + ^ ExternalData + fromHandle: handle + type: arrayType! Item was removed: - ----- Method: ExternalStructure>>asExternalData (in category 'converting') ----- - asExternalData - - ^ ExternalData - fromHandle: self getHandle - type: self externalType "content type" - size: 1! Item was removed: - ----- Method: ExternalStructure>>asExternalStructure (in category 'converting') ----- - asExternalStructure - - ^ self! Item was removed: - ----- Method: ExternalStructure>>asExternalUnion (in category 'converting') ----- - asExternalUnion - - ^ self! Item was added: + ----- Method: ExternalStructure>>byteSize (in category 'accessing') ----- + byteSize + "Answer the number of bytes used for my contents. If my handle is null, I do not require any bytes. If my handle is not null, my type will know the required bytes for my contents." + + ^ self isNull + ifTrue: [0] + ifFalse: [self externalType asNonPointerType "content type" byteSize]! Item was added: + ----- Method: ExternalStructure>>checkHandle (in category 'compatibility') ----- + checkHandle + + | type | + handle ifNil: [^ self "already free'd"]. + handle isExternalAddress ifTrue: [^ self "already ok"]. + + type := self class externalType. + self flag: #pointerAliasCompatibility. "mt: Bug in FFI plugin, which fails to answer ExternalAddress as handle for alias-to-pointer types." + + (type isPointerType and: [type isTypeAlias + and: [handle size = ExternalAddress wordSize]]) ifTrue: [ + handle := ExternalAddress fromByteArray: handle].! Item was added: + ----- Method: ExternalStructure>>checkHandleUndo (in category 'compatibility') ----- + checkHandleUndo + "See #checkHandle. Call this if the FFI call would not work with the ExternalAddress." + + | type | + self flag: #pointerAliasCompatibility. + + handle ifNil: [^ self "already free'd"]. + handle isInternalMemory ifTrue: [^ self "already ok"]. + + type := self class externalType. + (type isPointerType and: [type isTypeAlias + and: [handle size = ExternalAddress wordSize]]) ifTrue: [ + handle := handle changeClassTo: ByteArray].! Item was changed: ----- Method: ExternalStructure>>externalType (in category 'accessing') ----- externalType + self checkHandle. "Fix bug in FFI plugin." + ^ handle isExternalAddress + ifTrue: [self class externalType asPointerType] + ifFalse: [self class externalType asNonPointerType]! - ^ self class externalType! Item was changed: ----- Method: ExternalStructure>>free (in category 'initialize-release') ----- free "Free the handle pointed to by the receiver" + self externalType isPointerType + ifTrue: [handle isNull ifFalse: [handle free]] - handle isExternalAddress - ifTrue: [handle free; beNull] ifFalse: [handle := nil].! Item was changed: ----- Method: ExternalStructure>>isNull (in category 'testing') ----- isNull + + ^ (self externalType isPointerType and: [handle isNull]) + or: [handle isNil]! - - handle isInternalMemory - ifTrue: [^ handle isNull: self externalType]. - handle isExternalAddress - ifTrue: [^ handle isNull]. - ^ handle isNil! Item was changed: ----- Method: ExternalStructure>>postCopy (in category 'copying') ----- postCopy + "Copy external memory into object memory, shallowCopy otherwise." - "Copy external memory into object memory to not loose track of what to #free and what not. It's safer this way." + self externalType isPointerType + ifTrue: [handle := self asArray postCopy getHandle] - handle isExternalAddress - ifTrue: [handle := self asExternalData getExternalData getHandle] ifFalse: [handle := handle copy. "Materializes byte-array read-writer section if any"].! Item was changed: ----- Method: ExternalStructure>>printOn: (in category 'printing') ----- printOn: stream + | showBrackets | + showBrackets := self externalType isPointerType not. + + showBrackets ifTrue: [stream nextPutAll: '[']. - handle ifNil: [stream nextPutAll: '? ']. - handle isInternalMemory ifTrue: [stream nextPutAll: '[']. super printOn: stream. + showBrackets ifTrue: [stream nextPutAll: ']']. - handle ifNil: [stream nextPutAll: ' ?']. - handle isInternalMemory ifTrue: [stream nextPutAll: ']']. self printIdentityOn: stream.! Item was changed: ----- Method: ExternalStructure>>writer (in category 'accessing') ----- writer + self checkHandle. ^ handle isInternalMemory + "Wrap handle into helper to address offsets in the byte array without copy." - "Wrap handle into helper to address offsets in the byte array." ifTrue: [self class fromHandle: (ByteArrayReadWriter on: handle)] "Either alias-to-atomic or already in external memory." ifFalse: [self]! Item was changed: ----- Method: ExternalStructure>>zeroMemory (in category 'initialize-release') ----- zeroMemory "Remove all information but keep the memory allocated." + self externalType isPointerType + ifTrue: [handle zeroMemory: self byteSize] + ifFalse: [self externalType isAtomic + ifFalse: [handle zeroMemory: self byteSize] + ifTrue: [handle := handle class zero]].! - handle isExternalAddress - ifTrue: [handle zeroMemory: self externalType byteSize] - ifFalse: [handle isInternalMemory - ifTrue: [handle zeroMemory] - ifFalse: [ - "Alias-to-atomic type." - handle := handle class zero]].! Item was changed: ----- Method: ExternalStructureType class>>newTypeForStructureClass: (in category 'instance creation') ----- newTypeForStructureClass: anExternalStructureClass + | type pointerType referentClass | - | type referentClass | referentClass := anExternalStructureClass. self assert: [referentClass includesBehavior: ExternalStructure] description: 'Wrong base class for structure'. type := self newTypeForUnknownNamed: referentClass name. + pointerType := type asPointerType. referentClass compiledSpec ifNil: [ "First time. The referent class' fields are probably just compiled for the first time." + type setReferentClass: referentClass. + pointerType setReferentClass: referentClass] - type asNonPointerType setReferentClass: referentClass. - type asPointerType setReferentClass: referentClass] ifNotNil: [ + type newReferentClass: referentClass. + pointerType newReferentClass: referentClass]. + + ^ [type becomeKnownType] ifError: [ + self assert: [type isUnknownType]. + type "still unkown"]! - type asNonPointerType newReferentClass: referentClass. - type asPointerType newReferentClass: referentClass]. - - ^ type! Item was removed: - ----- Method: ExternalStructureType class>>newTypeForUnknownNamed: (in category 'instance creation') ----- - newTypeForUnknownNamed: typeName - - | type pointerType | - self - assert: [(StructTypes includesKey: typeName) not] - description: 'Structure type already exists. Use #typeNamed: to access it.'. - - type := self "ExternalStructureType" basicNew - compiledSpec: (WordArray with: self structureSpec); - yourself. - self assert: [type isEmpty]. - - pointerType := ExternalType basicNew - compiledSpec: (WordArray with: self pointerSpec); - yourself. - self assert: [pointerType isPointerType]. - - "Connect non-pointer type with pointer type." - type setReferencedType: pointerType. - pointerType setReferencedType: type. - - "Remember this new struct type." - StructTypes at: typeName asSymbol put: type. - - ^ type! Item was removed: - ----- Method: ExternalStructureType>>checkType (in category 'external structure') ----- - checkType - - self class extraTypeChecks ifFalse: [^ self]. - - self - assert: [self isPointerType not] - description: 'Convert to ExternalType to use this feature'. - - referentClass ifNil: [self error: 'Unknown structure type']. - self isEmpty ifTrue: [self error: 'Empty structure']. - ! Item was changed: ----- Method: ExternalStructureType>>handle:at: (in category 'external data') ----- handle: handle at: byteOffset - "Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:." - - | result | - self checkType. + ^ referentClass fromHandle: (handle structAt: byteOffset length: self byteSize)! - result := self isAtomic - ifTrue: [ - handle "alias to atomic" - perform: (AtomicSelectors at: self atomicType) - with: byteOffset] - ifFalse: [ - handle "regular struct or alias to struct or alias to pointer" - structAt: byteOffset length: self byteSize]. - - ^ referentClass fromHandle: result! Item was changed: ----- Method: ExternalStructureType>>handle:at:put: (in category 'external data') ----- handle: handle at: byteOffset put: value - "Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:." + ^ handle + structAt: byteOffset + put: value getHandle + length: self byteSize! - self checkType. - - self isAtomic - ifTrue: [ "alias to atomic" - self class extraTypeChecks ifTrue: [ - self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."]. - ^ handle - perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol - with: byteOffset - with: value getHandle] - ifFalse: [ "regular struct or alias to struct or alias to pointer" - self class extraTypeChecks ifTrue: [ - self assert: [value externalType == self]]. - ^ handle - structAt: byteOffset - put: value getHandle - length: self byteSize].! Item was added: + ----- Method: ExternalStructureType>>isArrayType (in category 'testing') ----- + isArrayType + + ^ false! Item was added: + ----- Method: ExternalStructureType>>isAtomic (in category 'testing') ----- + isAtomic + + ^ false! Item was removed: - ----- Method: ExternalStructureType>>isEmpty (in category 'testing') ----- - isEmpty - "Return true if the receiver represents a structure type" - ^ self byteSize = 0! Item was removed: - ----- Method: ExternalStructureType>>isFloatType (in category 'testing') ----- - isFloatType - "Overwritten to not raise an error for struct types." - - ^ false! Item was removed: - ----- Method: ExternalStructureType>>isIntegerType (in category 'testing') ----- - isIntegerType - "Overwritten to not raise an error for struct types." - - ^ false! Item was added: + ----- Method: ExternalStructureType>>isPointerType (in category 'testing') ----- + isPointerType + + ^ false! Item was added: + ----- Method: ExternalStructureType>>isStructureType (in category 'testing') ----- + isStructureType + + ^ true! Item was changed: ----- Method: ExternalStructureType>>isTypeAlias (in category 'testing') ----- isTypeAlias + ^ referentClass notNil + and: [referentClass isTypeAlias + and: [referentClass originalType isStructureType]]! - ^ referentClass notNil and: [referentClass isTypeAlias]! Item was removed: - ----- Method: ExternalStructureType>>isTypeAliasForAtomic (in category 'testing') ----- - isTypeAliasForAtomic - "Answer whether this type aliases an atomic type, e.g., typedef ulong ID" - "See ThreadedFFIPlugin >> ffiArgument: oop Spec: argSpec Class: argClass in: calloutState" - - ^ self isTypeAlias and: [self isStructureType not and: [self isAtomic]]! Item was removed: - ----- Method: ExternalStructureType>>isTypeAliasForPointer (in category 'testing') ----- - isTypeAliasForPointer - "Answer whether this type aliases a pointer type, e.g., typedef char* charptr_t" - "See ThreadedFFIPlugin >> ffiArgument: oop Spec: argSpec Class: argClass in: calloutState" - - "Note that self isTypeAliasForPointer => [self isPointerType not]" - ^ self isTypeAlias and: [self isStructureType and:[self headerWord anyMask: FFIFlagPointer]]! Item was added: + ----- Method: ExternalStructureType>>isUnknownType (in category 'testing') ----- + isUnknownType + + ^ false! Item was added: + ----- Method: ExternalStructureType>>newTypeAlias (in category 'private') ----- + newTypeAlias + + "self isTypeAlias ifFalse: [^ self]." + "Nothing to do. My referentClass was already upated." + ! Item was changed: + ----- Method: ExternalStructureType>>originalType (in category 'accessing - type alias') ----- - ----- Method: ExternalStructureType>>originalType (in category 'accessing') ----- originalType + "Overwritten to look into my referencedType. See #isTypeAliasReferenced." + + ^ self "e.g. *MyStructPtr" asPointerType isTypeAlias "e.g. MyStructPtr" + ifTrue: [super originalType asNonPointerType "e.g. MyStruct, not MyStruct*"] + ifFalse: [super originalType]! - "Resolve original type for alias. Error if not a type alias." - - ^ ExternalType typeNamed: self originalTypeName! Item was removed: - ----- Method: ExternalStructureType>>originalTypeName (in category 'accessing') ----- - originalTypeName - "Resolve original type for alias. Error if not a type alias." - - ^ referentClass ifNotNil: [referentClass originalTypeName]! Item was added: + ----- Method: ExternalStructureType>>printContentsOn: (in category 'printing') ----- + printContentsOn: aStream + + self isEmpty + ifTrue: [aStream nextPutAll: ' { void }'] + ifFalse: [super printContentsOn: aStream].! Item was changed: ----- Method: ExternalStructureType>>printOn: (in category 'printing') ----- printOn: aStream + referentClass + ifNil: [aStream nextPutAll: '<unknown struct type>'] + ifNotNil: [super printOn: aStream].! - self isTypeAlias ifTrue: [ - aStream nextPutAll: self typeName. - aStream - nextPutAll: '~>'; - print: self originalType. - self isEmpty - ifTrue: [aStream nextPutAll: ' ???']. - ^ self]. - - referentClass == nil - ifTrue:[aStream nextPutAll: '<unknown struct type>'] - ifFalse:[ - super printOn: aStream. - self isEmpty - ifTrue: [aStream nextPutAll: ' { void }']].! Item was changed: ----- Method: ExternalStructureType>>readAlias (in category 'external structure') ----- readAlias - "this is an aliased structure type, which can itself be a regular struct or an alias to another struct or an alias to a pointer" + ^ '^ {1} fromHandle: handle' + format: {referentClass name}! - self checkType. - - ^ String streamContents: [:s | - s nextPutAll: '^', referentClass name,' fromHandle: handle']! Item was changed: ----- Method: ExternalStructureType>>readFieldAt: (in category 'external structure') ----- 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." + ^ '^ {1} fromHandle: (handle structAt: {2} length: {3})' + format: { + referentClass name. + byteOffset. + self byteSize}! - self checkType. - - self isAtomic - ifTrue: [ "alias to atomic" - ^ String streamContents:[:s | - s nextPutAll:'^'; - print: referentClass; - nextPutAll:' fromHandle: (handle '; - nextPutAll: (AtomicSelectors at: self atomicType); - space; print: byteOffset; - nextPutAll:')']] - ifFalse: [ "regular struct or alias to struct or alias to pointer" - ^ String streamContents:[:s| - s nextPutAll:'^'; - print: referentClass; - nextPutAll:' fromHandle: (handle'. - self isTypeAliasForPointer - ifFalse: [ - s nextPutAll: ' structAt: '; - print: byteOffset; - nextPutAll:' length: '; - print: self byteSize; - nextPutAll:')'] - ifTrue: [ - s nextPutAll: ' pointerAt: '; - print: byteOffset; - nextPutAll: ' length: '; - print: self byteSize; - nextPutAll: ') asByteArrayPointer']]]! Item was changed: ----- Method: ExternalStructureType>>storeOn: (in category 'printing') ----- storeOn: aStream + + self asPointerType isTypeAlias + ifTrue: [ + aStream + nextPutAll: referentClass name; + nextPutAll: ' externalType asNonPointerType'] + ifFalse: [super storeOn: aStream].! - - referentClass ifNil: [ - "unknown struct type" - ^ aStream nextPutAll: 'nil']. - - aStream - nextPut: $(; - nextPutAll: ExternalType name; space; - nextPutAll: #structTypeNamed:; space; - store: referentClass name; - nextPut: $).! Item was changed: ----- Method: ExternalStructureType>>writeAliasWith: (in category 'external structure') ----- writeAliasWith: valueName - "this is an aliased structure type" - "expect the value have that structure type with either byte array or external address as handle" + ^ 'handle := {1} getHandle.' + format: {valueName}! - self checkType. - - ^ String streamContents: [:s | - self class extraTypeChecks ifTrue: [ - s nextPutAll: ('self assert: [{1} class externalType == {2}].' format: {valueName. self storeString}); crtab]. - s nextPutAll:'handle := ', valueName,' getHandle']! Item was removed: - ----- Method: ExternalStructureType>>writeFieldArgName (in category 'external structure') ----- - writeFieldArgName - - ^ 'a',referentClass name! Item was changed: ----- Method: ExternalStructureType>>writeFieldAt:with: (in category 'external structure') ----- 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." + ^ 'handle structAt: {1} put: {2} getHandle length: {3}.' + format: { + byteOffset. + valueName. + self byteSize}! - self checkType. - - ^String streamContents:[:s| - self isAtomic - ifTrue: [ "alias to atomic" - self class extraTypeChecks ifTrue: [ - self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."]. - s nextPutAll:'handle '; - nextPutAll: (AtomicSelectors at: self atomicType); - space; print: byteOffset; - nextPutAll:' put: '; - nextPutAll: valueName; - nextPutAll: ' getHandle'] - ifFalse: [ "regular struct or alias to struct or alias to pointer" - self class extraTypeChecks ifTrue: ["expect either byte array or external address as handle" - s nextPutAll: ('self assert: [{1} class externalType == {2}].' format: {valueName. self storeString}); crtab]. - - self isTypeAliasForPointer - ifFalse: [ - s nextPutAll:'handle structAt: '; - print: byteOffset; - nextPutAll:' put: '; - nextPutAll: valueName; - nextPutAll:' getHandle'; - nextPutAll:' length: '; - print: self byteSize; - nextPutAll:'.'] - ifTrue: [ - s nextPutAll:'handle pointerAt: '; - print: byteOffset; - nextPutAll:' put: '; - nextPutAll: valueName; - nextPutAll:' getHandle asExternalPointer'; - nextPutAll:' length: '; - print: self byteSize; - nextPutAll:'.']]].! Item was changed: ----- Method: ExternalType class>>arrayTypeFor:size: (in category 'instance lookup') ----- arrayTypeFor: contentType size: numElements "Lookup fails if content type is not present." + ^ ((ArrayTypes + at: contentType typeName + ifAbsentPut: [WeakValueDictionary new]) + at: numElements ifAbsent: [nil]) + ifNil: [ + self + newTypeForContentType: contentType + size: numElements]! - | key | - key := contentType typeName -> numElements. - ^ (ArrayTypes at: key ifAbsent: [nil]) - ifNil: [ - ArrayTypes removeKey: key ifAbsent: []. - self - newTypeForContentType: contentType - size: numElements]! Item was changed: ----- Method: ExternalType class>>arrayTypeNamed: (in category 'instance lookup') ----- arrayTypeNamed: typeName "Answers an array type for the content type and size specified in the typeName, e.g. char[10] or MyStruct[5]. Lookup fails silently (i.e. nil) if content type does not exist." + | arraySpec contentType numElements | - | arraySpec | arraySpec := self parseArrayTypeName: typeName. + contentType := arraySpec second. + numElements := arraySpec third. - arraySpec second ifNil: [ ^ nil "content type unknown" ]. - arraySpec third ifNil: [arraySpec at: 3 put: 0]. + contentType ifNil: [ ^ nil "content type unknown" ]. + contentType isUnknownType + ifTrue: [ ^ nil "content type not initialized" ]. + ^ self arrayTypeFor: arraySpec second size: arraySpec third! Item was added: + ----- Method: ExternalType class>>arrayTypeNames (in category 'instance list') ----- + arrayTypeNames + "Answers the names of the currently known array types." + + ^ self arrayTypes collect: [:each | each typeName]! Item was added: + ----- Method: ExternalType class>>arrayTypes (in category 'instance list') ----- + arrayTypes + "Answers the currently known array types." + + ^ Array streamContents: [:stream | + self arrayTypesDo: [:type | stream nextPut: type]]! Item was added: + ----- Method: ExternalType class>>arrayTypesDo: (in category 'instance list') ----- + arrayTypesDo: block + + ArrayTypes do: [:sizes | sizes do: [:each | + each notNil "may be garbage collected" + ifTrue: [block value: each]]]. + + "Type aliases to array types are managed in StructTypes but are actual array types." + StructTypes do: [:each | + (each notNil "may be garbage collected" and: [each isArrayType]) + ifTrue: [block value: each]].! Item was added: + ----- Method: ExternalType class>>atomicTypeNames (in category 'instance list') ----- + atomicTypeNames + "Answers the names of the currently known atomic types." + + ^ AtomicTypeNames asArray! Item was added: + ----- Method: ExternalType class>>atomicTypes (in category 'instance list') ----- + atomicTypes + "Answers the currently known atomic types." + + ^ Array streamContents: [:stream | + self atomicTypesDo: [:type | stream nextPut: type]]! Item was added: + ----- Method: ExternalType class>>atomicTypesDo: (in category 'instance list') ----- + atomicTypesDo: block + + AtomicTypeNames do: [:typeName | + block value: (AtomicTypes at: typeName)]! Item was changed: ----- Method: ExternalType class>>cleanupUnusedTypes (in category 'housekeeping') ----- cleanupUnusedTypes "In the lookup table for struct types and array types, remove keys to types no longer present.. ExternalType cleanupUnusedTypes " Smalltalk garbageCollect. StructTypes keys do: [:key | (StructTypes at: key) ifNil: [ StructTypes removeKey: key]]. + + ArrayTypes keys do: [:contentTypeName | + | sizes | + sizes := ArrayTypes at: contentTypeName. + sizes keys do: [:size | + (sizes at: size) ifNil: [sizes removeKey: size]]. + sizes ifEmpty: [ + ArrayTypes removeKey: contentTypeName]].! - ArrayTypes keys do: [:key | - (ArrayTypes at: key) ifNil: [ - ArrayTypes removeKey: key]].! Item was changed: ----- Method: ExternalType class>>initializeDefaultTypes (in category 'class initialization') ----- initializeDefaultTypes + "Create new atomic types and setup the dictionaries. See #resetAllAtomicTypes." + + 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]]. + - "ExternalType initialize" - | type pointerType | - AtomicTypes = nil ifTrue:[ - "Create new atomic types and setup the dictionaries" - AtomicTypes := Dictionary new. - AtomicTypeNames valuesDo:[:k| - type := self basicNew. - pointerType := self basicNew. - AtomicTypes at: k put: type. - type setReferencedType: pointerType. - pointerType setReferencedType: type. - ]. - ]. self initializeAtomicTypes. + self initializeStructureTypes.! - self initializeStructureTypes. - "AtomicTypes := nil"! Item was changed: ----- Method: ExternalType class>>initializeStructureTypes (in category 'class initialization') ----- initializeStructureTypes "Reset all non-pointer struct types to zero and their pointer companions to the appropriate pointer size." StructTypes ifNil: [ StructTypes := WeakValueDictionary new]. ArrayTypes ifNil: [ + ArrayTypes := Dictionary new]. - ArrayTypes := WeakValueDictionary new]. 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 | - ArrayTypes valuesDo: [:arrayType | arrayType compiledSpec: (WordArray with: (arrayType headerWord bitClear: FFIStructSizeMask)); byteAlignment: nil. arrayType asPointerType compiledSpec: (WordArray with: self pointerSpec); + byteAlignment: nil]].! - byteAlignment: nil].! Item was added: + ----- Method: ExternalType class>>newTypeForAtomicNamed: (in category 'instance creation') ----- + newTypeForAtomicNamed: atomicTypeName + + ^ ExternalAtomicType newTypeForAtomicNamed: atomicTypeName! Item was changed: ----- Method: ExternalType class>>newTypeForUnknownNamed: (in category 'instance creation') ----- newTypeForUnknownNamed: typeName + ^ ExternalUnknownType newTypeForUnknownNamed: typeName! - ^ ExternalStructureType newTypeForUnknownNamed: typeName! 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 #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 ifNil: [self newTypeForUnknownNamed: aTypeName] ifNotNil: [self newTypeForStructureClass: structClass]! Item was changed: ----- Method: ExternalType class>>noticeModificationOf: (in category 'housekeeping') ----- noticeModificationOf: aClass "A subclass of ExternalStructure has been redefined. Clean out any obsolete references to its type." + aClass withAllSubclassesDo: [:cls | | typeName type | - aClass withAllSubclassesDo: [:cls | | typeName | typeName := cls name. + + ArrayTypes at: typeName ifPresent: [:sizes | + sizes do: [:arrayType | arrayType ifNotNil: [ + arrayType newReferentClass: cls. + arrayType asPointerType newReferentClass: cls]]]. + + (type := StructTypes at: typeName ifAbsent: []) + ifNotNil: [ - (StructTypes at: typeName ifAbsent: []) - ifNotNil: [:type | type newReferentClass: cls. + type asPointerType newReferentClass: cls. + type newTypeAlias]]! - type asPointerType newReferentClass: cls]. - ArrayTypes keysAndValuesDo: [:nameSpec :arrayType | - arrayType ifNotNil: [ - nameSpec key = typeName "content type" ifTrue: [ - arrayType newReferentClass: cls. - arrayType asPointerType newReferentClass: cls]]]]! Item was changed: ----- Method: ExternalType class>>noticeRemovalOf: (in category 'housekeeping') ----- noticeRemovalOf: aClass "A subclass of ExternalStructure is being removed. Clean out any obsolete references to its type." | type | type := StructTypes at: aClass name ifAbsent:[nil]. type == nil ifFalse:[ type newReferentClass: nil. type asPointerType newReferentClass: nil]. + ArrayTypes at: aClass name ifPresent: [:sizes | + sizes do: [:arrayType | + arrayType newReferentClass: nil. + arrayType asPointerType newReferentClass: nil]].! - ! Item was changed: ----- Method: ExternalType class>>noticeRenamingOf:from:to: (in category 'housekeeping') ----- noticeRenamingOf: aClass from: oldName to: newName "An ExternalStructure has been renamed from oldName to newName. Keep our type names in sync." (StructTypes at: oldName ifAbsent:[nil]) ifNotNil: [:type | StructTypes at: newName put: type]. StructTypes removeKey: oldName ifAbsent: []. + (ArrayTypes at: oldName ifAbsent: [nil]) + ifNotNil: [:sizes | ArrayTypes at: newName put: sizes]. + ArrayTypes removeKey: oldName ifAbsent: [].! - ArrayTypes keys do: [:nameSpec | - nameSpec key = oldName ifTrue: [ - nameSpec key: newName]]. - ArrayTypes rehash.! Item was added: + ----- Method: ExternalType class>>pointerAliasAlignment (in category 'private') ----- + pointerAliasAlignment + ^ self pointerAlignment! Item was added: + ----- Method: ExternalType class>>pointerAliasSpec (in category 'private') ----- + pointerAliasSpec + "Answers a mask to check the #headerWord for a type alias to a pointer type." + ^ self structureSpec bitOr: self pointerSpec! Item was added: + ----- Method: ExternalType class>>pointerTypeNames (in category 'instance list') ----- + pointerTypeNames + + ^ self pointerTypes collect: [:each | each typeName]! Item was added: + ----- Method: ExternalType class>>pointerTypes (in category 'instance list') ----- + pointerTypes + "Answers the currently known pointer types, including type-alias-to-pointer types." + + ^ Array streamContents: [:stream | + self pointerTypesDo: [:type | stream nextPut: type]]! Item was added: + ----- Method: ExternalType class>>pointerTypesDo: (in category 'instance list') ----- + pointerTypesDo: block + "Answers the currently known pointer types, including type-alias-to-pointer types." + + self atomicTypesDo: [:type | + block value: type asPointerType]. + self structTypesDo: [:type | + block value: type asPointerType]. + self arrayTypesDo: [:type | + block value: type asPointerType]. + + "Type aliases to pointer types are managed in StructTypes but are actual pointer types." + StructTypes do: [:each | (each notNil and: [each isPointerType]) + ifTrue: [block value: each]].! Item was added: + ----- Method: ExternalType class>>resetAllTypes (in category 'housekeeping') ----- + resetAllTypes + "If we reset the atomic types, we reset everything else." + + self resetAllAtomicTypes.! Item was changed: ----- Method: ExternalType class>>structTypeNamed: (in category 'instance lookup') ----- structTypeNamed: typeName "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: [ "Create struct types for existing struct classes on-the-fly." - ifNil: [ StructTypes removeKey: typeName ifAbsent: []. + (self environment classNamed: typeName) + ifNotNil: [:cls | (cls includesBehavior: ExternalStructure) ifTrue: [ + self newTypeNamed: typeName]]]! - self newTypeNamed: typeName]! Item was added: + ----- Method: ExternalType class>>structTypeNames (in category 'instance list') ----- + structTypeNames + "Answers the names of the currently known struct types." + + ^ self structTypes collect: [:each | each typeName]! Item was added: + ----- Method: ExternalType class>>structTypes (in category 'instance list') ----- + structTypes + "Answers the currently known struct types, including type-alias-to-atomic and type-alias-to-struct types." + + ^ Array streamContents: [:stream | + self structTypesDo: [:type | stream nextPut: type]]! Item was added: + ----- Method: ExternalType class>>structTypesDo: (in category 'instance list') ----- + structTypesDo: block + "Enumerate all struct types. Includes types for packed structs and unions." + + StructTypes do: [:each | (each notNil and: [each isStructureType]) + ifTrue: [block value: each]]! Item was added: + ----- Method: ExternalType class>>typeAliasTypeNames (in category 'instance list') ----- + typeAliasTypeNames + + ^ self typeAliasTypes collect: [:each | each typeName]! Item was added: + ----- Method: ExternalType class>>typeAliasTypes (in category 'instance list') ----- + typeAliasTypes + "Answers the currently known type-alias types." + + ^ Array streamContents: [:stream | + self typeAliasTypesDo: [:type | stream nextPut: type]]! Item was added: + ----- Method: ExternalType class>>typeAliasTypesDo: (in category 'instance list') ----- + typeAliasTypesDo: block + "All type alias types are managed in StructTypes for easy reference via #referentClass." + + StructTypes do: [:each | each ifNotNil: [:type | + type isTypeAlias ifTrue: [block value: type]]]! Item was changed: ----- Method: ExternalType class>>typeNamed: (in category 'instance lookup') ----- typeNamed: typeName "Supports pointer-type lookup for both atomic and structure types. + Examples: 'long', 'long*', 'long *' or 'MyStruct', 'MyStruct*', 'MyStruct *', 'IntPtr', '*IntPtr' " - Examples: 'long', 'long*', 'long *' or 'MyStruct', 'MyStruct*', 'MyStruct *'" + | isPointerType isNonPointerType isArrayType actualTypeName type | + isArrayType := false. isNonPointerType := false. + actualTypeName := typeName copyWithoutAll: ' '. - | isPointerType isArrayType actualTypeName type | - isArrayType := false. - (isPointerType := typeName last == $*) - ifTrue: [actualTypeName := typeName allButLast withoutTrailingBlanks] - ifFalse: [(isArrayType := typeName last == $]) - ifFalse: [actualTypeName := typeName]]. + (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 - ifTrue: [^ self arrayTypeNamed: typeName]. + (isArrayType := actualTypeName last == $]) + ifTrue: [ type := self arrayTypeNamed: actualTypeName ] + ifFalse: [ + (Symbol lookup: actualTypeName) + ifNotNil: [:sym | actualTypeName := sym]. + type := (self atomicTypeNamed: actualTypeName) + ifNil: [self structTypeNamed: actualTypeName]]. - (Symbol lookup: actualTypeName) - ifNotNil: [:sym | actualTypeName := sym]. + ^ 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 "]]]! - type := (self atomicTypeNamed: actualTypeName) - ifNil: [self structTypeNamed: actualTypeName]. - - ^ type ifNotNil: [isPointerType ifTrue: [type asPointerType] ifFalse: [type]]! Item was changed: ----- Method: ExternalType>>allocate (in category 'external data') ----- allocate "Allocate a single representative for this type." + ^ (self asNonPointerType allocate: 1) first! - self isPointerType ifTrue: [ - self flag: #workaround. "mt: Better support for multi-dimensional containers needed." - ^ ExternalType void asPointerType allocate: 1]. - - ^ (self allocate: 1) first! Item was changed: ----- Method: ExternalType>>allocate: (in category 'external data') ----- allocate: numElements "Allocate space for containing an array of numElements of this dataType" | handle | - self - flag: #contentVsContainer; - assert: [self isPointerType not or: [self isVoid]] - description: 'No support for n-dimensional containers. Allocate for void* as workaround.'; - assert: [self byteSize > 0] - description: 'Invalid byte size.'. - handle := ByteArray new: self byteSize * numElements. ^ExternalData fromHandle: handle type: self size: numElements! Item was changed: ----- Method: ExternalType>>allocateExternal (in category 'external data') ----- allocateExternal "Allocate a single representative for this type in external memory." + | result | + ^ [(result := self asNonPointerType allocateExternal: 1) first] + ensure: [ self isAtomic ifTrue: [result free] ]! - | result | - self isPointerType ifTrue: [ - self flag: #workaround. "mt: Better support for multi-dimensional containers needed." - ^ ExternalType void asPointerType allocateExternal: 1]. - - "By design, aliased pointers are stored as byte array." - self isTypeAliasForPointer ifTrue: [^ self allocate]. - - ^ [(result := self allocateExternal: 1) first] - ensure: [ - "Atomics and alias-to-atomic are immediately available in object memory. We thus must free the external memory to avoid leaks." - self isStructureType ifFalse: [result free]]! Item was changed: ----- Method: ExternalType>>allocateExternal: (in category 'external data') ----- allocateExternal: numElements "Allocate space for containing an array of numElements of this type. Note that we zero the memory for safe use. If you do not need that, please use ExternalAddress class >> #allocate: directly. BE AWARE that structs can have pointers tools automatically follow and thus risking a SEGFAULT and hence VM CRASH for uninitalized memory." + | handle arrayByteSize | + arrayByteSize := self byteSize * numElements. + handle := ExternalAddress allocateZero: arrayByteSize. + ^ ExternalData fromHandle: handle type: self size: numElements! - | handle | - self - flag: #contentVsContainer; - assert: [self isPointerType not or: [self isVoid]] - description: 'No support for n-dimensional containers. Allocate for void* as workaround.'; - assert: [self byteSize > 0] - description: 'Invalid byte size.'. - - handle := ExternalAddress allocate: self byteSize * numElements. - ^(ExternalData fromHandle: handle type: self size: numElements) - zeroMemory; - yourself! Item was added: + ----- Method: ExternalType>>asExternalType (in category 'converting') ----- + asExternalType + + ^ self! Item was added: + ----- Method: ExternalType>>becomeStructureType (in category 'private - type alias') ----- + becomeStructureType + + self class = ExternalStructure ifTrue: [^ self]. + + self class = ExternalPointerType ifTrue: [ + | newPointerType | + "We are not a type alias for a pointer type anymore." + self changeClassTo: ExternalStructureType. + + "Fetch my updated spec as a structure type." + compiledSpec := referentClass compiledSpec. + byteAlignment := referentClass byteAlignment. + + "Prepare and set my new, dedicated pointer type." + (newPointerType := ExternalPointerType basicNew) + compiledSpec: (WordArray with: self class pointerSpec); + byteAlignment: self class pointerAlignment; + setReferentClass: referentClass; + setReferencedType: self. + referencedType := newPointerType. + + "Done. Answer self because of #changeClassTo:." + ^ self]. + + self class = ExternalArrayType ifTrue: [ + "An not #isTypeAliasForArray anymore. :-( " + | newStructType | + newStructType := ExternalStructureType basicNew + compiledSpec: self compiledSpec; + byteAlignment: self byteAlignment; + setReferentClass: referentClass; + setReferencedType: referencedType; + yourself. + + "Not a pointer type for array type anymore." + referencedType setReferentClass: referentClass. + + self becomeForward: newStructType. + self assert: [newStructType class = ExternalStructureType]. + ^ newStructType].! Item was removed: - ----- Method: ExternalType>>checkType (in category 'external structure') ----- - checkType - - self class extraTypeChecks ifFalse: [^ self]. - - (self isPointerType not and: [referentClass notNil]) - ifTrue: [self error: 'Must convert to ExternalStructureType before use']. - - self - assert: [self isStructureType not] - description: 'Convert to ExternalStructureType to use this feature'.! Item was changed: ----- Method: ExternalType>>handle:at: (in category 'external data') ----- handle: handle at: byteOffset "Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:." + + self subclassResponsibility.! - - self checkType. - - self isPointerType - ifFalse: [ - "Answer atomic value" - ^ handle - perform: (AtomicSelectors at: self atomicType) - with: byteOffset] - ifTrue: [ - ^ referentClass - ifNotNil: [ - "Answer structure, union, or type alias" - referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)] - ifNil: [ - "Answer wrapper that points to external data, unknown size (i.e. number of elements)" - ExternalData - fromHandle: (handle pointerAt: byteOffset length: self byteSize) - type: self ]]! Item was changed: ----- Method: ExternalType>>handle:at:put: (in category 'external data') ----- handle: handle at: byteOffset put: value "Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:." + self subclassResponsibility.! - self checkType. - - self isPointerType - ifFalse: [ "set atomic value" - self class extraTypeChecks ifTrue: [ - self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."]. - handle - perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol - with: byteOffset - with: value] - ifTrue: [ "set pointer to struct/union/alias" - self class extraTypeChecks ifTrue: [ - self assert: [value externalType == self]]. - handle - pointerAt: byteOffset - put: value getHandle - length: self byteSize].! Item was changed: ----- Method: ExternalType>>isArrayType (in category 'testing') ----- isArrayType + self flag: #todo. "mt: Change once encoded in headerWord. See #isAtomic for inspiration." ^ false! Item was changed: ----- Method: ExternalType>>isAtomic (in category 'testing') ----- isAtomic "Return true if the receiver describes a built-in type" + + ^ (self headerWord anyMask: FFIFlagAtomic) + and: [self headerWord noMask: FFIFlagPointer]! - ^self headerWord anyMask: FFIFlagAtomic! Item was added: + ----- Method: ExternalType>>isEmpty (in category 'testing - special') ----- + isEmpty + + ^ self byteSize = 0! Item was changed: ----- Method: ExternalType>>isPointerType (in category 'testing') ----- isPointerType + + ^ self headerWord anyMask: FFIFlagPointer! - "Return true if the receiver represents a pointer type" - ^self isStructureType not and:[self headerWord anyMask: FFIFlagPointer]! Item was changed: ----- Method: ExternalType>>isStructureType (in category 'testing') ----- isStructureType "Return true if the receiver represents a structure type" + + ^ (self headerWord anyMask: FFIFlagStructure) + and: [self headerWord noMask: FFIFlagPointer "alias to pointer type"] + and: [self isArrayType not "alias to array type"]! - ^self headerWord anyMask: FFIFlagStructure! Item was changed: ----- Method: ExternalType>>isTypeAlias (in category 'testing') ----- isTypeAlias + + self subclassResponsibility.! - - ^ false! Item was removed: - ----- Method: ExternalType>>isTypeAliasForPointer (in category 'testing') ----- - isTypeAliasForPointer - - ^ false! Item was added: + ----- Method: ExternalType>>isTypeAliasReferenced (in category 'testing') ----- + isTypeAliasReferenced + "Answer whether this type is the referencedType of a type alias." + + ^ referencedType notNil and: [referencedType isTypeAlias]! Item was added: + ----- Method: ExternalType>>isUnknownType (in category 'testing') ----- + isUnknownType + + ^ (self isAtomic + or: [self isPointerType + or: [self isStructureType + or: [self isArrayType]]]) not! Item was changed: + ----- Method: ExternalType>>isVoid (in category 'testing - special') ----- - ----- Method: ExternalType>>isVoid (in category 'testing') ----- isVoid "Return true if the receiver describes a plain 'void' type" ^self isAtomic and:[self atomicType = 0]! Item was changed: ----- Method: ExternalType>>newReferentClass: (in category 'private') ----- newReferentClass: classOrNil - "The class I'm referencing has changed. Update my spec." + referentClass := classOrNil.! - referentClass := classOrNil. - self assert: [referentClass isNil or: [self isAtomic not and: [self isPointerType]]].! Item was added: + ----- Method: ExternalType>>newTypeAlias (in category 'private') ----- + newTypeAlias + + self subclassResponsibility.! Item was added: + ----- Method: ExternalType>>originalType (in category 'accessing - type alias') ----- + originalType + "Resolve original type for alias. Error if not a type alias." + + ^ referentClass originalType! Item was removed: - ----- Method: ExternalType>>pointerSize (in category 'accessing') ----- - pointerSize - - ^ self asPointerType headerWord bitAnd: FFIStructSizeMask! Item was added: + ----- Method: ExternalType>>printContentsOn: (in category 'printing') ----- + printContentsOn: aStream + + aStream + space; + nextPut: $(; + nextPutAll: self byteSize asString; + space; + nextPutAll: self byteAlignment asString; + nextPut: $).! Item was changed: ----- Method: ExternalType>>printOn: (in category 'printing') ----- printOn: aStream + self printTypeNameOn: aStream. - aStream nextPutAll: self typeName. + (self isTypeAlias or: [self isTypeAliasReferenced]) + ifTrue: [self printOriginalTypeOn: aStream] + ifFalse: [self printContentsOn: aStream].! - aStream - space; - nextPut: $(; - nextPutAll: self byteSize asString; - space; - nextPutAll: self byteAlignment asString; - nextPut: $).! Item was added: + ----- Method: ExternalType>>printOriginalTypeOn: (in category 'printing') ----- + printOriginalTypeOn: aStream + + aStream + nextPutAll: ' ~> '; + print: self originalType.! Item was added: + ----- Method: ExternalType>>printTypeNameOn: (in category 'printing') ----- + printTypeNameOn: aStream + + aStream nextPutAll: self typeName.! Item was changed: ----- Method: ExternalType>>readAlias (in category 'external structure') ----- readAlias + self subclassResponsibility.! - self checkType. - - ^ String streamContents: [:s | - self isPointerType - ifFalse: [ - "this is an aliased atomic, non-pointer type" - s nextPutAll: '^handle "', self writeFieldArgName, '"'] - ifTrue: [ - referentClass - ifNotNil: [ - "this is an aliased pointer to a structure, union, or type alias" - s nextPutAll:'^', referentClass name,' fromHandle: handle asExternalPointer'] - ifNil: [ - "this is an aliased pointer to external data" - s nextPutAll: '^ ExternalData fromHandle: handle'. - self isPointerType ifTrue:[s nextPutAll:' asExternalPointer']. - s nextPutAll:' type: '. - s nextPutAll: self asPointerType storeString]]]! Item was changed: ----- Method: ExternalType>>readFieldAt: (in category 'external structure') ----- 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 subclassResponsibility.! - self checkType. - - ^ String streamContents: [:s | - - self isPointerType - ifFalse: [ - "Atomic value" - s nextPutAll:'^handle '; - nextPutAll: (AtomicSelectors at: self atomicType); - space; print: byteOffset] - ifTrue: [ - referentClass - ifNotNil: [ - "Pointer to structure, union, or type alias" - s nextPutAll: '^'; - print: referentClass; - nextPutAll: ' fromHandle: (handle pointerAt: '; - print: byteOffset; - nextPutAll: ' length: '; - print: self byteSize; - nextPut: $)] - ifNil: [ - "Pointer to external data" - s nextPutAll: '^ ExternalData fromHandle: (handle pointerAt: '; - print: byteOffset; - nextPutAll: ' length: '; - print: self byteSize; - nextPutAll: ') type: ExternalType '; - nextPutAll: self atomicTypeName]]].! Item was added: + ----- Method: ExternalType>>size (in category 'accessing') ----- + size + "Backstop for array types. Undefined for all other types. Once encoded in the headerWord, this might answer something more specific for all types." + + ^ nil! Item was changed: ----- Method: ExternalType>>storeOn: (in category 'printing') ----- storeOn: aStream + + self flag: #todo. "mt: There are more compact (and maybe faster) representations for atomic types." + aStream + nextPut: $(; + nextPutAll: ExternalType name; space; + nextPutAll: #typeNamed:; space; + store: self typeName; + nextPutAll: ')'.! - referentClass - ifNil: [ "atomic or pointer to atomic" - aStream nextPutAll: ExternalType name; space; nextPutAll: self atomicTypeName] - ifNotNil: [ "pointer to structure or union or type alias" - aStream - nextPut: $(; - nextPutAll: ExternalType name; space; - nextPutAll: #structTypeNamed:; space; - store: referentClass name; - nextPutAll: ')']. - - self isPointerType ifTrue: [aStream space; nextPutAll: #asPointerType]! Item was changed: ----- Method: ExternalType>>typeName (in category 'accessing') ----- typeName ^ String streamContents: [:stream | + (self isPointerType not and: [self asPointerType isTypeAlias]) + ifTrue: [stream nextPut: $* "e.g. *DoublePtr *MyStructPtr"] + ifFalse: ["e.g. double DoublePtr MyStruct MyStructPtr"]. + stream nextPutAll: (referentClass + ifNil: [self atomicTypeName "e.g. double double*"] + ifNotNil: [referentClass name "e.g. MyStruct MyStruct* MyStructPtr *MyStructPtr"]). + + (self isPointerType and: [self isTypeAlias not]) + ifTrue: [stream nextPut: $* "e.g. double* MyStruct*"] + ifFalse: ["e.g. double DoublePtr MyStruct MyStructPtr"]]! - ifNil: [self atomicTypeName] - ifNotNil: [referentClass name]). - self isPointerType - ifTrue: [stream nextPut: $*]]! Item was changed: ----- Method: ExternalType>>writeAliasWith: (in category 'external structure') ----- writeAliasWith: valueName + self subclassResponsibility.! - self checkType. - - ^ String streamContents: [:s | - self isPointerType - ifFalse: [ - "this is an aliased atomic non-pointer type" - self class extraTypeChecks ifTrue: [ - self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."]. - s nextPutAll:'handle := ', valueName, '.'] - ifTrue: [ - "this is an aliased pointer type" - self class extraTypeChecks ifTrue: ["expect the value to be a structure/union/alias/data with an external address as handle" - s nextPutAll: ('self assert: [{1} externalType == {2}].' format: {valueName. self storeString}); crtab]. - s nextPutAll:'handle := ', valueName,' getHandle asByteArrayPointer']]! Item was changed: ----- Method: ExternalType>>writeFieldArgName (in category 'external structure') ----- writeFieldArgName + ^ referentClass + ifNotNil: ['a',referentClass name] + ifNil: ['externalData']! - ^ self isPointerType - ifFalse: [ - self atomicTypeName caseOf: { - ['bool'] -> ['aBoolean']. - ['char'] -> ['aCharacter']. - ['schar'] -> ['aCharacter']. - ['float'] -> ['aFloat']. - ['double'] -> ['aFloat']. - } otherwise: ['anInteger']] - ifTrue: [ - referentClass - ifNotNil: ['a',referentClass name] - ifNil: ['externalData']]! Item was changed: ----- Method: ExternalType>>writeFieldAt:with: (in category 'external structure') ----- 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 subclassResponsibility.! - self checkType. - - ^ String streamContents: [:s | - self isPointerType - ifFalse: [ - "Atomic value" - self class extraTypeChecks ifTrue: [ - self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."]. - s nextPutAll:'handle '; - nextPutAll: (AtomicSelectors at: self atomicType); - space; print: byteOffset; - nextPutAll:' put: '; - nextPutAll: valueName] - ifTrue: [ - "Pointer to structure, union, type alias, or external data." - self class extraTypeChecks ifTrue: [ - s nextPutAll: ('self assert: [{1} externalType == {2}].' format: {valueName. self storeString}); crtab]. - s nextPutAll:'handle pointerAt: '; - print: byteOffset; - nextPutAll:' put: '; - nextPutAll: valueName; - nextPutAll:' getHandle'; - nextPutAll: ' length: '; - print: self byteSize; - nextPutAll: '.']]! Item was added: + ----- Method: ExternalTypeAlias class>>isTypeAlias (in category 'testing') ----- + isTypeAlias + + ^ true! Item was changed: ----- Method: ExternalTypeAlias class>>originalTypeName (in category 'type alias') ----- originalTypeName - "Answer the typeName this alias should be for, e.g., 'long', 'ulonglong*'. Provide a default here to make automated sends to #compileFields work." + self subclassResponsibility.! - ^ 'void*'! Item was changed: ----- Method: ExternalTypeAlias>>doesNotUnderstand: (in category 'proxy') ----- doesNotUnderstand: msg + "Use aliases as transparent proxies." + - ^ msg sendTo: self value! Item was added: + ExternalType subclass: #ExternalUnknownType + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'FFI-Kernel'! Item was added: + ----- Method: ExternalUnknownType class>>newTypeForUnknownNamed: (in category 'instance creation') ----- + newTypeForUnknownNamed: typeName + + | type pointerType | + self + assert: [(StructTypes includesKey: typeName) not] + description: 'Type already exists. Use #typeNamed: to access it.'. + + type := ExternalUnknownType basicNew + compiledSpec: (WordArray with: self structureSpec); + 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." + StructTypes at: typeName asSymbol put: type. + + ^ type! Item was added: + ----- Method: ExternalUnknownType>>becomeArrayType (in category 'construction') ----- + becomeArrayType + "I am now positive on #isTypeAliasForArray :-) Make myself an array type. Not that easy because Arraytype as extra instVars #size and #contentType." + + | newArrayType | + newArrayType := ExternalArrayType basicNew + compiledSpec: self compiledSpec; + byteAlignment: self byteAlignment; + setReferentClass: referentClass; + setReferencedType: referencedType; + setContentType: referentClass originalType contentType; "Hmm..." + setSize: referentClass originalType size; "Hmm..." + yourself. + + "No referentClass for pointer types of array types." + referencedType setReferentClass: nil. + + self becomeForward: newArrayType. + + ^ newArrayType! Item was added: + ----- Method: ExternalUnknownType>>becomeAtomicType (in category 'construction') ----- + becomeAtomicType + + self changeClassTo: ExternalAtomicType.! Item was added: + ----- Method: ExternalUnknownType>>becomeKnownType (in category 'construction') ----- + becomeKnownType + "Give me some purpose. :-) The order of checks matters because some tests only look at the #headerWord. Make the tests that look into referentClass first." + + self isTypeAliasForStructure + ifTrue: [^ self becomeStructureType]. + self isTypeAliasForArray + ifTrue: [^ self becomeArrayType]. + + self isTypeAliasForAtomic + ifTrue: [^ self becomeAtomicType]. + self isTypeAliasForPointer + ifTrue: [^ self becomePointerType]. + + ^ self becomeStructureType! Item was added: + ----- Method: ExternalUnknownType>>becomePointerType (in category 'construction') ----- + becomePointerType + "I am a type alias for a pointer type now. Forget my current pointer type (i.e. referencedType), which I will replace myself. Also, create a new non-pointer type based on a copy of the original type's non-pointer type. In that copy, we can (1) replace the referentClass with mine and (2) link back to use via referencedType so that #asPointerType and #asNonPointerType work as expected." + + self changeClassTo: ExternalPointerType. + self newTypeAlias.! Item was added: + ----- Method: ExternalUnknownType>>becomeStructureType (in category 'construction') ----- + becomeStructureType + + self changeClassTo: ExternalStructureType.! Item was added: + ----- Method: ExternalUnknownType>>isArrayType (in category 'testing') ----- + isArrayType + + ^ false! Item was added: + ----- Method: ExternalUnknownType>>isAtomic (in category 'testing') ----- + isAtomic + + ^ false! Item was added: + ----- Method: ExternalUnknownType>>isPointerType (in category 'testing') ----- + isPointerType + + ^ false! Item was added: + ----- Method: ExternalUnknownType>>isStructureType (in category 'testing') ----- + isStructureType + + ^ false! Item was added: + ----- Method: ExternalUnknownType>>isTypeAlias (in category 'testing') ----- + isTypeAlias + + ^ [self isTypeAliasForAtomic + or: [self isTypeAliasForPointer + or: [self isTypeAliasForStructure + or: [self isTypeAliasForArray]]] + ] ifError: [false "Ignore uninitialized field specs"]! Item was added: + ----- Method: ExternalUnknownType>>isTypeAliasForArray (in category 'testing - type alias') ----- + isTypeAliasForArray + "Overwritten because at some point, the receiver might be an alias and not yet changed to ExternalArrayType. See #becomeArrayType. Once #isArrayType is encoded in the headerWord, this can be removed." + + ^ referentClass notNil + and: [referentClass isTypeAlias + and: [referentClass originalType isArrayType]]! Item was added: + ----- Method: ExternalUnknownType>>isTypeAliasForAtomic (in category 'testing - type alias') ----- + isTypeAliasForAtomic + + ^ self headerWord allMask: FFIFlagAtomic! Item was added: + ----- Method: ExternalUnknownType>>isTypeAliasForPointer (in category 'testing - type alias') ----- + isTypeAliasForPointer + + ^ self headerWord allMask: ExternalType pointerAliasSpec! Item was added: + ----- Method: ExternalUnknownType>>isTypeAliasForStructure (in category 'testing - type alias') ----- + isTypeAliasForStructure + + ^ referentClass notNil + and: [referentClass isTypeAlias + and: [referentClass originalType isStructureType]]! Item was added: + ----- Method: ExternalUnknownType>>isUnknownType (in category 'testing') ----- + isUnknownType + + ^ true! Item was added: + ----- Method: ExternalUnknownType>>newReferentClass: (in category 'construction') ----- + newReferentClass: classOrNil + + self assert: [classOrNil notNil]. + + referentClass := classOrNil. + compiledSpec := referentClass compiledSpec. + byteAlignment := referentClass byteAlignment.! Item was added: + ----- Method: ExternalUnknownType>>newTypeAlias (in category 'construction') ----- + newTypeAlias + + self shouldNotImplement.! Item was added: + ----- Method: ExternalUnknownType>>printOn: (in category 'printing') ----- + printOn: aStream + + aStream nextPutAll: '<unknown type>'.! Item was added: + ----- Method: ExternalUnknownType>>typeName (in category 'accessing') ----- + typeName + + self shouldNotImplement.! Item was added: + ----- Method: FFIPlatformDescription class>>checkFFI (in category 'system startup') ----- + checkFFI + "Try to load the FFI module. Warn if not possible." + + [ [ExternalType int32_t + handle: #[ 0 0 0 0 ] + at: 1 + put: 42] ifError: [:msg | + self notify: 'FFI plugin not available.', String cr, String cr, msg] + ] fork. "Do not interrupt the startup list."! Item was changed: ----- Method: FFIPlatformDescription class>>startUp: (in category 'system startup') ----- startUp: resuming "Notify all FFI classes about platform changes." resuming ifTrue: [ LastPlatform in: [:lastPlatform | self newCurrent in: [:currentPlatform | lastPlatform = currentPlatform ifTrue: [ self flag: #discuss. "mt: Maybe add #platformResuming?" ExternalAddress allBeNull. ExternalType cleanupUnusedTypes ] ifFalse: [ LastPlatform := currentPlatform. "Update now. See #current." { ExternalAddress. ExternalType. ExternalStructure. ExternalPool } do: [:cls | cls platformChangedFrom: lastPlatform + to: currentPlatform] ]]]. + self checkFFI].! - to: currentPlatform] ]]] ].! Item was added: + ----- Method: Object>>isExternalObject (in category '*FFI-Kernel') ----- + isExternalObject + "Answer true if the receiver is a representation for an object that lives in external memory. Note that Squeak FFI supports managing such object in internal object memory, too. See ExternalObject, ExternalStructure, ExternalUnion, ExternalData etc. and also #isInternalMemory and #isExternalAddress." + + ^ false! |
Free forum by Nabble | Edit this page |