FFI: FFI-Kernel-mt.131.mcz

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

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

Name: FFI-Kernel-mt.131
Author: mt
Time: 5 May 2021, 5:54:00.906784 pm
UUID: be0b9c3a-044c-fd46-926a-f0350ddcd315
Ancestors: FFI-Kernel-mt.130

Adds housekeeping for array types, which is necessary to update their byteSize as dependent struct types change.

Adds the notion of a #contentType to ExternalType to complement ArrayType >> #contentType. At the moment, it is just useful for 1-level pointers (e.g. char*) or pointers of array types (e.g. the pointer type for char[10]). Once we have a better way to encode and distinguish n-dimensional containers, we should adapt the implementation of #contentType.

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

Item was changed:
  ExternalType subclass: #ExternalArrayType
+ instanceVariableNames: 'size'
- instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: ''
  category: 'FFI-Kernel'!

Item was changed:
+ ----- Method: ExternalArrayType class>>newTypeForContentType:size: (in category 'instance creation') -----
- ----- Method: ExternalArrayType class>>newTypeForContentType:size: (in category 'as yet unclassified') -----
  newTypeForContentType: contentType size: numElements
  "!!!!!! Be aware that only the pointer type can be used in calls. As of SqueakFFIPrims VMMaker.oscog-eem.2950, there is no actual support for array types in the FFI plugin !!!!!!"
 
+ | type pointerType headerWord byteSize |
- | type pointerType headerWord byteSize |
- contentType ifNil: [^ nil].
- numElements < 0 ifTrue: [^ nil].
-
  self
  assert: [contentType isPointerType not]
  description: 'No support for pointers as content type yet!!'.
 
+ self
+ assert: [contentType byteSize > 0]
+ description: 'Invalid byte size!!'.
+
+ self
+ assert: [(ArrayTypes includesKey: contentType typeName -> numElements) not]
+ description: 'Array type already exists. Use #typeNamed: to access it.'.
+
+ type := self "ExternalArrayType" basicNew.
- type := self basicNew.
  pointerType := ExternalType basicNew.
 
  "1) Regular type"
  byteSize := numElements * contentType byteSize.
  self assert: [byteSize <= FFIStructSizeMask].
+ headerWord := contentType headerWord.
- headerWord := contentType headerWord copy.
  headerWord := headerWord bitClear: FFIStructSizeMask.
  headerWord := headerWord bitOr: byteSize.
  type
  setReferencedType: pointerType;
  compiledSpec: (WordArray with: headerWord);
  byteAlignment: contentType byteAlignment;
+ setReferentClass: contentType referentClass;
+ setSize: numElements.
- setReferentClass: contentType referentClass.
 
  "2) Pointer type. Reuse the compiledSpec of the content-type's pointer type."
  pointerType
  setReferencedType: type;
  compiledSpec: contentType asPointerType compiledSpec copy;
  byteAlignment: contentType asPointerType byteAlignment;
  setReferentClass: contentType asPointerType referentClass.
+
+ "3) Remember this new array type."
+ ArrayTypes
+ at: contentType typeName -> numElements
+ put: type.
+
-
  ^ type!

Item was changed:
+ ----- Method: ExternalArrayType>>contentType (in category 'external data') -----
- ----- Method: ExternalArrayType>>contentType (in category 'accessing') -----
  contentType
+ "Overwritten because array types have their content type as part of their non-pointer type."
+
-
  ^ ExternalType typeNamed: super typeName!

Item was added:
+ ----- Method: ExternalArrayType>>newReferentClass: (in category 'private') -----
+ newReferentClass: classOrNil
+ "The class I'm referencing has changed, which affects arrays of structs. Update my byteSize."
+
+ | newByteSize newHeaderWord |
+ (referentClass := classOrNil)
+ ifNil: [ "my class has been removed - make me empty"
+ compiledSpec := WordArray with: self class structureSpec.
+ byteAlignment := 1]
+ ifNotNil: [ "my class has been changed - update my compiledSpec"
+ newHeaderWord := referentClass compiledSpec first.
+ newByteSize := size * (newHeaderWord bitAnd: FFIStructSizeMask).
+ newHeaderWord := newHeaderWord bitClear: FFIStructSizeMask.
+ newHeaderWord := newHeaderWord bitOr: newByteSize.
+ compiledSpec := WordArray with: newHeaderWord.
+ byteAlignment := referentClass byteAlignment].!

Item was added:
+ ----- Method: ExternalArrayType>>setSize: (in category 'private') -----
+ setSize: numElements
+
+ size := numElements.!

Item was changed:
  ----- Method: ExternalArrayType>>size (in category 'accessing') -----
  size
  "Answers the number of elements for this array type."
 
+ ^ size!
- ^ self byteSize / self contentType byteSize!

Item was changed:
  ----- Method: ExternalData>>containerType (in category 'accessing - types') -----
  containerType
 
+ ^ (size isNil or: [type isVoid])
+ ifTrue: [type]
+ ifFalse: [self contentType asArrayType: size]!
- ^ type!

Item was changed:
  ----- Method: ExternalData>>contentType (in category 'accessing - types') -----
  contentType
 
+ ^ type contentType!
- self flag: #todo. "mt: For n-ary pointer types, we typically just want to reducy arity by one."
- ^ type asNonPointerType!

Item was added:
+ ----- Method: ExternalStructureType>>newReferentClass: (in category 'private') -----
+ newReferentClass: classOrNil
+ "The class I'm referencing has changed. Update my spec."
+
+ (referentClass := classOrNil)
+ ifNil: [ "my class has been removed - make me 'struct { void }'"
+ compiledSpec := WordArray with: self class structureSpec.
+ byteAlignment := 1]
+ ifNotNil: [ "my class has been changed - update my compiledSpec"
+ compiledSpec := referentClass compiledSpec.
+ byteAlignment := referentClass byteAlignment].!

Item was changed:
  Object subclass: #ExternalType
  instanceVariableNames: 'compiledSpec referentClass referencedType byteAlignment'
+ classVariableNames: 'ArrayTypes AtomicSelectors AtomicTypeNames AtomicTypes ExtraTypeChecks StructTypes'
- classVariableNames: 'AtomicSelectors AtomicTypeNames AtomicTypes ExtraTypeChecks StructTypes'
  poolDictionaries: 'FFIConstants'
  category: 'FFI-Kernel'!
 
  !ExternalType commentStamp: 'mt 6/5/2020 18:25' 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
  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 added:
+ ----- Method: ExternalType class>>arrayTypeFor:size: (in category 'instance lookup') -----
+ arrayTypeFor: contentType size: numElements
+ "Lookup fails if content type is not present."
+
+ | key |
+ key := contentType typeName -> numElements.
+ ^ (ArrayTypes at: key ifAbsent: [nil])
+ ifNil: [
+ ArrayTypes removeKey: key ifAbsent: [].
+ self
+ newTypeForContentType: contentType
+ size: numElements]!

Item was changed:
  ----- Method: ExternalType class>>arrayTypeNamed: (in category 'instance lookup') -----
  arrayTypeNamed: typeName
+ "Answers an array type for the content type and size specified in the typeName, e.g. char[10] or MyStruct[5]. Lookup fails silently (i.e. nil) if content type does not exist."
- "Lookup fails if content type is not present."
 
+ | arraySpec |
+ arraySpec := self parseArrayTypeName: typeName.
+ arraySpec second ifNil: [ ^ nil "content type unknown" ].
+ arraySpec third ifNil: [arraySpec at: 3 put: 0].
- | contentType |
- self flag: #todo. "mt: Cache array types?"
 
+ ^ self
+ arrayTypeFor: arraySpec second
+ size: arraySpec third!
- (contentType := self typeNamed: (typeName copyFrom: 1 to: (typeName indexOf: $[) - 1))
- ifNil: [^ nil].
-
- ^ self newTypeNamed: typeName!

Item was changed:
  ----- Method: ExternalType class>>cleanupUnusedTypes (in category 'housekeeping') -----
  cleanupUnusedTypes
+ "In the lookup table for struct types and array types, remove keys to types no longer present..
+
+ ExternalType cleanupUnusedTypes
+ "
+ Smalltalk garbageCollect.
+ StructTypes keys do: [:key |
+ (StructTypes at: key) ifNil: [
+ [StructTypes removeKey: key]]].
+ ArrayTypes keys do: [:key |
+ (ArrayTypes at: key) ifNil: [
+ [ArrayTypes removeKey: key]]].!
- "ExternalType cleanupUnusedTypes"
- | value |
- Smalltalk garbageCollect.
- StructTypes keys do:[:key|
- value := StructTypes at: key.
- value == nil ifTrue:[StructTypes removeKey: key ifAbsent:[]]].!

Item was changed:
  ----- Method: ExternalType class>>initializeStructureTypes (in category 'class initialization') -----
  initializeStructureTypes
  "Reset all non-pointer struct types to zero and their pointer companions to the appropriate pointer size."
 
  StructTypes ifNil: [
  StructTypes := WeakValueDictionary new].
+ ArrayTypes ifNil: [
+ ArrayTypes := WeakValueDictionary new].
 
  self cleanupUnusedTypes.
 
  StructTypes valuesDo:[:structType |
  structType "asNonPointerType"
  compiledSpec: (WordArray with: self structureSpec);
  byteAlignment: nil.
  structType asPointerType
  compiledSpec: (WordArray with: self pointerSpec);
+ byteAlignment: nil].
+ ArrayTypes valuesDo: [:arrayType |
+ arrayType
+ compiledSpec: (WordArray with: (arrayType headerWord bitClear: FFIStructSizeMask));
+ byteAlignment: nil.
+ arrayType asPointerType
+ compiledSpec: (WordArray with: self pointerSpec);
  byteAlignment: nil].!

Item was changed:
  ----- Method: ExternalType class>>newTypeNamed: (in category 'instance creation') -----
  newTypeNamed: aTypeName
  "Create a new struct type or array type. Not needed for atomic types; see #initializeDefaultTypes."
 
+ | structClass arraySpec |
- | structClass contentType contentTypeName numElements |
  self
  assert: [aTypeName last ~~ $*]
  description: 'Pointer type will be created automatically'.
 
+ aTypeName last == $] ifTrue: [ "array type, e.g., char[50]"
+ arraySpec := self parseArrayTypeName: aTypeName.
+ arraySpec second ifNil: [arraySpec at: 2 put: (self newTypeNamed: arraySpec first)].
+ arraySpec third ifNil: [arraySpec at: 3 put: 0].
- aTypeName last == $] ifTrue: [
- "array type, e.g., char[50]"
- contentTypeName:= aTypeName copyFrom: 1 to: (aTypeName indexOf: $[) - 1.
- contentType := (self typeNamed: contentTypeName) "Create new if not already there."
- ifNil: [self newTypeNamed: contentTypeName].
- numElements := ((aTypeName copyFrom: (aTypeName indexOf: $[) + 1 to: aTypeName size - 1) asInteger)
- ifNil: [0].
  ^ self
+ newTypeForContentType: arraySpec second
+ size: arraySpec third].
- newTypeForContentType: contentType
- size: numElements].
 
  structClass := (self environment classNamed: aTypeName)
  ifNotNil: [:class | (class includesBehavior: ExternalStructure) ifTrue: [class]].
 
  ^ structClass
  ifNil: [self newTypeForUnknownNamed: aTypeName]
  ifNotNil: [self newTypeForStructureClass: structClass]!

Item was changed:
  ----- Method: ExternalType class>>noticeModificationOf: (in category 'housekeeping') -----
  noticeModificationOf: aClass
  "A subclass of ExternalStructure has been redefined.
  Clean out any obsolete references to its type."
+
+ aClass withAllSubclassesDo: [:cls | | typeName |
+ typeName := cls name.
+ (StructTypes at: typeName ifAbsent: [])
+ ifNotNil: [:type |
+ type newReferentClass: cls.
+ type asPointerType newReferentClass: cls].
+ ArrayTypes keysAndValuesDo: [:nameSpec :arrayType |
+ nameSpec key = typeName "content type" ifTrue: [
+ arrayType newReferentClass: cls.
+ arrayType asPointerType newReferentClass: cls]]]!
- | type |
- aClass isBehavior ifFalse:[^nil]. "how could this happen?"
- aClass withAllSubclassesDo:[:cls|
- type := StructTypes at: cls name ifAbsent:[nil].
- type == nil ifFalse:[
- type newReferentClass: cls.
- type asPointerType newReferentClass: cls].
- ].!

Item was changed:
  ----- Method: ExternalType class>>noticeRenamingOf:from:to: (in category 'housekeeping') -----
  noticeRenamingOf: aClass from: oldName to: newName
  "An ExternalStructure has been renamed from oldName to newName.
  Keep our type names in sync."
+
+ (StructTypes at: oldName ifAbsent:[nil])
+ ifNotNil: [:type | StructTypes at: newName put: type].
+ StructTypes removeKey: oldName ifAbsent: [].
+
+ ArrayTypes keys do: [:nameSpec |
+ nameSpec key = oldName ifTrue: [
+ nameSpec key: newName]].
+ ArrayTypes rehash.!
- | type |
- type := StructTypes at: oldName ifAbsent:[nil].
- type == nil ifFalse:[StructTypes at: newName put: type].
- StructTypes removeKey: oldName ifAbsent:[].!

Item was added:
+ ----- Method: ExternalType class>>parseArrayTypeName: (in category 'private') -----
+ parseArrayTypeName: aTypeName
+
+ | contentTypeName contentType numElements |
+ contentTypeName:= aTypeName copyFrom: 1 to: (aTypeName indexOf: $[) - 1.
+ contentType := self typeNamed: contentTypeName.
+ numElements := (aTypeName copyFrom: (aTypeName indexOf: $[) + 1 to: aTypeName size - 1) asInteger.
+ ^ { contentTypeName . contentType . numElements }!

Item was changed:
  ----- Method: ExternalType class>>resetAllAtomicTypes (in category 'housekeeping') -----
  resetAllAtomicTypes
  "Warning: This call is only required if you change the initialization for AtomicTypes."
 
  AtomicTypes := nil.
  StructTypes := nil.
+ ArrayTypes := nil.
 
  self initializeDefaultTypes.
  self resetAllStructureTypes.!

Item was changed:
  ----- Method: ExternalType class>>resetAllStructureTypes (in category 'housekeeping') -----
  resetAllStructureTypes
  "Warning: This call is only required if you change the container for StructTypes!! Note that (2) and (3) can be swapped but that puts unnecessary pressure on the GC."
 
  StructTypes := nil.
+ ArrayTypes := nil.
 
  "1) Initialize the container for structure types."
  self initializeStructureTypes.
 
  "2) Recompile all FFI calls to create and persist structure types."
  self recompileAllLibraryFunctions.
 
  "3) Update all structure types' spec and alignment."
  ExternalStructure compileAllFields.
  !

Item was added:
+ ----- Method: ExternalType>>asArrayType: (in category 'converting') -----
+ asArrayType: numElements
+
+ ^ self class arrayTypeFor: self size: numElements!

Item was added:
+ ----- Method: ExternalType>>contentType (in category 'external data') -----
+ contentType
+
+ | result |
+ self
+ assert: [self isPointerType]
+ description: 'Content type is only defined for pointer types!!'.
+
+ result := self asNonPointerType.
+ ^ result isArrayType
+ ifTrue: [result contentType]
+ ifFalse: [result]!

Item was changed:
  ----- Method: ExternalType>>newReferentClass: (in category 'private') -----
+ newReferentClass: classOrNil
- newReferentClass: aClass
  "The class I'm referencing has changed. Update my spec."
+
+ referentClass := classOrNil.
+ self assert: [referentClass isNil or: [self isAtomic not and: [self isPointerType]]].!
- referentClass := aClass.
- self isPointerType ifTrue:[^self]. "for pointers only the referentClass changed"
- referentClass == nil ifTrue:[
- "my class has been removed - make me 'struct { void }'"
- compiledSpec := WordArray with: self class structureSpec.
- byteAlignment := 1.
- ] ifFalse:[
- "my class has been changed - update my compiledSpec"
- compiledSpec := referentClass compiledSpec.
- byteAlignment := referentClass byteAlignment.
- ].!

Item was changed:
  (PackageInfo named: 'FFI-Kernel') postscript: 'Smalltalk removeFromStartUpList: ExternalAddress.
  Smalltalk removeFromStartUpList: ExternalObject.
 
+ "Adds housekeeping for array types."
- "Split up types for external structures from atomic types."
  ExternalType resetAllStructureTypes.
 
  "Re-generate all field accessors because type checks are now controlled by a new preference."
  ExternalStructure defineAllFields.
  '!