FFI Inbox: FFI-Kernel-mt.80.mcz

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
2 messages Options
Reply | Threaded
Open this post in threaded view
|

FFI Inbox: FFI-Kernel-mt.80.mcz

commits-2
A new version of FFI-Kernel was added to project FFI Inbox:
http://source.squeak.org/FFIinbox/FFI-Kernel-mt.80.mcz

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

Name: FFI-Kernel-mt.80
Author: mt
Time: 30 May 2020, 6:39:07.324231 pm
UUID: 4750dd07-8701-3146-9348-7a9064273fcf
Ancestors: FFI-Kernel-mt.79

Assure that #pointerSize in an external type can never be nil. Make it more clear that #pointerAt:(put:) is just a shortcut to be used for pointer arithmetic (see ExternalAddress >> #+). Struct field methods must be recompiled because of the field alignment. So, emitting #pointerAt:(put:) is of no use at all. Now we emit #(short|long)PointerAt:(put:).

Note that we only support 4-byte and 8-byte pointers. Thus, fail as early as possible if -- at some day -- #wordSize would be bigger than 8.

See discussion on vm-dev: http://forum.world.st/Re-squeak-dev-64-bit-FFI-was-porting-Croquet-to-Squeak6-0-alpha-tp5113318p5117466.html

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

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

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

Item was changed:
  ----- Method: ExternalStructure class>>compileFields:withAccessors: (in category 'field definition') -----
  compileFields: specArray withAccessors: aSymbol
  "Compile a type specification for the FFI machinery.
  Return the newly compiled spec.
  Eventually generate the field accessors according to following rules:
  - aSymbol = #always always generate the accessors
  - aSymbol = #never never generate the accessors
  - aSymbol = #generated only generate the auto-generated accessors
  - aSymbol = #absent only generate the absent accessors"
  | newByteAlignment byteOffset typeSpec newCompiledSpec |
  (specArray size > 0 and: [specArray first class ~~ Array]) ifTrue:
  [^ self compileAlias: specArray withAccessors: aSymbol].
  byteOffset := 0.
  newByteAlignment := self minStructureAlignment.
  typeSpec := WriteStream on: (WordArray new: 10).
  typeSpec nextPut: FFIFlagStructure.
  "dummy for size"
  specArray do:
  [:spec | | fieldName fieldType isPointerField externalType typeSize fieldAlignment selfRefering |
  fieldName := spec first.
  fieldType := spec second.
  isPointerField := fieldType last = $*.
  fieldType := (fieldType findTokens: '*') first withBlanksTrimmed.
  externalType := ExternalType atomicTypeNamed: fieldType.
  selfRefering := isPointerField and: [externalType isNil and: [fieldType = self asString]].
  selfRefering ifTrue: [
  externalType := ExternalType void asPointerType
  ] ifFalse:[
+ externalType ifNil: ["non-atomic"
+ (Symbol lookup: fieldType) ifNotNil: [:sym |
+ externalType := ExternalType structTypeNamed: sym].
- externalType == nil ifTrue: ["non-atomic"
- Symbol
- hasInterned: fieldType
- ifTrue: [:sym | externalType := ExternalType structTypeNamed: sym].
  ].
+ externalType ifNil: [
- externalType == nil ifTrue:[
  Transcript show: '(' , fieldType , ' is void)'.
  externalType := ExternalType void.
  ].
+ isPointerField ifTrue: [externalType := externalType asPointerType]].
- isPointerField ifTrue: [externalType := externalType asPointerType: self pointerSize]].
  typeSize := externalType byteSize.
  fieldAlignment := (externalType byteAlignment max: self minFieldAlignment)
  min: self maxFieldAlignment.
  byteOffset := byteOffset alignedTo: fieldAlignment.
  newByteAlignment := newByteAlignment max: fieldAlignment.
  spec size > 2 ifTrue: ["extra size"
  spec third < typeSize
  ifTrue: [^ self error: 'Explicit type size is less than expected'].
  typeSize := spec third.
  ].
  (fieldName notNil and: [self shouldGenerate: fieldName policy: aSymbol]) ifTrue: [
  self defineFieldAccessorsFor: fieldName startingAt: byteOffset + 1 type: externalType.
  ].
  typeSpec nextPutAll: (externalType embeddedSpecWithSize: typeSize).
  byteOffset := byteOffset + typeSize.
  ].
 
  newByteAlignment := newByteAlignment min: self maxStructureAlignment.
  byteOffset := byteOffset alignedTo: newByteAlignment.
  newCompiledSpec := typeSpec contents.
  newCompiledSpec at: 1 put: (byteOffset bitOr: FFIFlagStructure).
  byteAlignment := newByteAlignment.
  ^ newCompiledSpec!

Item was removed:
- ----- Method: ExternalStructure class>>pointerSize (in category 'accessing') -----
- pointerSize
- "Answer the size of pointers for this class.  By default answer nil.
- Subclasses that contain pointers must define the size of a pointer if the code is to operate on 64-bit and 32-bit platforms.
- Currently we have no way of converting a type between 32- and 64- bit versions beyond recompiling it."
- ^nil!

Item was changed:
  Object subclass: #ExternalType
+ instanceVariableNames: 'compiledSpec referentClass referencedType byteAlignment'
- instanceVariableNames: 'compiledSpec referentClass referencedType pointerSize byteAlignment'
  classVariableNames: 'AtomicSelectors AtomicTypeNames AtomicTypes StructTypes'
  poolDictionaries: 'FFIConstants'
  category: 'FFI-Kernel'!
 
  !ExternalType commentStamp: 'eem 6/25/2019 10:39' prior: 0!
  An external type represents the type of external objects.
 
  Instance variables:
  compiledSpec <WordArray> Compiled specification of the external type
  referentClass <Behavior | nil> Class type of argument required
  referencedType <ExternalType> Associated (non)pointer type with the receiver
  pointerSize <Integer | nil> The size of a pointer if the external type is a pointer or is a structure containing a pointer.
  byteAlignment <Integer | nil> The desired alignment for a field of the external type within a structure.  If nil it has yet to be computed.
 
  Compiled Spec:
  The compiled spec defines the type in terms which are understood by the VM. Each word is defined as:
  bits 0...15 - byte size of the entity
  bit 16 - structure flag (FFIFlagStructure)
   This flag is set if the following words define a structure
  bit 17 - pointer flag (FFIFlagPointer)
   This flag is set if the entity represents a pointer to another object
  bit 18 - atomic flag (FFIFlagAtomic)
   This flag is set if the entity represents an atomic type.
   If the flag is set the atomic type bits are valid.
  bits 19...23 - unused
  bits 24...27 - atomic type (FFITypeVoid ... FFITypeDoubleFloat)
  bits 28...31 - unused
 
  Note that all combinations of the flags FFIFlagPointer, FFIFlagAtomic, and FFIFlagStructure are invalid, EXCEPT from the following:
 
  FFIFlagPointer + FFIFlagAtomic:
  This defines a pointer to an atomic type (e.g., 'char*', 'int*').
  The actual atomic type is represented in the atomic type bits.
 
  FFIFlagPointer + FFIFlagStructure:
  This defines a structure which is a typedef of a pointer type as in
  typedef void* VoidPointer;
  typedef Pixmap* PixmapPtr;
  It requires a byte size of four or eight (e.g. a 32-bit or 64-bit pointer) to work correctly.
 
  [Note: Other combinations may be allowed in the future]
  !

Item was removed:
- ----- Method: ExternalType>>asPointerType: (in category 'converting') -----
- asPointerType: anotherPointerSize
- "convert the receiver into a pointer type"
- | type |
- type := self asPointerType.
- ^type pointerSize = anotherPointerSize
- ifTrue: [type]
- ifFalse:
- [type copy pointerSize: anotherPointerSize; yourself]!

Item was changed:
  ----- Method: ExternalType>>pointerSize (in category 'accessing') -----
  pointerSize
+
+ ^ self asPointerType headerWord bitAnd: FFIStructSizeMask!
- "Answer the pointer size of the receiver, if specified."
- ^pointerSize!

Item was changed:
  ----- Method: ExternalType>>readFieldAt: (in category 'private') -----
  readFieldAt: byteOffset
  "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset.
  Private. Used for field definition only."
  self isPointerType ifTrue:
  [| accessor |
  accessor := self pointerSize caseOf: {
- [nil] -> [#pointerAt:].
  [4] -> [#shortPointerAt:].
  [8] -> [#longPointerAt:] }.
  ^String streamContents:
  [:s|
  referentClass
  ifNil:
  [s nextPutAll: '^ExternalData fromHandle: (handle ', accessor, ' ';
  print: byteOffset;
  nextPutAll: ') type: ExternalType ';
  nextPutAll: (AtomicTypeNames at: self atomicType);
  nextPutAll: ' asPointerType']
  ifNotNil:
  [s nextPutAll: '^';
  print: referentClass;
  nextPutAll: ' fromHandle: (handle ', accessor, ' ';
  print: byteOffset;
  nextPut: $)]]].
 
  self isAtomic ifFalse: "structure type"
  [^String streamContents:[:s|
  s nextPutAll:'^';
  print: referentClass;
  nextPutAll:' fromHandle: (handle structAt: ';
  print: byteOffset;
  nextPutAll:' length: ';
  print: self byteSize;
  nextPutAll:')']].
 
  "Atomic non-pointer types"
  ^String streamContents:
  [:s|
  s nextPutAll:'^handle ';
  nextPutAll: (AtomicSelectors at: self atomicType);
  space; print: byteOffset].!

Item was changed:
  ----- Method: ExternalType>>writeFieldAt:with: (in category 'private') -----
  writeFieldAt: byteOffset with: valueName
  "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset.
  Private. Used for field definition only."
  self isPointerType ifTrue:
  [| accessor |
  accessor := self pointerSize caseOf: {
- [nil] -> [#pointerAt:].
  [4] -> [#shortPointerAt:].
  [8] -> [#longPointerAt:] }.
  ^String streamContents:
  [:s|
  s nextPutAll:'handle ', accessor, ' ';
  print: byteOffset;
  nextPutAll:' put: ';
  nextPutAll: valueName;
  nextPutAll:' getHandle.']].
 
  self isAtomic ifFalse:[
  ^String streamContents:[:s|
  s nextPutAll:'handle structAt: ';
  print: byteOffset;
  nextPutAll:' put: ';
  nextPutAll: valueName;
  nextPutAll:' getHandle';
  nextPutAll:' length: ';
  print: self byteSize;
  nextPutAll:'.']].
 
  ^String streamContents:[:s|
  s nextPutAll:'handle ';
  nextPutAll: (AtomicSelectors at: self atomicType);
  space; print: byteOffset;
  nextPutAll:' put: ';
  nextPutAll: valueName].!

Item was changed:
  ----- Method: ExternalUnion class>>compileFields:withAccessors: (in category 'field definition') -----
  compileFields: specArray withAccessors: aSymbol
  "Compile a type specification for the FFI machinery.
  Return the newly compiled spec.
  Eventually generate the field accessors according to the policy defined in aSymbol."
  | byteOffset maxByteSize typeSpec newCompiledSpec newByteAlignment |
  (specArray size > 0 and: [specArray first class ~~ Array]) ifTrue:
  [^ self error: 'unions must have fields defined by sub-Array'].
  byteOffset := 1.
  newByteAlignment := 1.
  maxByteSize := 0.
  typeSpec := WriteStream on: (WordArray new: specArray size + 1).
  typeSpec nextPut: FFIFlagStructure.
  "dummy for size"
  specArray do:
  [:spec |
  | fieldName fieldType isPointerField externalType typeSize typeAlignment selfRefering |
  fieldName := spec first.
  fieldType := spec second.
  isPointerField := fieldType last = $*.
  fieldType := (fieldType findTokens: '*') first withBlanksTrimmed.
  externalType := ExternalType atomicTypeNamed: fieldType.
  selfRefering := isPointerField and: [externalType isNil and: [fieldType = self asString]].
  selfRefering ifTrue: [
  externalType := ExternalType void asPointerType
  ] ifFalse:[
+ externalType ifNil: ["non-atomic"
+ (Symbol lookup: fieldType) ifNotNil: [:sym |
+ externalType := ExternalType structTypeNamed: sym].
- externalType == nil ifTrue: ["non-atomic"
- Symbol
- hasInterned: fieldType
- ifTrue: [:sym | externalType := ExternalType structTypeNamed: sym].
  ].
+ externalType ifNil: [
- externalType == nil ifTrue:[
  Transcript show: '(' , fieldType , ' is void)'.
  externalType := ExternalType void.
  ].
+ isPointerField ifTrue: [externalType := externalType asPointerType]].
- isPointerField ifTrue: [externalType := externalType asPointerType: self pointerSize]].
  typeSize := externalType byteSize.
  typeAlignment := externalType byteAlignment.
  spec size > 2 ifTrue: ["extra size"
  spec third < typeSize
  ifTrue: [^ self error: 'Explicit type size is less than expected'].
  typeSize := spec third.
  ].
  (fieldName notNil and: [self shouldGenerate: fieldName policy: aSymbol]) ifTrue: [
  self defineFieldAccessorsFor: fieldName startingAt: byteOffset type: externalType.
  ].
  typeSpec nextPutAll: (externalType embeddedSpecWithSize: typeSize).
  maxByteSize := maxByteSize max: typeSize.
  newByteAlignment := newByteAlignment max: typeAlignment
  ].
  maxByteSize := maxByteSize alignedTo: newByteAlignment.
  newCompiledSpec := typeSpec contents.
  newCompiledSpec at: 1 put: (maxByteSize bitOr: FFIFlagStructure).
  byteAlignment := newByteAlignment.
  ^ newCompiledSpec!

Item was changed:
  (PackageInfo named: 'FFI-Kernel') postscript: 'Smalltalk removeFromStartUpList: ExternalAddress.
+ Smalltalk removeFromStartUpList: ExternalObject.
+
+ "Since #pointerSize in ExternalType is never nil anymore, make the code generated for fields more specific, i.e., #shortPointerAt:(put:) or #longPointerAt:(put:).
+ ExternalStructure withAllSubclassesDo: [:cls | cls defineFields].
+ '!
- Smalltalk removeFromStartUpList: ExternalObject.'!


Reply | Threaded
Open this post in threaded view
|

Re: FFI Inbox: FFI-Kernel-mt.80.mcz

marcel.taeumel
Hi all!

I will keep this one in the inbox for a few days. If there are no complaints, I will merge it.

Best,
Marcel

Am 30.05.2020 18:39:17 schrieb [hidden email] <[hidden email]>:

A new version of FFI-Kernel was added to project FFI Inbox:
http://source.squeak.org/FFIinbox/FFI-Kernel-mt.80.mcz

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

Name: FFI-Kernel-mt.80
Author: mt
Time: 30 May 2020, 6:39:07.324231 pm
UUID: 4750dd07-8701-3146-9348-7a9064273fcf
Ancestors: FFI-Kernel-mt.79

Assure that #pointerSize in an external type can never be nil. Make it more clear that #pointerAt:(put:) is just a shortcut to be used for pointer arithmetic (see ExternalAddress >> #+). Struct field methods must be recompiled because of the field alignment. So, emitting #pointerAt:(put:) is of no use at all. Now we emit #(short|long)PointerAt:(put:).

Note that we only support 4-byte and 8-byte pointers. Thus, fail as early as possible if -- at some day -- #wordSize would be bigger than 8.

See discussion on vm-dev: http://forum.world.st/Re-squeak-dev-64-bit-FFI-was-porting-Croquet-to-Squeak6-0-alpha-tp5113318p5117466.html

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

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

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

Item was changed:
----- Method: ExternalStructure class>>compileFields:withAccessors: (in category 'field definition') -----
compileFields: specArray withAccessors: aSymbol
"Compile a type specification for the FFI machinery.
Return the newly compiled spec.
Eventually generate the field accessors according to following rules:
- aSymbol = #always always generate the accessors
- aSymbol = #never never generate the accessors
- aSymbol = #generated only generate the auto-generated accessors
- aSymbol = #absent only generate the absent accessors"
| newByteAlignment byteOffset typeSpec newCompiledSpec |
(specArray size > 0 and: [specArray first class ~~ Array]) ifTrue:
[^ self compileAlias: specArray withAccessors: aSymbol].
byteOffset := 0.
newByteAlignment := self minStructureAlignment.
typeSpec := WriteStream on: (WordArray new: 10).
typeSpec nextPut: FFIFlagStructure.
"dummy for size"
specArray do:
[:spec | | fieldName fieldType isPointerField externalType typeSize fieldAlignment selfRefering |
fieldName := spec first.
fieldType := spec second.
isPointerField := fieldType last = $*.
fieldType := (fieldType findTokens: '*') first withBlanksTrimmed.
externalType := ExternalType atomicTypeNamed: fieldType.
selfRefering := isPointerField and: [externalType isNil and: [fieldType = self asString]].
selfRefering ifTrue: [
externalType := ExternalType void asPointerType
] ifFalse:[
+ externalType ifNil: ["non-atomic"
+ (Symbol lookup: fieldType) ifNotNil: [:sym |
+ externalType := ExternalType structTypeNamed: sym].
- externalType == nil ifTrue: ["non-atomic"
- Symbol
- hasInterned: fieldType
- ifTrue: [:sym | externalType := ExternalType structTypeNamed: sym].
].
+ externalType ifNil: [
- externalType == nil ifTrue:[
Transcript show: '(' , fieldType , ' is void)'.
externalType := ExternalType void.
].
+ isPointerField ifTrue: [externalType := externalType asPointerType]].
- isPointerField ifTrue: [externalType := externalType asPointerType: self pointerSize]].
typeSize := externalType byteSize.
fieldAlignment := (externalType byteAlignment max: self minFieldAlignment)
min: self maxFieldAlignment.
byteOffset := byteOffset alignedTo: fieldAlignment.
newByteAlignment := newByteAlignment max: fieldAlignment.
spec size > 2 ifTrue: ["extra size"
spec third <>
ifTrue: [^ self error: 'Explicit type size is less than expected'].
typeSize := spec third.
].
(fieldName notNil and: [self shouldGenerate: fieldName policy: aSymbol]) ifTrue: [
self defineFieldAccessorsFor: fieldName startingAt: byteOffset + 1 type: externalType.
].
typeSpec nextPutAll: (externalType embeddedSpecWithSize: typeSize).
byteOffset := byteOffset + typeSize.
].

newByteAlignment := newByteAlignment min: self maxStructureAlignment.
byteOffset := byteOffset alignedTo: newByteAlignment.
newCompiledSpec := typeSpec contents.
newCompiledSpec at: 1 put: (byteOffset bitOr: FFIFlagStructure).
byteAlignment := newByteAlignment.
^ newCompiledSpec!

Item was removed:
- ----- Method: ExternalStructure class>>pointerSize (in category 'accessing') -----
- pointerSize
- "Answer the size of pointers for this class. By default answer nil.
- Subclasses that contain pointers must define the size of a pointer if the code is to operate on 64-bit and 32-bit platforms.
- Currently we have no way of converting a type between 32- and 64- bit versions beyond recompiling it."
- ^nil!

Item was changed:
Object subclass: #ExternalType
+ instanceVariableNames: 'compiledSpec referentClass referencedType byteAlignment'
- instanceVariableNames: 'compiledSpec referentClass referencedType pointerSize byteAlignment'
classVariableNames: 'AtomicSelectors AtomicTypeNames AtomicTypes StructTypes'
poolDictionaries: 'FFIConstants'
category: 'FFI-Kernel'!

!ExternalType commentStamp: 'eem 6/25/2019 10:39' prior: 0!
An external type represents the type of external objects.

Instance variables:
compiledSpec Compiled specification of the external type
referentClass Class type of argument required
referencedType Associated (non)pointer type with the receiver
pointerSize The size of a pointer if the external type is a pointer or is a structure containing a pointer.
byteAlignment The desired alignment for a field of the external type within a structure. If nil it has yet to be computed.

Compiled Spec:
The compiled spec defines the type in terms which are understood by the VM. Each word is defined as:
bits 0...15 - byte size of the entity
bit 16 - structure flag (FFIFlagStructure)
This flag is set if the following words define a structure
bit 17 - pointer flag (FFIFlagPointer)
This flag is set if the entity represents a pointer to another object
bit 18 - atomic flag (FFIFlagAtomic)
This flag is set if the entity represents an atomic type.
If the flag is set the atomic type bits are valid.
bits 19...23 - unused
bits 24...27 - atomic type (FFITypeVoid ... FFITypeDoubleFloat)
bits 28...31 - unused

Note that all combinations of the flags FFIFlagPointer, FFIFlagAtomic, and FFIFlagStructure are invalid, EXCEPT from the following:

FFIFlagPointer + FFIFlagAtomic:
This defines a pointer to an atomic type (e.g., 'char*', 'int*').
The actual atomic type is represented in the atomic type bits.

FFIFlagPointer + FFIFlagStructure:
This defines a structure which is a typedef of a pointer type as in
typedef void* VoidPointer;
typedef Pixmap* PixmapPtr;
It requires a byte size of four or eight (e.g. a 32-bit or 64-bit pointer) to work correctly.

[Note: Other combinations may be allowed in the future]
!

Item was removed:
- ----- Method: ExternalType>>asPointerType: (in category 'converting') -----
- asPointerType: anotherPointerSize
- "convert the receiver into a pointer type"
- | type |
- type := self asPointerType.
- ^type pointerSize = anotherPointerSize
- ifTrue: [type]
- ifFalse:
- [type copy pointerSize: anotherPointerSize; yourself]!

Item was changed:
----- Method: ExternalType>>pointerSize (in category 'accessing') -----
pointerSize
+
+ ^ self asPointerType headerWord bitAnd: FFIStructSizeMask!
- "Answer the pointer size of the receiver, if specified."
- ^pointerSize!

Item was changed:
----- Method: ExternalType>>readFieldAt: (in category 'private') -----
readFieldAt: byteOffset
"Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset.
Private. Used for field definition only."
self isPointerType ifTrue:
[| accessor |
accessor := self pointerSize caseOf: {
- [nil] -> [#pointerAt:].
[4] -> [#shortPointerAt:].
[8] -> [#longPointerAt:] }.
^String streamContents:
[:s|
referentClass
ifNil:
[s nextPutAll: '^ExternalData fromHandle: (handle ', accessor, ' ';
print: byteOffset;
nextPutAll: ') type: ExternalType ';
nextPutAll: (AtomicTypeNames at: self atomicType);
nextPutAll: ' asPointerType']
ifNotNil:
[s nextPutAll: '^';
print: referentClass;
nextPutAll: ' fromHandle: (handle ', accessor, ' ';
print: byteOffset;
nextPut: $)]]].

self isAtomic ifFalse: "structure type"
[^String streamContents:[:s|
s nextPutAll:'^';
print: referentClass;
nextPutAll:' fromHandle: (handle structAt: ';
print: byteOffset;
nextPutAll:' length: ';
print: self byteSize;
nextPutAll:')']].

"Atomic non-pointer types"
^String streamContents:
[:s|
s nextPutAll:'^handle ';
nextPutAll: (AtomicSelectors at: self atomicType);
space; print: byteOffset].!

Item was changed:
----- Method: ExternalType>>writeFieldAt:with: (in category 'private') -----
writeFieldAt: byteOffset with: valueName
"Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset.
Private. Used for field definition only."
self isPointerType ifTrue:
[| accessor |
accessor := self pointerSize caseOf: {
- [nil] -> [#pointerAt:].
[4] -> [#shortPointerAt:].
[8] -> [#longPointerAt:] }.
^String streamContents:
[:s|
s nextPutAll:'handle ', accessor, ' ';
print: byteOffset;
nextPutAll:' put: ';
nextPutAll: valueName;
nextPutAll:' getHandle.']].

self isAtomic ifFalse:[
^String streamContents:[:s|
s nextPutAll:'handle structAt: ';
print: byteOffset;
nextPutAll:' put: ';
nextPutAll: valueName;
nextPutAll:' getHandle';
nextPutAll:' length: ';
print: self byteSize;
nextPutAll:'.']].

^String streamContents:[:s|
s nextPutAll:'handle ';
nextPutAll: (AtomicSelectors at: self atomicType);
space; print: byteOffset;
nextPutAll:' put: ';
nextPutAll: valueName].!

Item was changed:
----- Method: ExternalUnion class>>compileFields:withAccessors: (in category 'field definition') -----
compileFields: specArray withAccessors: aSymbol
"Compile a type specification for the FFI machinery.
Return the newly compiled spec.
Eventually generate the field accessors according to the policy defined in aSymbol."
| byteOffset maxByteSize typeSpec newCompiledSpec newByteAlignment |
(specArray size > 0 and: [specArray first class ~~ Array]) ifTrue:
[^ self error: 'unions must have fields defined by sub-Array'].
byteOffset := 1.
newByteAlignment := 1.
maxByteSize := 0.
typeSpec := WriteStream on: (WordArray new: specArray size + 1).
typeSpec nextPut: FFIFlagStructure.
"dummy for size"
specArray do:
[:spec |
| fieldName fieldType isPointerField externalType typeSize typeAlignment selfRefering |
fieldName := spec first.
fieldType := spec second.
isPointerField := fieldType last = $*.
fieldType := (fieldType findTokens: '*') first withBlanksTrimmed.
externalType := ExternalType atomicTypeNamed: fieldType.
selfRefering := isPointerField and: [externalType isNil and: [fieldType = self asString]].
selfRefering ifTrue: [
externalType := ExternalType void asPointerType
] ifFalse:[
+ externalType ifNil: ["non-atomic"
+ (Symbol lookup: fieldType) ifNotNil: [:sym |
+ externalType := ExternalType structTypeNamed: sym].
- externalType == nil ifTrue: ["non-atomic"
- Symbol
- hasInterned: fieldType
- ifTrue: [:sym | externalType := ExternalType structTypeNamed: sym].
].
+ externalType ifNil: [
- externalType == nil ifTrue:[
Transcript show: '(' , fieldType , ' is void)'.
externalType := ExternalType void.
].
+ isPointerField ifTrue: [externalType := externalType asPointerType]].
- isPointerField ifTrue: [externalType := externalType asPointerType: self pointerSize]].
typeSize := externalType byteSize.
typeAlignment := externalType byteAlignment.
spec size > 2 ifTrue: ["extra size"
spec third <>
ifTrue: [^ self error: 'Explicit type size is less than expected'].
typeSize := spec third.
].
(fieldName notNil and: [self shouldGenerate: fieldName policy: aSymbol]) ifTrue: [
self defineFieldAccessorsFor: fieldName startingAt: byteOffset type: externalType.
].
typeSpec nextPutAll: (externalType embeddedSpecWithSize: typeSize).
maxByteSize := maxByteSize max: typeSize.
newByteAlignment := newByteAlignment max: typeAlignment
].
maxByteSize := maxByteSize alignedTo: newByteAlignment.
newCompiledSpec := typeSpec contents.
newCompiledSpec at: 1 put: (maxByteSize bitOr: FFIFlagStructure).
byteAlignment := newByteAlignment.
^ newCompiledSpec!

Item was changed:
(PackageInfo named: 'FFI-Kernel') postscript: 'Smalltalk removeFromStartUpList: ExternalAddress.
+ Smalltalk removeFromStartUpList: ExternalObject.
+
+ "Since #pointerSize in ExternalType is never nil anymore, make the code generated for fields more specific, i.e., #shortPointerAt:(put:) or #longPointerAt:(put:).
+ ExternalStructure withAllSubclassesDo: [:cls | cls defineFields].
+ '!
- Smalltalk removeFromStartUpList: ExternalObject.'!