FFI: FFI-Kernel-mt.181.mcz

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

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

Name: FFI-Kernel-mt.181
Author: mt
Time: 8 June 2021, 11:53:52.533752 am
UUID: d7c02d46-f7b6-4d41-a63a-dd327d60367a
Ancestors: FFI-Kernel-mt.180

Fixes and clean-up in array types. No need for #isPointerTypeForArray because #referentClass is used only for alias-to-array types as in other types. The #contentType has its own instVar.

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

Item was changed:
  ----- Method: ExternalArrayType class>>newTypeForContentType:size: (in category 'instance creation') -----
  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 |
  self
  flag: #contentVsContainer;
  assert: [contentType isTypeAlias or: [contentType isArrayType not]]
  description: 'No support for direct multi-dimensional containers yet. Use type aliases.'.
 
  self
  assert: [contentType isVoid not]
  description: 'No array types for void type!!'.
 
  self
  assert: [
  (ArrayTypes at: contentType typeName
  ifPresent: [:sizes | sizes at: numElements ifAbsent: [nil]]
  ifAbsent: [nil] ) isNil]
  description: 'Array type already exists. Use #typeNamed: to access it.'.
 
  type := ExternalArrayType basicNew.
  pointerType := ExternalPointerType basicNew.
 
  "1) Regular type"
  byteSize := numElements
  ifNil: [0] ifNotNil: [numElements * contentType byteSize].
  headerWord := contentType headerWord.
  headerWord := headerWord bitClear: FFIStructSizeMask.
  headerWord := headerWord bitOr: (byteSize min: FFIStructSizeMask).
  type
  setReferencedType: pointerType;
  compiledSpec: (WordArray with: headerWord);
  byteAlignment: (numElements ifNil: [0] ifNotNil: [contentType byteAlignment]);
+ setReferentClass: nil; "Like atomics and pointers-to-atomics, no dedicated class exists."
- setReferentClass: contentType referentClass;
  setContentType: contentType;
  setSize: numElements;
  setByteSize: byteSize.
 
  "2) Pointer type. Reuse the compiledSpec of the content-type's pointer type."
  pointerType
  setReferencedType: type;
  compiledSpec: (WordArray with: (self pointerSpec bitOr: FFIFlagAtomic "HACK!! To deceive the FFI plugin :)"));
  byteAlignment: self pointerAlignment;
  setReferentClass: nil.
 
  "3) Remember this new array type."
  (ArrayTypes at: contentType typeName ifAbsentPut: [WeakValueDictionary new])
  at: numElements put: type.
 
  ^ type!

Item was changed:
  ----- Method: ExternalArrayType>>allocate (in category 'external data') -----
  allocate
+ "Overwritten to allocate specific to contentType and size. Check referentClass to consider #isTypeAlias."
+
-
  | data |
  data := self contentType allocate: self size.
+ ^ referentClass
+ ifNil: [data "genuine arrays"]
+ ifNotNil: [referentClass fromHandle: data getHandle]!
- ^ self isTypeAlias
- ifTrue: [referentClass fromHandle: data getHandle]
- ifFalse: [data]!

Item was changed:
  ----- Method: ExternalArrayType>>allocateExternal (in category 'external data') -----
  allocateExternal
+ "Overwritten to allocate specific to contentType and size. Check referentClass to consider #isTypeAlias."
+
-
  | data |
  data := self contentType allocateExternal: self size.
+ ^ referentClass
+ ifNil: [data "genuine arrays"]
+ ifNotNil: [referentClass fromHandle: data getHandle]!
- ^ self isTypeAlias
- ifTrue: [referentClass fromHandle: data getHandle]
- ifFalse: [data]!

Item was changed:
  ----- Method: ExternalArrayType>>handle:at: (in category 'external data') -----
  handle: handle at: byteOffset
 
  | resultHandle |
  resultHandle := handle structAt: byteOffset length: self byteSize.
+ ^ referentClass
+ ifNotNil: [referentClass fromHandle: resultHandle]
+ ifNil: [ExternalData fromHandle: resultHandle type: self]!
- ^ self isTypeAlias
- ifTrue: [referentClass fromHandle: resultHandle]
- ifFalse: [ExternalData fromHandle: resultHandle type: self]!

Item was added:
+ ----- Method: ExternalArrayType>>newContentType: (in category 'private') -----
+ newContentType: typeOrNil
+ "My content type has changed. Update my byteSize."
+
+ | newByteSize newHeaderWord |
+ (contentType := typeOrNil)
+ 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 := contentType headerWord.
+ newByteSize := size ifNil: [0] ifNotNil: [size * (newHeaderWord bitAnd: FFIStructSizeMask)].
+ newHeaderWord := newHeaderWord bitClear: FFIStructSizeMask.
+ newHeaderWord := newHeaderWord bitOr: (newByteSize min: FFIStructSizeMask).
+ compiledSpec := WordArray with: newHeaderWord.
+ byteAlignment := contentType byteAlignment.
+ byteSize := newByteSize]!

Item was changed:
  ----- 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 'struct { void }'"
- ifNil: [ "my class has been removed - make me empty"
  compiledSpec := WordArray with: self class structureSpec.
+ byteAlignment := 1.
+ contentType := size := byteSize := nil]
+ ifNotNil: [ "I am an alias-to-array type. Update my specs."
+ | originalType |
+ originalType := referentClass originalType.
+ self assert: [originalType isArrayType].
+
+ compiledSpec := originalType compiledSpec.
+ byteAlignment := originalType byteAlignment.
+
+ contentType := originalType contentType.
+ size := originalType size.
+ byteSize := originalType byteSize]!
- byteAlignment := 1]
- ifNotNil: [ "my class has been changed - update my compiledSpec"
- newHeaderWord := referentClass compiledSpec first.
- newByteSize := size ifNil: [0] ifNotNil: [size * (newHeaderWord bitAnd: FFIStructSizeMask)].
- newHeaderWord := newHeaderWord bitClear: FFIStructSizeMask.
- newHeaderWord := newHeaderWord bitOr: (newByteSize min: FFIStructSizeMask).
- compiledSpec := WordArray with: newHeaderWord.
- byteAlignment := referentClass byteAlignment.
- byteSize := newByteSize]!

Item was changed:
  ----- Method: ExternalArrayType>>readFieldAt: (in category 'external structure') -----
  readFieldAt: byteOffset
 
+ ^ referentClass
+ ifNotNil: [
- ^ self isTypeAlias
- ifTrue: [
  '^ {1} fromHandle: (handle structAt: {1} length: {2})'
  format: {
  referentClass name.
  byteOffset.
  self byteSize}]
+ ifNil: [
- ifFalse: [
  '^ ExternalData fromHandle: (handle structAt: {1} length: {2}) type: {3}'
  format: {
  byteOffset.
  self byteSize.
  self storeStringForField}]!

Item was changed:
  ----- Method: ExternalArrayType>>storeOn: (in category 'printing') -----
  storeOn: aStream
 
+ referentClass ifNotNil: [
- self isTypeAlias ifTrue: [
  ^ aStream
  nextPutAll: referentClass name;
  nextPutAll: ' externalType'].
 
  aStream nextPut: $(.
  self contentType storeOn: aStream.
  aStream nextPutAll: ' asArrayType: '.
  aStream nextPutAll: self size asString.
  aStream nextPut: $).!

Item was changed:
  ----- Method: ExternalArrayType>>typeName (in category 'accessing') -----
  typeName
 
+ referentClass
+ ifNotNil: [^ super typeName].
- self isTypeAlias
- ifTrue: [^ super typeName].
 
  ^ String streamContents: [:stream | | inParentheses |
  (inParentheses := self contentType isPointerType not
  and: [self contentType asPointerType isTypeAlias])
  ifTrue: [stream nextPut: $(. "e.g. (*DoublePtr)[5]"].
 
  stream nextPutAll: self contentType typeName.
 
  inParentheses ifTrue: [stream nextPut: $)].
 
  stream nextPut: $[.
  self size ifNotNil: [stream nextPutAll: self size asString].
  stream nextPut: $]. ]!

Item was changed:
  ----- Method: ExternalPointerType>>handle:at: (in category 'external data') -----
  handle: handle at: byteOffset
 
+ ^ referentClass
- | referentClassToUse |
- referentClassToUse := self isPointerTypeForArray
- ifFalse: [referentClass]
- ifTrue: [self asNonPointerType isTypeAlias
- ifTrue: [self asNonPointerType referentClass] ifFalse: [nil]].
- ^ referentClassToUse
  ifNotNil: [
+ referentClass fromHandle: (handle pointerAt: byteOffset length: self byteSize)]
- referentClassToUse fromHandle: (handle pointerAt: byteOffset length: self byteSize)]
  ifNil: [
  ExternalData
  fromHandle: (handle pointerAt: byteOffset length: self byteSize)
  type: self asNonPointerType "content type"]!

Item was removed:
- ----- Method: ExternalPointerType>>isPointerTypeForArray (in category 'testing') -----
- isPointerTypeForArray
- "referentClass is currently nil for pointer-to-array types. All operations on referentClass should check this to then use the referentClass from the non-pointer type. Might be changed once array information are encoded in the headerWord."
-
- ^ self asNonPointerType isArrayType!

Item was removed:
- ----- Method: ExternalPointerType>>newReferentClass: (in category 'private') -----
- newReferentClass: classOrNil
- "The class I'm referencing has changed. Keep pointer types for array types free of the referentClass so that FFI calls return ExternalData."
-
- self isPointerTypeForArray
- ifTrue: [referentClass := nil]
- ifFalse: [referentClass := classOrNil].!

Item was changed:
  ----- Method: ExternalPointerType>>originalType (in category 'accessing - type alias') -----
  originalType
  "Overwritten to look into my referencedType. See #isTypeAliasReferenced."
 
- self isPointerTypeForArray ifTrue: [
- ^ self asNonPointerType originalType asPointerType].
-
  ^ self "e.g. MyStructPtr" asNonPointerType isTypeAlias "e.g. *MyStructPtr"
  ifTrue: [super originalType asPointerType "e.g. MyStruct*, not MyStruct"]
  ifFalse: [super originalType]!

Item was changed:
  ----- Method: ExternalPointerType>>readFieldAt: (in category 'external structure') -----
  readFieldAt: byteOffset
 
- | referentClassToUse |
- referentClassToUse := self isPointerTypeForArray
- ifFalse: [referentClass]
- ifTrue: [self asNonPointerType isTypeAlias
- ifTrue: [self asNonPointerType referentClass] ifFalse: [nil]].
  ^ '^ {1} fromHandle: (handle pointerAt: {2} length: {3}){4}'
  format: {
+ (referentClass ifNil: [ExternalData]) name.
- (referentClassToUse ifNil: [ExternalData]) name.
  byteOffset.
  self byteSize.
+ referentClass ifNotNil: [''] ifNil: [
- referentClassToUse ifNotNil: [''] ifNil: [
  ' type: ', self asNonPointerType "content type" storeStringForField]}!

Item was changed:
  ----- Method: ExternalType class>>noticeModificationOf: (in category 'housekeeping') -----
  noticeModificationOf: aClass
+ "A subclass of ExternalStructure has been redefined."
- "A subclass of ExternalStructure has been redefined.
- Clean out any obsolete references to its type."
 
  aClass withAllSubclassesDo: [:cls | | typeName type |
  typeName := cls name.
 
- ArrayTypes at: typeName ifPresent: [:sizes |
- sizes do: [:arrayType | arrayType ifNotNil: [
- arrayType newReferentClass: cls.
- arrayType asPointerType newReferentClass: cls]]].
-
  (type := StructTypes at: typeName ifAbsent: [])
  ifNotNil: [
  type newReferentClass: cls.
  type asPointerType newReferentClass: cls.
+ type newTypeAlias].
+
+ ArrayTypes at: typeName ifPresent: [:sizes |
+ sizes do: [:arrayType | arrayType ifNotNil: [
+ arrayType newContentType: type]]].
+
+ "Alias-to-array types, which are stored in StructTypes, will not update via #newContentType:. We scan StructTypes for #isArrayType to find such aliases to then call #newContentType:."
+ StructTypes do: [:each |
+ (each notNil and: [each isArrayType and: [each contentType == type]])
+ ifTrue: [each newContentType: type]]].!
- type newTypeAlias]]!

Item was changed:
  ----- Method: ExternalType class>>noticeRemovalOf: (in category 'housekeeping') -----
  noticeRemovalOf: aClass
  "A subclass of ExternalStructure is being removed.
  Clean out any obsolete references to its type."
+
+ | typeName type |
+ typeName := aClass name.
+
+ (type := StructTypes at: typeName ifAbsent: [])
+ ifNotNil: [
+ type newReferentClass: nil.
+ type asPointerType newReferentClass: nil].
+
- | type |
- type := StructTypes at: aClass name ifAbsent:[nil].
- type == nil ifFalse:[
- type newReferentClass: nil.
- type asPointerType newReferentClass: nil].
  ArrayTypes at: aClass name ifPresent: [:sizes |
+ sizes do: [:arrayType | arrayType ifNotNil: [
+ arrayType newContentType: nil]].
+
+ "Alias-to-array types, which are stored in StructTypes, will not update via #newContentType:. We scan StructTypes for #isArrayType to find such aliases to then call #newContentType:."
+ StructTypes do: [:each |
+ (each notNil and: [each isArrayType and: [each contentType == type]])
+ ifTrue: [each newContentType: type]]].!
- sizes do: [:arrayType |
- arrayType newReferentClass: nil.
- arrayType asPointerType newReferentClass: nil]].!

Item was changed:
  ----- Method: ExternalUnknownType>>becomeArrayType (in category 'construction') -----
  becomeArrayType
  "I am now positive on #isTypeAliasForArray :-) Make myself an array type. Not that easy because Arraytype as extra instVars #size and #contentType."
 
  | newArrayType |
  newArrayType := ExternalArrayType basicNew
  compiledSpec: self compiledSpec;
  byteAlignment: self byteAlignment;
  setReferentClass: referentClass;
  setReferencedType: referencedType;
  setContentType: referentClass originalType contentType; "Hmm..."
  setSize: referentClass originalType size; "Hmm..."
  setByteSize: referentClass originalType byteSize; "Hmm..."
  yourself.
 
- "No referentClass for pointer types of array types."
- referencedType setReferentClass: nil.
-
  self becomeForward: newArrayType.
 
  ^ newArrayType!