FFI: FFI-Kernel-mt.153.mcz

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

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

Name: FFI-Kernel-mt.153
Author: mt
Time: 16 May 2021, 1:02:04.676551 pm
UUID: b7201890-f5ab-104b-bd0c-c4f82dca5af3
Ancestors: FFI-Kernel-mt.152

Yay! ^__^ Fixes the bug where alias-to-atomic types initialized the referentClass with the actual atomic instead of a proper handle (i.e. ByteArray or ExternalAddress).

Note that this fix renders #isInternalMemory unnecessary, which I replaced with "isExternalAddress not".

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

Item was removed:
- ----- Method: ByteArray>>isInternalMemory (in category '*FFI-Kernel-testing') -----
- isInternalMemory
-
- ^ true!

Item was changed:
  ----- Method: ByteArrayReadWriter class>>on: (in category 'instance creation') -----
  on: handle
  "Wraps the given handle into a read-writer. Avoid double-wrapping."
 
+ self assert: [handle isExternalAddress not].
- self assert: [handle isInternalMemory].
 
  ^ (thisContext objectClass: handle) == self
  ifTrue: [handle]
  ifFalse: [self new setArray: handle]!

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

Item was changed:
  ----- Method: ExternalAtomicType>>handle:at: (in category 'external data') -----
  handle: handle at: byteOffset
 
- | result |
- result :=  handle
- perform: (AtomicSelectors at: self atomicType)
- with: byteOffset.
  ^ referentClass
+ ifNil: [ "Genuine atomics"
+ handle
+ perform: (AtomicSelectors at: self atomicType)
+ with: byteOffset]
+ ifNotNil: [ "Alias to atomics"
+ referentClass fromHandle: (handle
+ structAt: byteOffset
+ length: self byteSize)]!
- ifNotNil: [referentClass fromHandle: result]
- ifNil: [result]!

Item was changed:
  ----- Method: ExternalAtomicType>>handle:at:put: (in category 'external data') -----
  handle: handle at: byteOffset put: value
 
+ ^ referentClass
+ ifNil: ["genuine atomic"
+ handle
+ perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
+ with: byteOffset
+ with: value]
+ ifNotNil: ["type alias"
+ handle
+ structAt: byteOffset
+ put: value getHandle
+ length: self byteSize]!
- ^ handle
- perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
- with: byteOffset
- with: (referentClass ifNil: [value] ifNotNil: [value getHandle])!

Item was changed:
  ----- Method: ExternalAtomicType>>readAlias (in category 'external structure') -----
  readAlias
 
+ ^ self readFieldAt: 1!
- ^ '^ {1}handle{2}'
- format: {
- referentClass ifNil: [''] ifNotNil: [
- referentClass name, ' fromHandle: '].
- referentClass ifNotNil: [''] ifNil: [
- ' "', self writeFieldArgName, '"'] }!

Item was changed:
  ----- Method: ExternalAtomicType>>readFieldAt: (in category 'external structure') -----
  readFieldAt: byteOffset
 
+ ^ referentClass
+ ifNil: [ "Genuine atomics"
+ '^ handle {1} {2}'
+ format: {
+ AtomicSelectors at: self atomicType.
+ byteOffset}]
+ ifNotNil: [ "Type alias"
+ '^ {1} fromHandle: (handle structAt: {2} length: {3})'
+ format: {
+ referentClass name.
+ byteOffset.
+ self byteSize}]!
- ^ '^ {1}handle {2} {3}{4}'
- format: {
- referentClass ifNil: [''] ifNotNil: [
- referentClass name, ' fromHandle: ('].
- AtomicSelectors at: self atomicType.
- byteOffset.
- referentClass ifNil: [''] ifNotNil: [')']}!

Item was changed:
  ----- Method: ExternalAtomicType>>writeAliasWith: (in category 'external structure') -----
  writeAliasWith: valueName
 
+ ^ self writeFieldAt: 1 with: valueName!
- ^ 'handle := {1}{2}.'
- format: {
- valueName.
- referentClass ifNil: [''] ifNotNil: [' getHandle']}!

Item was changed:
  ----- Method: ExternalAtomicType>>writeFieldAt:with: (in category 'external structure') -----
  writeFieldAt: byteOffset with: valueName
 
+ ^ referentClass
+ ifNil: ["genuine atomics"
+ 'handle {1} {2} put: {3}.'
+ format: {
+ AtomicSelectors at: self atomicType.
+ byteOffset.
+ valueName}]
+ ifNotNil: ["type alias"
+ 'handle structAt: {1} put: {2} getHandle length: {3}.'
+ format: {
+ byteOffset.
+ valueName.
+ self byteSize}]!
- ^ 'handle {1} {2} put: {3}{4}.'
- format: {
- AtomicSelectors at: self atomicType.
- byteOffset.
- valueName.
- referentClass ifNil: [''] ifNotNil: [' getHandle']}!

Item was changed:
  ----- Method: ExternalData class>>with: (in category 'instance creation') -----
  with: externalStructure
  "Put externalStructure into an array. Note that pointer types need to be elevated as pointer type of the array type. The content type MUST be a non-pointer type because the handle will decide between internal memory or external address."
 
  | contentType arrayType |
  contentType := externalStructure externalType asNonPointerType.
-
- contentType isAtomic ifTrue: [
- ^ (contentType allocate: 1)
- at: 1 put: externalStructure getHandle;
- yourself].
-
  arrayType := contentType asArrayType: 1.
 
  ^ ExternalData
  fromHandle: externalStructure getHandle
  type: arrayType!

Item was changed:
  ----- Method: ExternalData>>writer (in category 'accessing') -----
  writer
  "Overwritten to preserve type."
 
+ ^ handle isExternalAddress
+ ifTrue: [self]
+ ifFalse: [self class fromHandle: (ByteArrayReadWriter on: handle) type: type]!
- ^ handle isInternalMemory
- ifTrue: [self class fromHandle: (ByteArrayReadWriter on: handle) type: type]
- ifFalse: [self]!

Item was changed:
  ----- Method: ExternalPointerType>>readAlias (in category 'external structure') -----
  readAlias
+
+ ^ self asNonPointerType readAlias!
- "
- ExternalStructure defineAllFields.
- "
- ^ '^ {1} fromHandle: handle{2}' withCRs
- format: {
- (referentClass ifNil: [ExternalData]) name.
- referentClass ifNotNil: [''] ifNil: [
- ' type: ', self asNonPointerType "content type" storeString]}!

Item was changed:
  ----- Method: ExternalPointerType>>writeAliasWith: (in category 'external structure') -----
  writeAliasWith: valueName
 
+ ^ self asNonPointerType writeAliasWith: valueName!
- ^ 'handle := {1} getHandle.'
- format: {valueName}!

Item was changed:
  ----- Method: ExternalStructure>>free (in category 'initialize-release') -----
  free
  "Free the handle pointed to by the receiver"
 
+ handle isExternalAddress
- self externalType isPointerType
  ifTrue: [handle isNull ifFalse: [handle free]]
  ifFalse: [handle := nil].!

Item was changed:
  ----- Method: ExternalStructure>>isNull (in category 'testing') -----
  isNull
 
+ ^ (handle isExternalAddress and: [handle isNull])
- ^ (self externalType isPointerType and: [handle isNull])
  or: [handle isNil]!

Item was removed:
- ----- 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."
-
- handle ifNil: [
- ^ stream nextPutAll: '<UNDEFINED>'].
-
- self isNull ifTrue: [
- ^ stream nextPutAll: '<NULL>'].!

Item was changed:
  ----- Method: ExternalStructure>>printOn: (in category 'printing') -----
  printOn: stream
 
+ handle isExternalAddress
+ ifTrue: [
+ stream
+ nextPutAll: '@ ';
+ nextPutAll: self class name]
+ ifFalse: [
+ stream
+ nextPutAll: '[ ';
+ nextPutAll: self class name;
+ nextPutAll: ' ]'].
+ self isNull ifTrue: [
+ ^ stream nextPutAll: '<NULL>'].!
- | showBrackets |
- showBrackets := self externalType isPointerType not.
-
- showBrackets ifTrue: [stream nextPutAll: '['].
-
- super printOn: stream.
-
- showBrackets ifTrue: [stream nextPutAll: ']'].
-
- self printIdentityOn: stream.!

Item was changed:
  ----- Method: ExternalStructure>>writer (in category 'accessing') -----
  writer
 
+ ^ handle isExternalAddress
+ ifTrue: [self]
+ ifFalse: [self class fromHandle: (ByteArrayReadWriter on: handle)]!
- ^ handle isInternalMemory
- "Wrap handle into helper to address offsets in the byte array without copy."
- ifTrue: [self class fromHandle: (ByteArrayReadWriter on: handle)]
- "Either alias-to-atomic or already in external memory."
- ifFalse: [self]!

Item was changed:
  ----- Method: ExternalStructure>>zeroMemory (in category 'initialize-release') -----
  zeroMemory
  "Remove all information but keep the memory allocated."
 
+ handle zeroMemory: self byteSize.!
- self externalType isPointerType
- ifTrue: [handle zeroMemory: self byteSize]
- ifFalse: [self externalType isAtomic
- ifFalse: [handle zeroMemory: self byteSize]
- ifTrue: [handle := handle class zero]].!

Item was changed:
  ----- Method: ExternalType>>allocate (in category 'external data') -----
  allocate
  "Allocate a single representative for this type."
+
+ | data |
+ data := self asNonPointerType allocate: 1.
+ ^ referentClass ifNil: [data "genuine atomics"] ifNotNil: [data first]!
-
- ^ (self asNonPointerType allocate: 1) first!

Item was changed:
  ----- Method: ExternalType>>allocateExternal (in category 'external data') -----
  allocateExternal
  "Allocate a single representative for this type in external memory."
 
+ | data |
+ data := self asNonPointerType allocateExternal: 1.
+ ^ referentClass ifNil: [data "genuine atomics"] ifNotNil: [data first]!
- | result |
- ^ [(result := self asNonPointerType allocateExternal: 1) first]
- ensure: [ self isAtomic ifTrue: [result free] ]!

Item was removed:
- ----- Method: Object>>isInternalMemory (in category '*FFI-Kernel') -----
- isInternalMemory
- "Return true if the receiver describes a region of memory (within Squeak's object memory) to be interpreted (e.g., as external structure, pointer, ...). NOTE that this backstop is in Object because atomic types store actual objects (e.g., numbers) as their handle."
-
- ^ false!