FFI: FFI-Kernel-mt.149.mcz

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

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

Name: FFI-Kernel-mt.149
Author: mt
Time: 15 May 2021, 7:04:06.411008 pm
UUID: 53902204-8aa9-cd42-b172-a5773374c06c
Ancestors: FFI-Kernel-mt.148

Adds mechanism to allocate using array classes (i.e. RawBitsArray's or ByteString) for array-of-atomics types. Can be disabled as preferenced, enabled by default. Does not affect #allocateExternal:.

(Do not treat 'char' and 'schar' as integer types anymore because in Squeak those are Character, not Integer.)

(Forces #minVal and #maxVal to use ByteArray.)

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

Item was added:
+ ----- Method: ByteArray class>>externalType (in category '*FFI-Kernel') -----
+ externalType
+
+ ^ ExternalType uint8_t asArrayType: nil!

Item was removed:
- ----- Method: ByteArray>>isNull (in category '*FFI-Kernel-pointers') -----
- isNull
- "Answer false since only pointers (i.e. external addresses) can be null."
-
- ^ false!

Item was added:
+ ----- Method: ByteString class>>externalType (in category '*FFI-Kernel') -----
+ externalType
+
+ ^ ExternalType char asArrayType: nil!

Item was added:
+ ----- Method: ByteString>>contentType (in category '*FFI-Kernel') -----
+ contentType
+
+ ^ self externalType contentType!

Item was added:
+ ----- Method: ByteString>>externalType (in category '*FFI-Kernel') -----
+ externalType
+
+ ^ self class externalType contentType asArrayType: self size!

Item was added:
+ ----- Method: ByteString>>free (in category '*FFI-Kernel') -----
+ free
+
+ self shouldNotImplement.!

Item was added:
+ ----- Method: ByteString>>from:to: (in category '*FFI-Kernel') -----
+ from: firstIndex to: lastIndex
+ "See ExternalData"
+
+ ^ self copyFrom: firstIndex to: lastIndex!

Item was added:
+ ----- Method: ByteString>>getHandle (in category '*FFI-Kernel') -----
+ getHandle
+ "I am my own handle."
+
+ ^ self!

Item was added:
+ ----- Method: ByteString>>isArray (in category '*FFI-Kernel') -----
+ isArray
+ "Maybe move to Trunk?"
+
+ ^ true!

Item was added:
+ ----- Method: ByteString>>isNull (in category '*FFI-Kernel') -----
+ isNull
+
+ ^ false!

Item was added:
+ ----- Method: ByteString>>reader (in category '*FFI-Kernel') -----
+ reader
+
+ ^ self!

Item was added:
+ ----- Method: ByteString>>setContentType: (in category '*FFI-Kernel') -----
+ setContentType: type
+ "See ExternalData."
+
+ self shouldNotImplement.!

Item was added:
+ ----- Method: ByteString>>setSize: (in category '*FFI-Kernel') -----
+ setSize: size
+ "See ExternalData."
+
+ self shouldNotImplement.!

Item was added:
+ ----- Method: ByteString>>writer (in category '*FFI-Kernel') -----
+ writer
+
+ ^ self!

Item was added:
+ ----- Method: ByteString>>zeroMemory (in category '*FFI-Kernel') -----
+ zeroMemory
+
+ 1 to: self size do: [:index |
+ self at: index put: Character null].!

Item was added:
+ ----- Method: DoubleByteArray class>>externalType (in category '*FFI-Kernel') -----
+ externalType
+
+ ^ ExternalType uint16_t asArrayType: nil!

Item was added:
+ ----- Method: DoubleWordArray class>>externalType (in category '*FFI-Kernel') -----
+ externalType
+
+ ^ ExternalType uint64_t asArrayType: nil!

Item was added:
+ ----- Method: ExternalData>>copy (in category 'copying') -----
+ copy
+ "Overwritten to obey #useArrayClasses preference."
+
+ self sizeCheck.
+ ExternalType useArrayClasses ifTrue: [
+ (self contentType allocateArrayClass: self size)
+ ifNotNil: [:array |
+ self withIndexDo: [:each :index |
+ array at: index put: each].
+ ^ array]].
+
+ ^ super copy!

Item was changed:
  Object subclass: #ExternalType
  instanceVariableNames: 'compiledSpec referentClass referencedType byteAlignment'
+ classVariableNames: 'ArrayClasses ArrayTypes AtomicSelectors AtomicTypeNames AtomicTypes ExtraTypeChecks StructTypes UseArrayClasses'
- classVariableNames: 'ArrayTypes 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>>extraTypeChecksDuring: (in category 'preferences') -----
+ extraTypeChecksDuring: aBlock
+
+ | priorValue |
+ priorValue := ExtraTypeChecks.
+ ExtraTypeChecks := true.
+ aBlock ensure: [ExtraTypeChecks := priorValue].!

Item was changed:
  ----- Method: ExternalType class>>initialize (in category 'class initialization') -----
  initialize
+ "
+ ExternalType initialize
+ "
- "ExternalType initialize"
  self initializeFFIConstants.
+ self initializeDefaultTypes.
+ self initializeArrayClasses.!
- self initializeDefaultTypes.!

Item was added:
+ ----- Method: ExternalType class>>initializeArrayClasses (in category 'class initialization') -----
+ initializeArrayClasses
+ "
+ ExternalType initializeArrayClasses.
+ "
+ ArrayClasses ifNil: [
+ ArrayClasses := IdentityDictionary new].
+
+ RawBitsArray allSubclasses collect: [:arrayClass |
+ [ArrayClasses at: arrayClass externalType contentType ifAbsentPut: arrayClass]
+ on: SubclassResponsibility do: [ "Ignore." ]].
+
+ ArrayClasses at: ExternalType unsignedChar put: ByteString.
+ ArrayClasses at: ExternalType signedChar put: ByteString. !

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.
+ ArrayClasses := nil.
 
  self initializeDefaultTypes.
  self resetAllStructureTypes.!

Item was added:
+ ----- Method: ExternalType class>>useArrayClasses (in category 'preferences') -----
+ useArrayClasses
+ <preference: 'Use Array Classes (i.e. RawBitsArray)'
+ categoryList: #('FFI Kernel')
+ description: 'When true, type-based allocation in (local) object memory will use array classes instead of a ByteArray wrapped in ExternalData. Does not apply to external allocation.'
+ type: #Boolean>
+ ^UseArrayClasses ifNil:[true]!

Item was added:
+ ----- Method: ExternalType class>>useArrayClasses: (in category 'preferences') -----
+ useArrayClasses: aBoolean
+
+ UseArrayClasses := aBoolean.!

Item was added:
+ ----- Method: ExternalType class>>useArrayClassesDuring: (in category 'preferences') -----
+ useArrayClassesDuring: aBlock
+
+ | priorValue |
+ priorValue := UseArrayClasses.
+ UseArrayClasses := true.
+ aBlock ensure: [UseArrayClasses := priorValue].!

Item was changed:
  ----- Method: ExternalType>>allocate: (in category 'external data') -----
  allocate: numElements
+ "Allocate space for containing an array of numElements of this dataType. Use a proper array class if present."
- "Allocate space for containing an array of numElements of this dataType"
 
  | handle |
+ self class useArrayClasses ifTrue: [
+ (self allocateArrayClass: numElements)
+ ifNotNil: [:array | ^ array]].
  handle := ByteArray new: self byteSize * numElements.
  ^ExternalData fromHandle: handle type: self size: numElements!

Item was added:
+ ----- Method: ExternalType>>allocateArrayClass: (in category 'external data') -----
+ allocateArrayClass: numElements
+ "Allocate space for containing an array of numElements of this dataType. Try to use an array class. Answer 'nil' if there is no such class for the receiver."
+
+ ^ ArrayClasses
+ at: self
+ ifPresent: [:arrayClass | arrayClass new: numElements]
+ ifAbsent: [nil]
+ !

Item was added:
+ ----- Method: ExternalType>>isCharType (in category 'testing - special') -----
+ isCharType
+
+ | type |
+ type := self atomicType.
+ ^ type = FFITypeUnsignedChar or: [type = FFITypeSignedChar]!

Item was changed:
  ----- Method: ExternalType>>isIntegerType (in category 'testing - integer') -----
  isIntegerType
  "Return true if the receiver is a built-in integer type"
  | type |
  type := self atomicType.
+ ^type > FFITypeBool and:[type <= FFITypeSignedLongLong]!
- ^type > FFITypeBool and:[type <= FFITypeSignedChar]!

Item was changed:
  ----- Method: ExternalType>>maxVal (in category 'accessing') -----
  maxVal
+ "Force ByteArray. Do not use #allocate:."
+
-
  | data bytes |
+ bytes := ByteArray new: self byteSize.
+ data := ExternalData fromHandle: bytes type: self size: 1.
- data := self allocate: 1.
- bytes := data getHandle.
 
  self isIntegerType ifTrue: [
  self isSigned ifTrue: [
  bytes atAllPut: 16rFF.
  FFIPlatformDescription current endianness = #little
  ifTrue: [bytes at: bytes size put: 16r7F]
  ifFalse: [bytes at: 1 put: 16r7F].
  ^ data value].
  self isUnsigned ifTrue: [
  bytes atAllPut: 16rFF.
  ^ data value]].
 
  self isFloatType ifTrue: [
  bytes atAllPut: 16rFF.
  self isSinglePrecision ifTrue: [
  FFIPlatformDescription current endianness = #little
  ifTrue: [
  bytes at: bytes size put: 16r7F.
  bytes at: bytes size - 1 put: 16r7F]
  ifFalse: [
  bytes at: 1 put: 16r7F.
  bytes at: 2 put: 16r7F].
  ^ data value].
  self isDoublePrecision ifTrue: [
  FFIPlatformDescription current endianness = #little
  ifTrue: [
  bytes at: bytes size put: 16r7F.
  bytes at: bytes size - 1 put: 16rEF]
  ifFalse: [
  bytes at: 1 put: 16r7F.
  bytes at: 2 put: 16rEF].
  ^ data value]].
 
  self error: 'maxVal not defined for this type'.!

Item was changed:
  ----- Method: ExternalType>>minVal (in category 'accessing') -----
  minVal
+ "Force ByteArray. Do not use #allocate:."
 
  | data bytes |
+ bytes := ByteArray new: self byteSize.
+ data := ExternalData fromHandle: bytes type: self size: 1.
- data := self allocate: 1.
- bytes := data getHandle.
 
  self isIntegerType ifTrue: [
  self isSigned ifTrue: [
  FFIPlatformDescription current endianness = #little
  ifTrue: [bytes at: bytes size put: 1 << 7]
  ifFalse: [bytes at: 1 put: 1 << 7].
  ^ data value].
  self isUnsigned ifTrue: [
  ^ data value]].
 
  self isFloatType ifTrue: [
  bytes atAllPut: 16rFF.
  self isSinglePrecision ifTrue: [
  FFIPlatformDescription current endianness = #little
  ifTrue: [bytes at: bytes size - 1 put: 16r7F]
  ifFalse: [bytes at: 2 put: 16r7F].
  ^ data value].
  self isDoublePrecision ifTrue: [
  FFIPlatformDescription current endianness = #little
  ifTrue: [bytes at: bytes size - 1 put: 16rEF]
  ifFalse: [bytes at: 2 put: 16rEF].
  ^ data value]].
 
  self error: 'minVal not defined for this type'.!

Item was added:
+ ----- Method: Float32Array class>>externalType (in category '*FFI-Kernel') -----
+ externalType
+
+ ^ ExternalType float asArrayType: nil!

Item was added:
+ ----- Method: Float64Array class>>externalType (in category '*FFI-Kernel') -----
+ externalType
+
+ ^ ExternalType double asArrayType: nil!

Item was added:
+ ----- Method: RawBitsArray class>>externalType (in category '*FFI-Kernel') -----
+ externalType
+
+ self subclassResponsibility.!

Item was added:
+ ----- Method: RawBitsArray>>contentType (in category '*FFI-Kernel') -----
+ contentType
+
+ ^ self externalType contentType!

Item was added:
+ ----- Method: RawBitsArray>>externalType (in category '*FFI-Kernel') -----
+ externalType
+
+ ^ self class externalType contentType asArrayType: self size!

Item was added:
+ ----- Method: RawBitsArray>>free (in category '*FFI-Kernel') -----
+ free
+
+ self shouldNotImplement.!

Item was added:
+ ----- Method: RawBitsArray>>from:to: (in category '*FFI-Kernel') -----
+ from: firstIndex to: lastIndex
+ "See ExternalData"
+
+ ^ self copyFrom: firstIndex to: lastIndex!

Item was added:
+ ----- Method: RawBitsArray>>getHandle (in category '*FFI-Kernel') -----
+ getHandle
+ "I am my own handle."
+
+ ^ self!

Item was added:
+ ----- Method: RawBitsArray>>isArray (in category '*FFI-Kernel') -----
+ isArray
+ "Maybe move to Trunk?"
+
+ ^ true!

Item was added:
+ ----- Method: RawBitsArray>>isNull (in category '*FFI-Kernel') -----
+ isNull
+
+ ^ false!

Item was added:
+ ----- Method: RawBitsArray>>reader (in category '*FFI-Kernel') -----
+ reader
+
+ ^ self!

Item was added:
+ ----- Method: RawBitsArray>>setContentType: (in category '*FFI-Kernel') -----
+ setContentType: type
+ "See ExternalData."
+
+ self shouldNotImplement.!

Item was added:
+ ----- Method: RawBitsArray>>setSize: (in category '*FFI-Kernel') -----
+ setSize: size
+ "See ExternalData."
+
+ self shouldNotImplement.!

Item was added:
+ ----- Method: RawBitsArray>>writer (in category '*FFI-Kernel') -----
+ writer
+
+ ^ self!

Item was added:
+ ----- Method: RawBitsArray>>zeroMemory (in category '*FFI-Kernel') -----
+ zeroMemory
+
+ self atAllPut: 0.!

Item was added:
+ ----- Method: SignedByteArray class>>externalType (in category '*FFI-Kernel') -----
+ externalType
+
+ ^ ExternalType int8_t asArrayType: nil!

Item was added:
+ ----- Method: SignedDoubleByteArray class>>externalType (in category '*FFI-Kernel') -----
+ externalType
+
+ ^ ExternalType int16_t asArrayType: nil!

Item was added:
+ ----- Method: SignedDoubleWordArray class>>externalType (in category '*FFI-Kernel') -----
+ externalType
+
+ ^ ExternalType int64_t asArrayType: nil!

Item was added:
+ ----- Method: SignedWordArray class>>externalType (in category '*FFI-Kernel') -----
+ externalType
+
+ ^ ExternalType int32_t asArrayType: nil!

Item was added:
+ ----- Method: WordArray class>>externalType (in category '*FFI-Kernel') -----
+ externalType
+
+ ^ ExternalType uint32_t asArrayType: nil!