FFI: FFI-Kernel-mt.106.mcz

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

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

Name: FFI-Kernel-mt.106
Author: mt
Time: 13 June 2020, 6:40:12.388471 pm
UUID: c2a1a9c3-1ef1-5843-b2ae-28b3d19ad833
Ancestors: FFI-Kernel-mt.105

Adds an interface to interpret ExternalData. The behavior compares with the code generated for struct-field accessors, i.e., #readFieldAt: <=> #handle:at: and #writeFieldAt:with: <=> #handle:at:put:.

In contrast to the interface in ByteArray/ExternalAddress, offer guards to avoid misinterpretation. For example, compare ExternalData >> #signedLongLongAt: with ByteArray >> #signedLongLongAt:. Note that you can always force a different interpretation through ExternalData >> #asType:.

Also clarify the role of ExternalData by hard-coding #byteAlignment, #byteSize, #compiledSpec, etc.

Also offer a simple way to convert external structures (and unions) to external data and back. Note the difference between #asExternalStructure and #getExternalStructure. I hope the name is okay.

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

Item was added:
+ ----- Method: ExternalData class>>byteAlignment (in category 'external type') -----
+ byteAlignment
+
+ ^ self externalType byteAlignment!

Item was added:
+ ----- Method: ExternalData class>>byteSize (in category 'external type') -----
+ byteSize
+
+ ^ self externalType byteSize!

Item was added:
+ ----- Method: ExternalData class>>compiledSpec (in category 'external type') -----
+ compiledSpec
+
+ ^ self externalType compiledSpec!

Item was added:
+ ----- Method: ExternalData class>>setCompiledSpec:byteAlignment: (in category 'external type') -----
+ setCompiledSpec: spec byteAlignment: alignment
+
+ self shouldNotImplement.!

Item was added:
+ ----- Method: ExternalData>>asExternalData (in category 'converting') -----
+ asExternalData
+
+ ^ self!

Item was added:
+ ----- Method: ExternalData>>asExternalStructure (in category 'converting') -----
+ asExternalStructure
+
+ self
+ assert: [type referentClass includesBehavior: ExternalStructure]
+ description: 'Wrong type'.
+
+ ^ type referentClass fromHandle: handle!

Item was added:
+ ----- Method: ExternalData>>asExternalUnion (in category 'converting') -----
+ asExternalUnion
+
+ self
+ assert: [type referentClass includesBehavior: ExternalUnion]
+ description: 'Wrong type'.
+
+ ^ type referentClass fromHandle: handle!

Item was added:
+ ----- Method: ExternalData>>asType: (in category 'converting') -----
+ asType: anExternalType
+
+ ^ ExternalData fromHandle: handle type: anExternalType!

Item was added:
+ ----- Method: ExternalData>>assert:at: (in category 'accessing') -----
+ assert: expectedType at: index
+
+ self
+ assert: [type = expectedType asPointerType]
+ description: 'Wrong type'.
+
+ ^ self at: index!

Item was added:
+ ----- Method: ExternalData>>assert:at:put: (in category 'accessing') -----
+ assert: expectedType at: index put: value
+
+ self
+ assert: [type = expectedType]
+ description: 'Wrong type'.
+
+ ^ self at: index put: value!

Item was added:
+ ----- Method: ExternalData>>at: (in category 'accessing') -----
+ at: index
+
+ self
+ flag: #externalDataArray;
+ assert: [index = 1 or: [type isAtomic]]
+ description: 'Should not read non-atomic pointer as array'.
+
+ ^ type asNonPointerType
+ handle: handle
+ at: ((index-1) * type asNonPointerType byteSize) + 1!

Item was added:
+ ----- Method: ExternalData>>at:put: (in category 'accessing') -----
+ at: index put: value
+
+ self
+ flag: #externalDataArray;
+ assert: [index = 1 or: [type isAtomic]]
+ description: 'Should not read non-atomic pointer as array'.
+
+ ^ type asNonPointerType
+ handle: handle
+ at: ((index-1) * type asNonPointerType byteSize) + 1
+ put: value!

Item was added:
+ ----- Method: ExternalData>>booleanAt: (in category 'accessing - atomic values') -----
+ booleanAt: index
+
+ ^ self
+ assert: ExternalType bool
+ at: index!

Item was added:
+ ----- Method: ExternalData>>booleanAt:put: (in category 'accessing - atomic values') -----
+ booleanAt: index put: value
+
+ ^ self
+ assert: ExternalType bool
+ at: index
+ put: value!

Item was added:
+ ----- Method: ExternalData>>doubleAt: (in category 'accessing - atomic values') -----
+ doubleAt: index
+
+ ^ self
+ assert: ExternalType double
+ at: index!

Item was added:
+ ----- Method: ExternalData>>doubleAt:put: (in category 'accessing - atomic values') -----
+ doubleAt: index put: value
+
+ ^ self
+ assert: ExternalType double
+ at: index
+ put: value!

Item was changed:
+ ----- Method: ExternalData>>externalType (in category 'accessing') -----
- ----- Method: ExternalData>>externalType (in category 'converting') -----
  externalType
 
  ^ type!

Item was added:
+ ----- Method: ExternalData>>floatAt: (in category 'accessing - atomic values') -----
+ floatAt: index
+
+ ^ self
+ assert: ExternalType float
+ at: index!

Item was added:
+ ----- Method: ExternalData>>floatAt:put: (in category 'accessing - atomic values') -----
+ floatAt: index put: value
+
+ ^ self
+ assert: ExternalType float
+ at: index
+ put: value!

Item was changed:
  ----- Method: ExternalData>>fromCString (in category 'converting') -----
  fromCString
  "Assume that the receiver represents a C string and convert it to a Smalltalk string. hg 2/25/2000 14:18"
 
  | stream index char |
+ self
+ assert: [self externalType = ExternalType string]
+ description: 'Wrong type'.
+
- type isPointerType ifFalse: [self error: 'External object is not a pointer type.'].
  stream := WriteStream on: String new.
  index := 1.
+ [(char := self at: index) = 0 asCharacter] whileFalse: [
- [(char := handle unsignedCharAt: index) = 0 asCharacter] whileFalse: [
  stream nextPut: char.
  index := index + 1].
  ^stream contents!

Item was added:
+ ----- 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: [type referentClass includesBehavior: ExternalStructure]
+ description: 'Wrong type'.
+
+ ^ self at: 1!

Item was added:
+ ----- 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: [type referentClass includesBehavior: ExternalUnion]
+ description: 'Wrong type'.
+
+ ^ self at: 1!

Item was added:
+ ----- Method: ExternalData>>signedByteAt: (in category 'accessing - atomic values') -----
+ signedByteAt: index
+
+ ^ self
+ assert: ExternalType signedByte
+ at: index!

Item was added:
+ ----- Method: ExternalData>>signedByteAt:put: (in category 'accessing - atomic values') -----
+ signedByteAt: index put: value
+
+ ^ self
+ assert: ExternalType signedByte
+ at: index
+ put: value!

Item was added:
+ ----- Method: ExternalData>>signedCharAt: (in category 'accessing - atomic values') -----
+ signedCharAt: index
+
+ ^ self
+ assert: ExternalType signedChar
+ at: index!

Item was added:
+ ----- Method: ExternalData>>signedCharAt:put: (in category 'accessing - atomic values') -----
+ signedCharAt: index put: value
+
+ ^ self
+ assert: ExternalType signedChar
+ at: index
+ put: value!

Item was added:
+ ----- Method: ExternalData>>signedLongAt: (in category 'accessing - atomic values') -----
+ signedLongAt: index
+
+ ^ self
+ assert: ExternalType signedLong
+ at: index!

Item was added:
+ ----- Method: ExternalData>>signedLongAt:put: (in category 'accessing - atomic values') -----
+ signedLongAt: index put: value
+
+ ^ self
+ assert: ExternalType signedLong
+ at: index
+ put: value!

Item was added:
+ ----- Method: ExternalData>>signedLongLongAt: (in category 'accessing - atomic values') -----
+ signedLongLongAt: index
+
+ ^ self
+ assert: ExternalType signedLongLong
+ at: index!

Item was added:
+ ----- Method: ExternalData>>signedLongLongAt:put: (in category 'accessing - atomic values') -----
+ signedLongLongAt: index put: value
+
+ ^ self
+ assert: ExternalType signedLongLong
+ at: index
+ put: value!

Item was added:
+ ----- Method: ExternalData>>signedShortAt: (in category 'accessing - atomic values') -----
+ signedShortAt: index
+
+ ^ self
+ assert: ExternalType signedShort
+ at: index!

Item was added:
+ ----- Method: ExternalData>>signedShortAt:put: (in category 'accessing - atomic values') -----
+ signedShortAt: index put: value
+
+ ^ self
+ assert: ExternalType signedShort
+ at: index
+ put: value!

Item was added:
+ ----- Method: ExternalData>>unsignedByteAt: (in category 'accessing - atomic values') -----
+ unsignedByteAt: index
+
+ ^ self
+ assert: ExternalType unsignedByte
+ at: index!

Item was added:
+ ----- Method: ExternalData>>unsignedByteAt:put: (in category 'accessing - atomic values') -----
+ unsignedByteAt: index put: value
+
+ ^ self
+ assert: ExternalType unsignedByte
+ at: index
+ put: value!

Item was added:
+ ----- Method: ExternalData>>unsignedCharAt: (in category 'accessing - atomic values') -----
+ unsignedCharAt: index
+
+ ^ self
+ assert: ExternalType unsignedChar
+ at: index!

Item was added:
+ ----- Method: ExternalData>>unsignedCharAt:put: (in category 'accessing - atomic values') -----
+ unsignedCharAt: index put: value
+
+ ^ self
+ assert: ExternalType unsignedChar
+ at: index
+ put: value!

Item was added:
+ ----- Method: ExternalData>>unsignedLongAt: (in category 'accessing - atomic values') -----
+ unsignedLongAt: index
+
+ ^ self
+ assert: ExternalType unsignedLong
+ at: index!

Item was added:
+ ----- Method: ExternalData>>unsignedLongAt:put: (in category 'accessing - atomic values') -----
+ unsignedLongAt: index put: value
+
+ ^ self
+ assert: ExternalType unsignedLong
+ at: index
+ put: value!

Item was added:
+ ----- Method: ExternalData>>unsignedLongLongAt: (in category 'accessing - atomic values') -----
+ unsignedLongLongAt: index
+
+ ^ self
+ assert: ExternalType unsignedLongLong
+ at: index!

Item was added:
+ ----- Method: ExternalData>>unsignedLongLongAt:put: (in category 'accessing - atomic values') -----
+ unsignedLongLongAt: index put: value
+
+ ^ self
+ assert: ExternalType unsignedLongLong
+ at: index
+ put: value!

Item was added:
+ ----- Method: ExternalData>>unsignedShortAt: (in category 'accessing - atomic values') -----
+ unsignedShortAt: index
+
+ ^ self
+ assert: ExternalType unsignedShort
+ at: index!

Item was added:
+ ----- Method: ExternalData>>unsignedShortAt:put: (in category 'accessing - atomic values') -----
+ unsignedShortAt: index  put: value
+
+ ^ self
+ assert: ExternalType unsignedShort
+ at: index
+ put: value!

Item was added:
+ ----- Method: ExternalData>>voidAt: (in category 'accessing - atomic values') -----
+ voidAt: index
+ "no accessors for void"
+ ^self shouldNotImplement!

Item was added:
+ ----- Method: ExternalData>>voidAt:put: (in category 'accessing - atomic values') -----
+ voidAt: index put: value
+ "no accessors for void"
+ ^self shouldNotImplement!

Item was added:
+ ----- Method: ExternalStructure>>asExternalData (in category 'converting') -----
+ asExternalData
+
+ ^ ExternalData fromHandle: self getHandle type: self externalType!

Item was added:
+ ----- Method: ExternalStructure>>asExternalStructure (in category 'converting') -----
+ asExternalStructure
+
+ ^ self!

Item was added:
+ ----- Method: ExternalStructure>>asExternalUnion (in category 'converting') -----
+ asExternalUnion
+
+ ^ self!

Item was added:
+ ----- 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 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)].
+
+ 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 added:
+ ----- 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 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 changed:
+ ----- Method: ExternalType>>readAlias (in category 'external structure') -----
- ----- Method: ExternalType>>readAlias (in category 'private') -----
  readAlias
 
  ^ String streamContents: [:s |
  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') -----
- ----- 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 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 ', accessor, ' ';
  print: byteOffset;
  nextPutAll: ') type: ExternalType '.
  shouldReadCString
  ifTrue:
  [s nextPutAll: 'string) fromCString']
  ifFalse:
  [s nextPutAll: self atomicTypeName;
  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>>writeAliasWith: (in category 'external structure') -----
- ----- Method: ExternalType>>writeAliasWith: (in category 'private') -----
  writeAliasWith: valueName
 
  ^ String streamContents: [:s |
  (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') -----
- ----- Method: ExternalType>>writeFieldArgName (in category 'private') -----
  writeFieldArgName
 
  ^ 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') -----
- ----- Method: ExternalType>>writeFieldAt:with: (in category 'private') -----
  writeFieldAt: byteOffset with: valueName
  "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset.
  Private. Used for field definition only."
  self isPointerType ifTrue:
  [| accessor |
  self flag: #ffiLongVsInt. "mt: Here short means 'long', which is actually 'int', and long means 'longlong'. Sigh."
  accessor := self pointerSize caseOf: {
  [4] -> [#shortPointerAt:].
  [8] -> [#longPointerAt:] }.
 
  ^String streamContents:
  [:s|
  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.']]].
 
  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].!