FFI: FFI-Kernel-mt.141.mcz

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

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

Name: FFI-Kernel-mt.141
Author: mt
Time: 7 May 2021, 5:56:25.63964 pm
UUID: d7665324-f0e5-dc4d-a0bd-fa20b91338ef
Ancestors: FFI-Kernel-mt.140

Fixes some bugs and regressions:
- clean-up of unused struct and array types is working again (at system start up)
- (re-)creation of unknown struct types for never-existent referent-classes works now

Adds new accessors/tests on atomic types:
- #minVal, #maxVal
- #isSinglePrecision, #isDoublePrecision
- #asSinglePrecision, #asDoublePrecision

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

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]].
- [StructTypes removeKey: key]]].
  ArrayTypes keys do: [:key |
  (ArrayTypes at: key) ifNil: [
+ ArrayTypes removeKey: key]].!
- [ArrayTypes removeKey: key]]].!

Item was changed:
  ----- Method: ExternalType class>>structTypeNamed: (in category 'instance lookup') -----
  structTypeNamed: typeName
  "Answers the external type for the struct named typeName. If there is no type yet, create a new one but only if typeName can be matched to an existing class in the system already. If you still need a type even if there is no such class present, use #newTypeNamed: to create a type with an unknown referent class."
 
  ^ (StructTypes at: typeName ifAbsent: [nil])
+ ifNil: [
+ StructTypes removeKey: typeName ifAbsent: [].
+ self newTypeNamed: typeName]!
- ifNil: [ "Create struct types for existing struct classes on-the-fly."
- (self environment classNamed: typeName)
- ifNotNil: [:cls | (cls includesBehavior: ExternalStructure) ifTrue: [
- StructTypes removeKey: typeName ifAbsent: [].
- self newTypeNamed: typeName]]]!

Item was added:
+ ----- Method: ExternalType>>asDoublePrecision (in category 'converting - integer') -----
+ asDoublePrecision
+
+ self isDoublePrecision ifTrue: [^ self].
+ ^ AtomicTypes at: (AtomicTypeNames at: self atomicType + 1)!

Item was changed:
+ ----- Method: ExternalType>>asSigned (in category 'converting - integer') -----
- ----- Method: ExternalType>>asSigned (in category 'converting') -----
  asSigned
 
  self isSigned ifTrue: [^ self].
  ^ AtomicTypes at: (AtomicTypeNames at: self atomicType + 1)!

Item was added:
+ ----- Method: ExternalType>>asSinglePrecision (in category 'converting - integer') -----
+ asSinglePrecision
+
+ self isSinglePrecision ifTrue: [^ self].
+ ^ AtomicTypes at: (AtomicTypeNames at: self atomicType - 1)!

Item was changed:
+ ----- Method: ExternalType>>asUnsigned (in category 'converting - integer') -----
- ----- Method: ExternalType>>asUnsigned (in category 'converting') -----
  asUnsigned
 
  self isUnsigned ifTrue: [^ self].
  ^ AtomicTypes at: (AtomicTypeNames at: self atomicType - 1)!

Item was added:
+ ----- Method: ExternalType>>checkFloatType (in category 'private') -----
+ checkFloatType
+
+ self isFloatType
+ ifFalse: [self error: 'Test is only defined on integer types!!'].!

Item was added:
+ ----- Method: ExternalType>>isDoublePrecision (in category 'testing - float') -----
+ isDoublePrecision
+
+ self checkFloatType.
+ ^ self atomicType = FFITypeDoubleFloat !

Item was changed:
+ ----- Method: ExternalType>>isFloatType (in category 'testing - float') -----
- ----- Method: ExternalType>>isFloatType (in category 'testing') -----
  isFloatType
  "Return true if the receiver is a built-in float type"
  | type |
  type := self atomicType.
  ^type = FFITypeSingleFloat or: [type = FFITypeDoubleFloat]!

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

Item was changed:
+ ----- Method: ExternalType>>isSigned (in category 'testing - integer') -----
- ----- Method: ExternalType>>isSigned (in category 'testing') -----
  isSigned
  "Return true if the receiver is a signed integer type."
 
  self checkIntegerType.
  ^self atomicType anyMask: 1!

Item was added:
+ ----- Method: ExternalType>>isSinglePrecision (in category 'testing - float') -----
+ isSinglePrecision
+
+ self checkFloatType.
+ ^ self atomicType = FFITypeSingleFloat !

Item was changed:
+ ----- Method: ExternalType>>isUnsigned (in category 'testing - integer') -----
- ----- Method: ExternalType>>isUnsigned (in category 'testing') -----
  isUnsigned
  "Return true if the receiver is an unsigned integer type."
+
+ ^ self isSigned not!
-
- self checkIntegerType.
- ^self isSigned not!

Item was added:
+ ----- Method: ExternalType>>maxVal (in category 'accessing') -----
+ maxVal
+
+ | data bytes |
+ 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 added:
+ ----- Method: ExternalType>>minVal (in category 'accessing') -----
+ minVal
+
+ | data bytes |
+ 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 changed:
  ----- Method: FFIPlatformDescription class>>startUp: (in category 'system startup') -----
  startUp: resuming
  "Notify all FFI classes about platform changes."
 
  resuming ifTrue: [
  LastPlatform in: [:lastPlatform | self newCurrent in: [:currentPlatform |
  lastPlatform = currentPlatform
  ifTrue: [
  self flag: #discuss. "mt: Maybe add #platformResuming?"
+ ExternalAddress allBeNull.
+ ExternalType cleanupUnusedTypes ]
- ExternalAddress allBeNull]
  ifFalse: [
  LastPlatform := currentPlatform. "Update now. See #current."
  { ExternalAddress. ExternalType. ExternalStructure. ExternalPool }
  do: [:cls | cls
  platformChangedFrom: lastPlatform
  to: currentPlatform] ]]] ].!