FFI: FFI-Kernel-mt.117.mcz

Marcel Taeumel uploaded a new version of FFI-Kernel to project FFI:
http://source.squeak.org/FFI/FFI-Kernel-mt.117.mcz

==================== Summary ====================

Name: FFI-Kernel-mt.117
Author: mt
Time: 20 June 2020, 1:16:41.735743 pm
UUID: 4ffc4075-6459-ea44-b93a-5f1b46e99c4b
Ancestors: FFI-Kernel-mt.116

For the sake of code readability: untangles the specific role of struct types during field-accessor generation and dynamic field access into new subclass: ExternalStructureType. The implementation of ExternalType is now lighter again.

Note that this change does not affect FFI calls as is. The particular class of an external type is not relevant for type coercing during FFI calls and also not for packaging the return value. What matters is instVar 0 being the compiledSpec and instVar 1 being the referentClass. That does not change with this commit.

(Note that I added type checks to the generated field code. Those could easily be removed if not wanted. I suppose that implementing #assert: in ExternalStructure controlled by a pragma preference would be a good way of making type checks during field write-access optional.)

In the process, fixed the following things:
- regression for reading fields that are type alias to pointer type.
- uniform pointer access as #pointerAt:length: and #pointerAt:put:length: just like #structAt:length: and #structAt:put:length:. Makes the generated code more readable and avoids accessing the global "ExternalAddress wordSize".
- regression with #defineFields: because of the recent change to include #absent rule for #generated field compilation. So, avoid overwriting fields that are manually managed even if you use #defineFields instead of #compileFields.

=============== Diff against FFI-Kernel-mt.116 ===============

Item was changed:
+ ----- Method: ByteArray>>asByteArrayPointer (in category '*FFI-Kernel-pointers') -----
- ----- Method: ByteArray>>asByteArrayPointer (in category '*FFI-Kernel') -----
  asByteArrayPointer
  "Return a ByteArray describing a pointer to the contents of the receiver."
  ^self shouldNotImplement!

Item was changed:
+ ----- Method: ByteArray>>asExternalPointer (in category '*FFI-Kernel-pointers') -----
- ----- Method: ByteArray>>asExternalPointer (in category '*FFI-Kernel') -----
  asExternalPointer
  "Convert the receiver assuming that it describes a pointer to an object."
+ ^ self pointerAt: 1 length: self size!
- ^ self pointerAt: 1!

Item was changed:
+ ----- Method: ByteArray>>longPointerAt: (in category '*FFI-Kernel-pointers') -----
- ----- Method: ByteArray>>longPointerAt: (in category '*FFI-Kernel') -----
  longPointerAt: byteOffset
  "Answer an 8-byte pointer object stored at the given byte address"
+
+ ^ self pointerAt: byteOffset length: 8!
- | addr |
- addr := ExternalAddress basicNew: 8.
- 1 to: 8 do:
- [:i|
- addr basicAt: i put: (self unsignedByteAt: byteOffset+i-1)].
- ^addr!

Item was changed:
+ ----- Method: ByteArray>>longPointerAt:put: (in category '*FFI-Kernel-pointers') -----
- ----- Method: ByteArray>>longPointerAt:put: (in category '*FFI-Kernel') -----
  longPointerAt: byteOffset put: value
  "Store an 8-byte pointer object at the given byte address"
+
+ ^ self pointerAt: byteOffset put: value length: 8!
- value isExternalAddress ifFalse:
- [^self error:'Only external addresses can be stored'].
- 1 to: 8 do:
- [:i|
- self unsignedByteAt: byteOffset+i-1 put: (value basicAt: i)].
- ^value!

Item was changed:
+ ----- Method: ByteArray>>pointerAt: (in category '*FFI-Kernel-pointers') -----
- ----- Method: ByteArray>>pointerAt: (in category '*FFI-Kernel') -----
  pointerAt: byteOffset
  "Answer a pointer object stored at the given byte address"
 
+ ^ self pointerAt: byteOffset length: ExternalAddress wordSize!
- self flag: #ffiLongVsInt. "mt: Here short means 'long', which is actually 'int', and long means 'longlong'. Sigh."
- ^ ExternalAddress wordSize caseOf: {
- [4] -> [self shortPointerAt: byteOffset].
- [8] -> [self longPointerAt: byteOffset] }!

Item was added:
+ ----- Method: ByteArray>>pointerAt:length: (in category '*FFI-Kernel-pointers') -----
+ 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:
+ [:i|
+ addr basicAt: i put: (self unsignedByteAt: byteOffset+i-1)].
+ ^addr!

Item was changed:
+ ----- Method: ByteArray>>pointerAt:put: (in category '*FFI-Kernel-pointers') -----
- ----- Method: ByteArray>>pointerAt:put: (in category '*FFI-Kernel') -----
  pointerAt: byteOffset put: value
  "Store a pointer object at the given byte address"
 
+ ^ self pointerAt: byteOffset put: value length: ExternalAddress wordSize!
- self flag: #ffiLongVsInt. "mt: Here short means 'long', which is actually 'int', and long means 'longlong'. Sigh."
- ^ ExternalAddress wordSize caseOf: {
- [4] -> [self shortPointerAt: byteOffset put: value].
- [8] -> [self longPointerAt: byteOffset put: value] }!

Item was added:
+ ----- 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"
+ 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') -----
- ----- Method: ByteArray>>shortPointerAt: (in category '*FFI-Kernel') -----
  shortPointerAt: byteOffset
  "Answer a 4-byte pointer object stored at the given byte address"
+
+ ^ self pointerAt: byteOffset length: 4!
- | addr |
- addr := ExternalAddress basicNew: 4.
- 1 to: 4 do:
- [:i|
- addr basicAt: i put: (self unsignedByteAt: byteOffset+i-1)].
- ^addr!

Item was changed:
+ ----- Method: ByteArray>>shortPointerAt:put: (in category '*FFI-Kernel-pointers') -----
- ----- Method: ByteArray>>shortPointerAt:put: (in category '*FFI-Kernel') -----
  shortPointerAt: byteOffset put: value
  "Store a 4-byte pointer object at the given byte address"
+
+ ^ self pointerAt: byteOffset put: value length: 4!
- value isExternalAddress ifFalse:
- [^self error:'Only external addresses can be stored'].
- 1 to: 4 do:
- [:i|
- self unsignedByteAt: byteOffset+i-1 put: (value basicAt: i)].
- ^value!

Item was changed:
  ExternalObject subclass: #ExternalStructure
  instanceVariableNames: ''
  classVariableNames: 'PreviousPlatform'
  poolDictionaries: 'FFIConstants'
  category: 'FFI-Kernel'!
  ExternalStructure class
+ instanceVariableNames: 'type compiledSpec byteAlignment'!
- instanceVariableNames: '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: 'type compiledSpec byteAlignment'!
- instanceVariableNames: 'compiledSpec byteAlignment'!

Item was changed:
  ----- Method: ExternalStructure class>>compileAllFields (in category 'system startup') -----
  compileAllFields
  "
  ExternalStructure compileAllFields
  "
  | priorAuthorInitials fieldSpec |
  priorAuthorInitials := Utilities authorInitialsPerSe.
  [Utilities setAuthorInitials: 'FFI'.
 
  self allStructuresInCompilationOrder do: [:structClass |
  fieldSpec := structClass fields.
  self flag: #discuss. "mt: Why do we need that extra layout check? Performance gain is minimal..."
  (structClass hasFieldLayoutChanged: fieldSpec)
  ifTrue: [structClass compileFieldsSilently: fieldSpec].
  structClass externalType "asNonPointerType"
  compiledSpec: structClass compiledSpec;
+ byteAlignment: structClass byteAlignment.
+ structClass organization removeEmptyCategories].
- byteAlignment: structClass byteAlignment].
  "Compilation of fields only needs external types temporarily. Non-weak references to external types are only in methods with FFI calls."
  ExternalType cleanupUnusedTypes.
 
  ] ensure: [Utilities setAuthorInitials: priorAuthorInitials]!

Item was changed:
  ----- Method: ExternalStructure class>>defineAllFields (in category 'system startup') -----
  defineAllFields
  "For convenience.
  ExternalStructure defineAllFields
  "
  self allStructuresInCompilationOrder
+ do: [:structClass |
+ structClass defineFields.
+ structClass organization removeEmptyCategories].!
- do: [:structClass | structClass defineFields].!

Item was changed:
  ----- Method: ExternalStructure class>>defineFields: (in category 'field definition') -----
  defineFields: fieldSpec
  "Private. Use #defineFields."
 
+ self compileFields: fieldSpec withAccessors: #generated.
- self compileFields: fieldSpec withAccessors: #always.
  ExternalType noticeModificationOf: self.!

Item was changed:
  ----- Method: ExternalStructure class>>maybeCompileAccessor:withSelector: (in category 'field definition - support') -----
  maybeCompileAccessor: aString withSelector: selector
+ "Only compile if category or source changed."
+
+ | category ref |
+ category := #'*autogenerated - accessing'.
+ ((ref := MethodReference class: self selector: selector) isValid
+ and: [ref category = category]
+ and: [ref sourceString = aString])
+ ifTrue: [^ self].
+ self compile: aString classified: category.!
- (self compiledMethodAt: selector ifAbsent: []) ifNotNil:
- [:existingMethod|
- existingMethod getSourceFromFile asString = aString ifTrue:
- [^self]].
- self compile: aString classified: #'*autogenerated - accessing'!

Item was added:
+ ExternalType subclass: #ExternalStructureType
+ instanceVariableNames: 'fieldTypes'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'FFI-Kernel'!
+
+ !ExternalStructureType commentStamp: 'mt 6/18/2020 08:54' prior: 0!
+ I am specializing types for external structures. While compiledSpec and referentClass are still paramount when the FFI plugin is processing FFI calls, this specialization can help untangle in-image processing of external structures and their data.
+
+ In terms of plugin compatibility, you could still use instances of ExternalType as, for example, argument types in ExternalFunction -- given that compiledSpec and referentClass are correct. Argument coercing in FFI calls would still work. However, you could no longer use in-image facilities such as #readFieldAt: / #writeFieldAt:width, which is used for generating struct-field accessors. And the dynamic access through #handle:at: / #handle:at:put: would fail. Also, #printOn: would not be very helpful anymore.
+
+ So, having this specialization of ExternalType for ExternalStructure helps packaging code. :-) Of course, this type can also be used for ExternalUnion, ExternalPackagedStructure, and ExternalTypeAlias.!

Item was added:
+ ----- Method: ExternalStructureType class>>newTypeForStructureClass: (in category 'instance creation') -----
+ newTypeForStructureClass: anExternalStructureClass
+
+ | type referentClass |
+ referentClass := anExternalStructureClass.
+
+ self
+ assert: [referentClass includesBehavior: ExternalStructure]
+ description: 'Wrong base class for structure'.
+
+ type := self newTypeForUnknownNamed: referentClass name.
+
+ referentClass compiledSpec
+ ifNil: [ "First time. The referent class' fields are probably just compiled for the first time."
+ type asNonPointerType setReferentClass: referentClass.
+ type asPointerType setReferentClass: referentClass]
+ ifNotNil: [
+ type asNonPointerType newReferentClass: referentClass.
+ type asPointerType newReferentClass: referentClass].
+
+ ^ type!

Item was added:
+ ----- 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 added:
+ ----- Method: ExternalStructureType>>checkType (in category 'external structure') -----
+ checkType
+
+ 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 added:
+ ----- 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
+ assert: [self isPointerType not]
+ description: 'Use ExternalStructure to use this feature.'.
+
+ referentClass ifNil: [self error: 'Unknown structure type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ 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 added:
+ ----- 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:."
+
+ self
+ assert: [self isPointerType not]
+ description: 'Use ExternalType to use this feature.'.
+
+ referentClass ifNil: [self error: 'Unknown structure type'].
+ self isEmpty ifTrue: [self error: 'Empty structure'].
+
+ self isAtomic
+ ifTrue: [ "alias to atomic"
+ 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 assert: [value externalType == self].
+ ^ handle
+ structAt: byteOffset
+ put: value getHandle
+ length: self byteSize].!

Item was added:
+ ----- Method: ExternalStructureType>>isEmpty (in category 'testing') -----
+ isEmpty
+ "Return true if the receiver represents a structure type"
+ ^ self byteSize = 0!

Item was added:
+ ----- Method: ExternalStructureType>>isIntegerType (in category 'testing') -----
+ isIntegerType
+ "Overwritten to not raise an error for struct types."
+
+ ^ false!

Item was added:
+ ----- Method: ExternalStructureType>>isTypeAlias (in category 'testing') -----
+ isTypeAlias
+
+ ^ referentClass notNil and: [referentClass isTypeAlias]!

Item was added:
+ ----- 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 added:
+ ----- 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>>originalType (in category 'accessing') -----
+ originalType
+ "Resolve original type for alias. Error if not a type alias."
+
+ ^ ExternalType typeNamed: self originalTypeName!

Item was added:
+ ----- 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>>printOn: (in category 'printing') -----
+ printOn: aStream
+
+ self isTypeAlias ifTrue: [
+ aStream nextPutAll: referentClass name.
+ aStream
+ nextPutAll: '~>';
+ print: self originalType.
+ self isEmpty
+ ifTrue: [aStream nextPutAll: ' ???'].
+ ^ self].
+
+ referentClass == nil
+ ifTrue:[aStream nextPutAll: '<unknown struct type>']
+ ifFalse:[
+ aStream nextPutAll: referentClass name.
+ self isEmpty
+ ifTrue: [aStream nextPutAll: ' { void }']].!

Item was added:
+ ----- 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"
+
+ self checkType.
+
+ ^ String streamContents: [:s |
+ s nextPutAll: '^', referentClass name,' fromHandle: handle']!

Item was added:
+ ----- 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."
+
+ 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 added:
+ ----- Method: ExternalStructureType>>storeOn: (in category 'printing') -----
+ storeOn: aStream
+
+ referentClass ifNil: [
+ "unknown struct type"
+ ^ aStream nextPutAll: 'nil'].
+
+ aStream
+ nextPut: $(;
+ nextPutAll: ExternalType name; space;
+ nextPutAll: #structTypeNamed:; space;
+ store: referentClass name;
+ nextPut: $).
+
+ self isPointerType ifTrue: [
+ aStream space; nextPutAll: #asPointerType].!

Item was added:
+ ----- 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"
+
+ self checkType.
+
+ ^ String streamContents: [:s |
+ s nextPutAll: ('self assert: [{1} class externalType == {2}].' format: {valueName. self storeString}); crtab.
+ s nextPutAll:'handle := ', valueName,' getHandle']!

Item was added:
+ ----- Method: ExternalStructureType>>writeFieldArgName (in category 'external structure') -----
+ writeFieldArgName
+
+ ^ 'a',referentClass name!

Item was added:
+ ----- 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."
+
+ self checkType.
+
+ ^String streamContents:[:s|
+ self isAtomic
+ ifTrue: [ "alias to atomic"
+ 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"
+ "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>>newTypeForStructureClass: (in category 'instance creation') -----
  newTypeForStructureClass: anExternalStructureClass
+
+ ^ ExternalStructureType newTypeForStructureClass: anExternalStructureClass!
-
- | type referentClass |
- referentClass := anExternalStructureClass.
-
- self
- assert: [referentClass includesBehavior: ExternalStructure]
- description: 'Wrong base class for structure'.
-
- type := self newTypeForUnknownNamed: referentClass name.
-
- referentClass compiledSpec
- ifNil: [ "First time. The referent class' fields are probably just compiled for the first time."
- type asNonPointerType setReferentClass: referentClass.
- type asPointerType setReferentClass: referentClass]
- ifNotNil: [
- type asNonPointerType newReferentClass: referentClass.
- type asPointerType newReferentClass: referentClass].
-
- ^ type!

Item was changed:
  ----- Method: ExternalType class>>newTypeForUnknownNamed: (in category 'instance creation') -----
  newTypeForUnknownNamed: typeName
 
+ ^ ExternalStructureType newTypeForUnknownNamed: typeName!
- | type pointerType |
- self
- assert: [(StructTypes includesKey: typeName) not]
- description: 'Structure type already exists. Use #typeNamed: to access it.'.
-
- type := self basicNew
- compiledSpec: (WordArray with: self structureSpec);
- yourself.
- self assert: [type isEmptyStructureType].
-
- pointerType := self 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 added:
+ ----- Method: ExternalType>>checkType (in category 'external structure') -----
+ checkType
+
+ (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:."
 
  | result |
+ self checkType.
- self isPointerType ifTrue: [
- | accessor shouldReadCString |
- accessor := self pointerSize caseOf: {
- [4] -> [#shortPointerAt:].
- [8] -> [#longPointerAt:] }.
- shouldReadCString := self = ExternalType string.
- ^ referentClass
- ifNil: [
- result := ExternalData
- fromHandle: (handle perform: accessor with: byteOffset)
- type: self.
- shouldReadCString
- ifTrue: [result fromCString]
- ifFalse: [result]]
- ifNotNil: [
- referentClass
- fromHandle: (handle perform: accessor with: byteOffset)]].
-
- self isAtomic ifFalse: [ "structure type"
- ^ referentClass fromHandle: (handle structAt: byteOffset length: self byteSize)].
 
+ 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"
+ result := ExternalData
+ fromHandle: (handle pointerAt: byteOffset length: self byteSize)
+ type: self.
+ self = ExternalType string
+ ifTrue: [result fromCString]
+ ifFalse: [result]]]!
- result := handle
- perform: (AtomicSelectors at: self atomicType)
- with: byteOffset.
-
- ^ self isTypeAlias
- ifFalse: [result] "atomic type"
- ifTrue: [referentClass fromHandle: result] "alias to atomic type"!

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 checkType.
 
+ self isPointerType
+ ifFalse: [ "set atomic value"
+ 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 assert: [value externalType == self].
+ handle
+ pointerAt: byteOffset
+ put: value getHandle
+ length: self byteSize].!
- self isPointerType ifTrue: [
- | accessor |
- accessor := self pointerSize caseOf: {
- [4] -> [#shortPointerAt:put:].
- [8] -> [#longPointerAt:put:] }.
- self = ExternalType string
- ifTrue: [^ self error: 'You should not write a string of arbitrary length into an external address.'].
- ^ handle
- perform: accessor
- with: byteOffset
- with: value getHandle].
-
- self isAtomic ifFalse: [ "structure type"
- ^ handle
- structAt: byteOffset
- put: value getHandle
- length: self byteSize].
-
- self isTypeAlias ifTrue: [ "alias to atomic type"
- ^ handle
- perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
- with: byteOffset
- with: value getHandle].
-
- "atomic type"
- ^ handle
- perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
- with: byteOffset
- with: value!

Item was removed:
- ----- Method: ExternalType>>isEmptyStructureType (in category 'testing') -----
- isEmptyStructureType
- "Return true if the receiver represents a structure type"
- ^ self isStructureType and: [self byteSize = 0]!

Item was removed:
- ----- Method: ExternalType>>isTypeAlias (in category 'testing') -----
- isTypeAlias
-
- ^ self isPointerType not
- and: [referentClass notNil and: [referentClass isTypeAlias]]!

Item was removed:
- ----- Method: ExternalType>>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: ExternalType>>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]]"
- ^ self headerWord anyMask: FFIFlagPointer+FFIFlagStructure!

Item was removed:
- ----- Method: ExternalType>>originalType (in category 'accessing') -----
- originalType
- "Resolve original type for alias. Error if not a type alias."
-
- ^ ExternalType typeNamed: self originalTypeName!

Item was removed:
- ----- Method: ExternalType>>originalTypeName (in category 'accessing') -----
- originalTypeName
- "Resolve original type for alias. Error if not a type alias."
-
- ^ referentClass ifNotNil: [referentClass originalTypeName]!

Item was changed:
  ----- Method: ExternalType>>printOn: (in category 'printing') -----
  printOn: aStream
 
+ aStream nextPutAll: (referentClass ifNil: [self atomicTypeName] ifNotNil: [referentClass name]).
+ self isPointerType ifTrue: [aStream nextPut: $*].!
- self isTypeAlias ifTrue: [
- "Note that a type alias cannot be atomic."
- aStream nextPutAll: referentClass name.
- self isPointerType ifTrue:[aStream nextPut: $*].
- aStream
- nextPutAll: '~>';
- print: self originalType.
- self isEmptyStructureType
- ifTrue: [aStream nextPutAll: ' ???'].
- ^ self].
-
- self isAtomic
- ifTrue: [aStream nextPutAll: self atomicTypeName]
- ifFalse: [
- referentClass == nil
- ifTrue:[aStream nextPutAll: '<unknown struct type>']
- ifFalse:[
- aStream nextPutAll: referentClass name.
- self isEmptyStructureType
- ifTrue: [aStream nextPutAll: ' { void }']]].
- self isPointerType ifTrue:[aStream nextPut: $*].!

Item was changed:
  ----- Method: ExternalType>>readAlias (in category 'external structure') -----
  readAlias
 
+ 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"
+ | shouldReadCString |
+ (shouldReadCString := self = ExternalType string)
+ ifTrue: [s nextPutAll: '^(']
+ ifFalse: [s nextPutAll: '^'].
+ s nextPutAll: 'ExternalData fromHandle: handle'.
+ self isPointerType ifTrue:[s nextPutAll:' asExternalPointer'].
+ s nextPutAll:' type: '.
+ shouldReadCString
+ ifTrue: [s nextPutAll: 'ExternalType string) fromCString']
+ ifFalse: [s nextPutAll: self asPointerType storeString]]]]!
- referentClass == nil
- ifTrue:[(self isAtomic and:[self isPointerType not])
- ifTrue:[s nextPutAll:'^handle "', self writeFieldArgName, '"']
- ifFalse:[ | shouldReadCString |
- (shouldReadCString := self = ExternalType string)
- ifTrue: [s nextPutAll: '^(']
- ifFalse: [s nextPutAll: '^'].
- s nextPutAll: 'ExternalData fromHandle: handle'.
- self isPointerType ifTrue:[s nextPutAll:' asExternalPointer'].
- s nextPutAll:' type: '.
- shouldReadCString
- ifTrue: [s nextPutAll: 'ExternalType string) fromCString']
- ifFalse: [s nextPutAll: self asPointerType storeString]]]
- ifFalse:[s nextPutAll:'^', referentClass name,' fromHandle: handle'.
- self isPointerType ifTrue:[s nextPutAll:' asExternalPointer']]]!

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 checkType.
+
+ ^ String streamContents: [:s |
+
+ self isPointerType
+ ifFalse: [
+ "Atomic value"
+ s nextPutAll:'^handle ';
+ nextPutAll: (AtomicSelectors at: self atomicType);
+ space; print: byteOffset]
+ ifTrue: [
+ | shouldReadCString |
+ shouldReadCString := self = ExternalType string.
+ 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"
+ shouldReadCString
- self isPointerType ifTrue:
- [| accessor shouldReadCString |
- self flag: #ffiLongVsInt. "mt: Here short means 'long', which is actually 'int', and long means 'longlong'. Sigh."
- accessor := self pointerSize caseOf: {
- [4] -> [#shortPointerAt:].
- [8] -> [#longPointerAt:] }.
- shouldReadCString := self = ExternalType string.
- ^String streamContents:
- [:s|
- referentClass
- ifNil:
- [shouldReadCString
  ifTrue: [s nextPutAll: '^(']
  ifFalse: [s nextPutAll: '^'].
+ s nextPutAll: 'ExternalData fromHandle: (handle pointerAt: ';
- s nextPutAll: 'ExternalData fromHandle: (handle ', accessor, ' ';
  print: byteOffset;
+ nextPutAll: ' length: ';
+ print: self byteSize;
  nextPutAll: ') type: ExternalType '.
  shouldReadCString
  ifTrue:
  [s nextPutAll: 'string) fromCString']
  ifFalse:
  [s nextPutAll: self atomicTypeName;
+ nextPutAll: ' asPointerType']]]].!
- nextPutAll: ' asPointerType']]
- ifNotNil:
- [s nextPutAll: '^';
- print: referentClass;
- nextPutAll: ' fromHandle: (handle ', accessor, ' ';
- print: byteOffset;
- nextPut: $)]]].
-
- self isAtomic ifFalse: "structure type"
- [^String streamContents:[:s|
- s nextPutAll:'^';
- print: referentClass;
- nextPutAll:' fromHandle: (handle structAt: ';
- print: byteOffset;
- nextPutAll:' length: ';
- print: self byteSize;
- nextPutAll:')']].
-
- self isTypeAlias ifTrue: "alias to atomic type"
- [^String streamContents:[:s |
- s nextPutAll:'^';
- print: referentClass;
- nextPutAll:' fromHandle: (handle ';
- nextPutAll: (AtomicSelectors at: self atomicType);
- space; print: byteOffset;
- nextPutAll:')']].
-
- "Atomic non-pointer types"
- ^String streamContents:
- [:s|
- s nextPutAll:'^handle ';
- nextPutAll: (AtomicSelectors at: self atomicType);
- space; print: byteOffset].!

Item was changed:
  ----- Method: ExternalType>>storeOn: (in category 'printing') -----
  storeOn: aStream
 
+ 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]!
- self isAtomic
- ifTrue:[aStream nextPutAll: ExternalType name; space; nextPutAll: self atomicTypeName]
- ifFalse:[
- referentClass == nil
- ifTrue: [aStream nextPutAll: 'nil']
- ifFalse: [aStream nextPut: $(; nextPutAll: ExternalType name; space; nextPutAll: #structTypeNamed:; space;  store: referentClass name; nextPut: $)]].
- self isPointerType ifTrue: [aStream space; nextPutAll: #asPointerType].!

Item was changed:
  ----- Method: ExternalType>>writeAliasWith: (in category 'external structure') -----
  writeAliasWith: valueName
 
+ self checkType.
+
  ^ String streamContents: [:s |
+ self isPointerType
+ ifFalse: [
+ "this is an aliased atomic non-pointer type"
+ 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"
+ "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']]!
- (referentClass == nil and:[self isAtomic and:[self isPointerType not]])
- ifTrue:[s nextPutAll:'handle := ', valueName, '.']
- ifFalse:[
- self = ExternalType string
- ifTrue: [
- s nextPutAll: 'self shouldNotImplement. "You cannot write an arbitrary String object into an external address. Maybe we can pad or trim it in the future to only use the memory that has already been allocated. Additionally, this type alias to a char* stores its external address in a byte array. So, locally storing the string in a byte array will not work either, because we cannot discriminate when reading the field again."'; crtab.
- s nextPutAll: 'handle := ', valueName, ' asByteArray, #[0].']
- ifFalse: [
- s nextPutAll:'handle := ', valueName,' getHandle'.
- self isPointerType ifTrue:[s nextPutAll:' asByteArrayPointer']]]]!

Item was changed:
  ----- Method: ExternalType>>writeFieldArgName (in category 'external structure') -----
  writeFieldArgName
 
+ ^ 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: [
+ self = ExternalType string
+ ifTrue: ['externalCStringData']
+ ifFalse: ['externalData']]]!
- ^ referentClass == nil
- ifTrue:[(self isAtomic and:[self isPointerType not])
- ifTrue:[
- self atomicTypeName caseOf: {
- ['bool'] -> ['aBoolean'].
- ['char'] -> ['aCharacter'].
- ['schar'] -> ['aCharacter'].
- ['float'] -> ['aFloat'].
- ['double'] -> ['aFloat'].
- } otherwise: ['anInteger']]
- ifFalse:[
- self = ExternalType string
- ifTrue: ['aString']
- ifFalse: ['someExternalData']]]
- ifFalse:['a',referentClass name]!

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 checkType.
+
+ ^ String streamContents: [:s |
+ self isPointerType
+ ifFalse: [
+ "Atomic value"
+ 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."
+ s nextPutAll: ('self assert: [{1} externalType == {2}].' format: {valueName. self storeString}); crtab.
+ s nextPutAll:'handle pointerAt: ';
- self isPointerType ifTrue:
- [| accessor |
- self flag: #ffiLongVsInt. "mt: Here short means 'long', which is actually 'int', and long means 'longlong'. Sigh."
- accessor := self pointerSize caseOf: {
- [4] -> [#shortPointerAt:].
- [8] -> [#longPointerAt:] }.
-
- ^String streamContents:
- [:s|
- self = ExternalType string ifTrue:
- [s nextPutAll: 'self shouldNotImplement. "You should not write a string of abitrary length into an external address. Maybe we can pad or trim it in the future to only use the memory that has already been allocated."']
- ifFalse:
- [s nextPutAll:'handle ', accessor, ' ';
  print: byteOffset;
  nextPutAll:' put: ';
  nextPutAll: valueName;
+ nextPutAll:' getHandle';
+ nextPutAll: ' length: ';
+ print: self byteSize;
+ nextPutAll: '.']]!
- nextPutAll:' getHandle.']]].
-
- self isAtomic ifFalse:[ "structure type"
- ^String streamContents:[:s|
- s nextPutAll:'handle structAt: ';
- print: byteOffset;
- nextPutAll:' put: ';
- nextPutAll: valueName;
- nextPutAll:' getHandle';
- nextPutAll:' length: ';
- print: self byteSize;
- nextPutAll:'.']].
-
- self isTypeAlias ifTrue:[ "alias to atomic type"
- ^String streamContents:[:s|
- s nextPutAll:'handle ';
- nextPutAll: (AtomicSelectors at: self atomicType);
- space; print: byteOffset;
- nextPutAll:' put: ';
- nextPutAll: valueName;
- nextPutAll: ' getHandle']].
-
- ^String streamContents:[:s|
- s nextPutAll:'handle ';
- nextPutAll: (AtomicSelectors at: self atomicType);
- space; print: byteOffset;
- nextPutAll:' put: ';
- nextPutAll: valueName].!

Item was changed:
  (PackageInfo named: 'FFI-Kernel') postscript: 'Smalltalk removeFromStartUpList: ExternalAddress.
  Smalltalk removeFromStartUpList: ExternalObject.
 
+ "Split up types for external structures from atomic types."
+ ExternalType resetAllStructureTypes.
+
+ "Re-generate all field accessors because there are now type checks, too."
+ ExternalStructure defineAllFields.
+ '!
- "Since #pointerSize in ExternalType is never nil anymore, make the code generated for fields more specific, i.e., #shortPointerAt:(put:) or #longPointerAt:(put:)."
- ExternalType platformChangedFrom: FFIPlatformDescription empty to: FFIPlatformDescription current.
- ExternalStructure platformChangedFrom: FFIPlatformDescription empty to: FFIPlatformDescription current.'!