[squeak-dev] FFI: FFI-Kernel-mt.149.mcz

commits at source.squeak.org commits at source.squeak.org
Sat May 15 17:04:07 UTC 2021


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!



More information about the Squeak-dev mailing list