FFI: FFI-Kernel-mt.100.mcz

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

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

Name: FFI-Kernel-mt.100
Author: mt
Time: 8 June 2020, 11:19:01.328961 am
UUID: f04e1d02-77fb-eb43-bf53-292fbf956863
Ancestors: FFI-Kernel-mt.99

Further work on support of type aliasing and its documentation. Removes FFIObjectHandle again because that would require modification of the FFI plugin, which is not worthwhile because it only would simplify print-strings. Add documentation about this issue to ExternalStructure >> #isNull.

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

Item was changed:
  ----- Method: ExternalData>>printPointerOn: (in category 'printing') -----
  printPointerOn: stream
+ "Ignore since it is part of the type, e.g. char* or int[] etc."!
- "Ignore since it is part of the type."!

Item was removed:
- ----- Method: ExternalObject>>isExternalAddress (in category 'testing') -----
- isExternalAddress
- "Return true if the receiver describes the address of an object in the outside world"
- ^false!

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
+ flag: #isTypeAliasForPointer;
- flag: #isTypeAliasToPointer;
  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."
- ifFalse: ["Usual case. Typedef for another struct type. Just re-use compiled spec and extras from the aliased type."
  self
  flag: #isTypeAlias;
  setCompiledSpec: externalType compiledSpec
  byteAlignment: externalType byteAlignment].!

Item was added:
+ ----- Method: ExternalStructure>>hasStableRepresentation (in category 'testing') -----
+ hasStableRepresentation
+ "Answers whether the contents of this structure have a stable representation in memory. Basically, every handle that is not a ByteArray can be considered a stable representation. The primary examples would be handles that are 'nil' or an ExternalAddress. Additionally, there can be type aliases to atomic types, which then store the Smalltalk object, e.g. Integer or Float, for such an atomic, e.g. long or float, directly in 'handle'. Those Smalltalk objects are typically immediate (e.g., integers, characters). Note that strings map to char*, which is an (atomic) pointer type and thus accessible only through an ExternalData, which itself always holds an external address as its handle."
+
+ ^ handle class ~~ ByteArray!

Item was changed:
  ----- Method: ExternalStructure>>isNull (in category 'testing') -----
  isNull
- self flag: #bug. "mt: We should not have (and use) #asByteArrayPointer and also think that #isNull cannot be implemented in ByteArray."
 
+ self flag: #ffiDesignSmell. "Type aliases to atomic types store data via handle as Smalltalk object. Consequently, #isNull and #isExternalAddress must not be sent to 'handle' without care. Actually, #isExternalAddress is rather useless at the moment."
+
+ handle class == ExternalAddress ifTrue: [^ handle isNull].
+ self hasStableRepresentation ifTrue: [^ handle isNil].
+
+ self flag: #ffiDesignSmell. "Type aliases to pointer types store pointers via handle as ByteArray, not ExternalAddress (like regular pointer types). Consequently, it is tricky to detect a NULL pointer in the general sense. Here, try to check for #isTypeAliasForPointer and only then check for all bytes being 0 in the byte array."
+
+ "self assert: [self externalType isTypeAliasForPointer => [handle class == ByteArray]]."
+ ^ self externalType isTypeAliasForPointer
+ and: [handle allSatisfy: [:byte | byte = 0 ]]!
- ^ super isNull or: [
- self externalType isTypeAliasToPointer and: [
- handle class == ByteArray
- and: [ handle allSatisfy: [:byte | byte = 0 ]]]]!

Item was added:
+ ----- Method: ExternalStructure>>printIdentityOn: (in category 'printing') -----
+ printIdentityOn: stream
+ "Reveal information about this external object's identity so that users can quickly assess the need for inspecting its contents. Users can also infer lifetime properties and consider those when passing this object around in the system. For example, objects that are created on-the-fly when accessing fields via an external address may be of less value compared to objects that are actually hold at those external addresses. See #printPointerOn:."
+
+ handle ifNil: [
+ ^ stream nextPutAll: '<UNDEFINED>'].
+
+ self isNull ifTrue: [
+ ^ stream nextPutAll: '<NULL>'].
+
+ self hasStableRepresentation
+ ifTrue: ["Object has a stable representation. No need to expose its memory address in the UI."
+ ^ self]
+ ifFalse: ["Inform the user that this data was copied into object memory."
+ ^ stream nextPut: $<; print: handle identityHash; nextPut: $>].
+ !

Item was removed:
- ----- Method: ExternalStructure>>printNullOn: (in category 'printing') -----
- printNullOn: stream
-
- handle ifNil: [
- ^ stream nextPutAll: '<UNDEFINED>'].
-
- self isNull ifTrue: [
- ^ stream nextPutAll: '<NULL>'].
-
- handle isExternalAddress ifFalse: [
- "Inform the user that this data was copied into object memory."
- ^ stream nextPut: $<; print: handle identityHash; nextPut: $>].
- !

Item was changed:
  ----- Method: ExternalStructure>>printOn: (in category 'printing') -----
  printOn: stream
 
  super printOn: stream.
 
  self printPointerOn: stream.
+ self printIdentityOn: stream.!
- self printNullOn: stream.!

Item was changed:
  ----- Method: ExternalStructure>>printPointerOn: (in category 'printing') -----
  printPointerOn: stream
+ "Indicate whether this structure points to an external address or whether its contents got copied into a byte array in object memory."
 
  handle ifNil: [^ stream nextPutAll: '<UNDEFINED>'].
 
+ handle class == ExternalAddress
- handle isExternalAddress
  ifTrue: [stream nextPutAll: '*'].!

Item was changed:
  ----- Method: ExternalType class>>initializeAtomicTypes (in category 'class initialization') -----
  initializeAtomicTypes
  "ExternalType initialize"
 
  | atomicType byteSize type typeName byteAlignment |
  self flag: #ffiLongVsInt. "For a discussion about long vs. int see http://forum.world.st/Re-squeak-dev-64-bit-FFI-was-porting-Croquet-to-Squeak6-0-alpha-tp5113318.html."
 
  #(
  "name atomic id byte size byte alignment"
+ ('void' 0 0 0) "No non-pointer support in calls. Duh. ;-)"
+ ('bool' 1 1 1) "No pointer support in calls."
- ('void' 0 0 0)
- ('bool' 1 1 1)
  ('byte' 2 1 1)
  ('sbyte' 3 1 1)
  ('ushort' 4 2 2)
  ('short' 5 2 2)
  "!!!!!!" ('ulong' 6 4 "!!!!!!" 4)
  "!!!!!!" ('long' 7 4 "!!!!!!" 4)
  ('ulonglong' 8 8 8) "v.i."
  ('longlong' 9 8 8) "v.i."
  ('char' 10 1 1)
  ('schar' 11 1 1)
  ('float' 12 4 4)
  ('double' 13 8 8) "v.i."
  "TODO: ('longdouble' 14 10 16? 4?)"
  ) do:[:typeSpec| | compiled |
  typeName := typeSpec first.
  atomicType := typeSpec second.
  byteSize := typeSpec third.
  byteAlignment := typeSpec fourth.
 
  "0) On 32-bits Windows and MacOS, double and long long have an alignment of 8. But on 32-bit Linux, their alignment is 4. But not on a 32-bit Raspberry Pi OS."
  (FFIPlatformDescription current wordSize = 4
  and: [FFIPlatformDescription current isUnix
  and: [FFIPlatformDescription current isARM not]]) ifTrue: [
  (#('double' 'longlong' 'ulonglong') includes: typeName) ifTrue: [
  byteAlignment := 4]].
 
  "1) Regular type"
  type := (AtomicTypes at: typeName).
  compiled := WordArray with: ((byteSize bitOr: FFIFlagAtomic) bitOr:
  (atomicType bitShift: FFIAtomicTypeShift)).
  compiled ~= type compiledSpec
  "Preserve the identity of #compiledSpec."
  ifTrue: [type compiledSpec: compiled].
  type byteAlignment: byteAlignment.
 
  "2) Pointer type"
  type := type asPointerType.
  compiled := WordArray with: ((self pointerSpec bitOr: FFIFlagAtomic) bitOr:
  (atomicType bitShift: FFIAtomicTypeShift)).
  compiled ~= type compiledSpec
  "Preserve the identity of #compiledSpec."
  ifTrue: [type compiledSpec: compiled].
  type byteAlignment: self pointerAlignment.
  ].!

Item was changed:
  ----- Method: ExternalType>>isTypeAlias (in category 'testing') -----
  isTypeAlias
 
+ ^ self isPointerType not
+ and: [referentClass notNil and: [referentClass isTypeAlias]]!
- ^ referentClass
- ifNil: [false]
- ifNotNil: [:structClass | structClass isTypeAlias]!

Item was added:
+ ----- 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 added:
+ ----- Method: ExternalType>>isTypeAliasForPointer (in category 'testing') -----
+ isTypeAliasForPointer
+ "Answer whether this type aliases a pointer type, e.g., typedef char_ptr char*"
+ "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 removed:
- ----- Method: ExternalType>>isTypeAliasToPointer (in category 'testing') -----
- isTypeAliasToPointer
- "Answer whether this type aliases a pointer type, e.g., typedef char_ptr char*"
- ^ self isTypeAlias and: [self isStructureType and:[self headerWord anyMask: FFIFlagPointer]]!

Item was changed:
  ----- 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, '"']
- ifTrue:[s nextPutAll:'^handle object "', self readFieldArgName, '"']
  ifFalse:[s nextPutAll:'^ExternalData fromHandle: handle'.
  self isPointerType ifTrue:[s nextPutAll:' asExternalPointer'].
  s nextPutAll:' type: ';
  nextPutAll: self asPointerType storeString]]
  ifFalse:[s nextPutAll:'^', referentClass name,' fromHandle: handle'.
  self isPointerType ifTrue:[s nextPutAll:' asExternalPointer']]]!

Item was removed:
- ----- Method: ExternalType>>readFieldArgName (in category 'private') -----
- readFieldArgName
-
- ^ self writeFieldArgName!

Item was changed:
  ----- Method: ExternalType>>readFieldAt: (in category 'private') -----
  readFieldAt: byteOffset
  "Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset.
  Private. Used for field definition only."
  self isPointerType ifTrue:
  [| accessor |
  self flag: #ffiLongVsInt. "mt: Here short means 'long', which is actually 'int', and long means 'longlong'. Sigh."
  accessor := self pointerSize caseOf: {
  [4] -> [#shortPointerAt:].
  [8] -> [#longPointerAt:] }.
  ^String streamContents:
  [:s|
  referentClass
  ifNil:
  [s nextPutAll: '^ExternalData fromHandle: (handle ', accessor, ' ';
  print: byteOffset;
  nextPutAll: ') type: ExternalType ';
  nextPutAll: 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:' fromHandle: (FFIObjectHandle on: (handle ';
  nextPutAll: (AtomicSelectors at: self atomicType);
  space; print: byteOffset;
+ nextPutAll:')']].
- 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 'private') -----
  writeAliasWith: valueName
 
  ^ String streamContents: [:s |
  (referentClass == nil and:[self isAtomic and:[self isPointerType not]])
+ ifTrue:[s nextPutAll:'handle := ', valueName, '.']
- ifTrue:[s nextPutAll:'handle := FFIObjectHandle on: ', valueName, '.']
  ifFalse:[s nextPutAll:'handle := ', valueName,' getHandle'.
  self isPointerType ifTrue:[s nextPutAll:' asByteArrayPointer']]]!

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

Item was removed:
- Object subclass: #FFIObjectHandle
- instanceVariableNames: 'object'
- classVariableNames: ''
- poolDictionaries: ''
- category: 'FFI-Kernel'!
-
- !FFIObjectHandle commentStamp: 'mt 6/6/2020 13:11' prior: 0!
- I am a wrapper around an object and hence, in addition to ByteArray and ExternalAddress, the third kind of handle an external object can have. I am necessary to implement type aliasing.!

Item was removed:
- ----- Method: FFIObjectHandle class>>on: (in category 'instance creation') -----
- on: anObject
-
- ^ self new object: anObject!

Item was removed:
- ----- Method: FFIObjectHandle>>asByteArrayPointer (in category 'private') -----
- asByteArrayPointer
- "Return a ByteArray describing a pointer to the contents of the receiver."
- ^self shouldNotImplement!

Item was removed:
- ----- Method: FFIObjectHandle>>isExternalAddress (in category 'testing') -----
- isExternalAddress
-
- ^ false!

Item was removed:
- ----- Method: FFIObjectHandle>>isNull (in category 'testing') -----
- isNull
-
- ^ self object isNil!

Item was removed:
- ----- Method: FFIObjectHandle>>object (in category 'accessing') -----
- object
-
- ^ object!

Item was removed:
- ----- Method: FFIObjectHandle>>object: (in category 'accessing') -----
- object: anObject
-
- object := anObject.!

Item was removed:
- ----- Method: FFIObjectHandle>>printOn: (in category 'as yet unclassified') -----
- printOn: aStream
-
- aStream
- nextPutAll: '-> ';
- print: self object.!