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

commits at source.squeak.org commits at source.squeak.org
Thu Aug 19 09:12:49 UTC 2021


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

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

Name: FFI-Kernel-mt.215
Author: mt
Time: 19 August 2021, 11:12:47.424627 am
UUID: ca73c747-91ab-a749-8c8d-9ac0db1ca9bf
Ancestors: FFI-Kernel-mt.214

Generate type accessors for atomic types in ExternalType class. No need to hard-code them again. Names are already defined in #initializeAtomicTypeCodes and #initializeAtomicTypes.

Use type pool to generate quick-return accessors for atomic types in ExternalType and other struct-types in the type's class-side #externalType method. (Note that the use of the type pool can be disabled via #useTypePool preference.)

Adds enumerator to quickly access all known types.

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

Item was changed:
  ----- Method: ExternalAtomicType class>>newTypeForAtomicNamed: (in category 'instance creation') -----
  newTypeForAtomicNamed: atomicTypeName
  
  	| type pointerType |
  	type := ExternalAtomicType basicNew.
  	pointerType := ExternalPointerType basicNew.
  	
  	type setReferencedType: pointerType.
  	pointerType setReferencedType: type.
  	
  	type setAtomicTypeName: atomicTypeName.
  	AtomicTypes at: atomicTypeName put: type.
  	
+ 	type generateTypeAccessor.
  	^ type!

Item was added:
+ ----- Method: ExternalAtomicType>>generateTypeAccessor (in category 'external structure') -----
+ generateTypeAccessor
+ 	"Overwritten to generate accessors for atomic types directly in ExternalType class. Note that alias-to-atomic types have their referentClass; see super implementation."
+ 
+ 	| theClass selector category expression source |
+ 	referentClass ifNotNil: [^ super generateTypeAccessor].
+ 
+ 	theClass := ExternalType.
+ 	selector := self typeName.
+ 	category := '*autogenerated - type constants'.
+ 	expression := ExternalType useTypePool
+ 		ifTrue: [ExternalTypePool assuredPoolVarNameFor: self]
+ 		ifFalse: ['AtomicTypes at: ''{1}''' format: {self typeName}].
+ 	
+ 	source := '{1}\	{2}\	<generated>\	^ {3}' withCRs
+ 		format: {
+ 			selector.
+ 			'"This method was automatically generated. See {1}>>{2}"'
+ 				format: {thisContext methodClass. thisContext selector}.
+ 			expression }.
+ 	
+ 	theClass class
+ 		compileSilently: source
+ 		classified: category.!

Item was changed:
  ----- Method: ExternalStructureType class>>newTypeForStructureClass: (in category 'instance creation') -----
  newTypeForStructureClass: anExternalStructureClass
  	
  	| type pointerType referentClass |
  	referentClass := anExternalStructureClass.
  	
  	self
  		assert: [referentClass includesBehavior: ExternalStructure]
  		description: 'Wrong base class for structure'.
  	
  	type := self newTypeForUnknownNamed: referentClass name.
  	pointerType := type asPointerType.
  	
  	referentClass compiledSpec
  		ifNil: [ "First time. The referent class' fields are probably just compiled for the first time."
  			type setReferentClass: referentClass.
  			pointerType setReferentClass: referentClass]
  		ifNotNil: [
  			type newReferentClass: referentClass.
  			pointerType newReferentClass: referentClass].
  
+ 	type becomeKnownTypeSafely.
+ 	type generateTypeAccessor.
+ 	^ type!
- 	^ type becomeKnownTypeSafely!

Item was changed:
  Object subclass: #ExternalType
  	instanceVariableNames: 'compiledSpec referentClass referencedType byteAlignment'
  	classVariableNames: 'ArrayClasses ArrayTypes AtomicTypeCodes AtomicTypes ExtraTypeChecks StructTypes UseArrayClasses UseTypePool'
+ 	poolDictionaries: 'ExternalTypePool FFIConstants'
- 	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>>allTypeNames (in category 'instance list') -----
+ allTypeNames
+ 	"Answers the names of the currently known types."
+ 	
+ 	^ self allTypes collect: [:each | each typeName]!

Item was added:
+ ----- Method: ExternalType class>>allTypes (in category 'instance list') -----
+ allTypes
+ 	"Answers the currently known types."
+ 	
+ 	^ Array streamContents: [:stream |
+ 		self allTypesDo: [:type | stream nextPut: type]]!

Item was added:
+ ----- Method: ExternalType class>>allTypesDo: (in category 'instance list') -----
+ allTypesDo: block
+ 
+ 	self allAtomicTypesDo: block.
+ 	self allStructTypesDo: block.
+ 	self allPointerTypesDo: block.
+ 	self allArrayTypesDo: block.!

Item was removed:
- ----- Method: ExternalType class>>bool (in category 'type constants') -----
- bool
- 	^AtomicTypes at: 'bool'!

Item was removed:
- ----- Method: ExternalType class>>char16_t (in category 'type constants - stdint.h') -----
- char16_t
- 
- 	^ AtomicTypes at: 'char16_t'!

Item was removed:
- ----- Method: ExternalType class>>char32_t (in category 'type constants - stdint.h') -----
- char32_t
- 
- 	^ AtomicTypes at: 'char32_t'!

Item was removed:
- ----- Method: ExternalType class>>char8_t (in category 'type constants - stdint.h') -----
- char8_t
- 
- 	^ AtomicTypes at: 'char8_t'!

Item was removed:
- ----- Method: ExternalType class>>double (in category 'type constants') -----
- double
- 	^AtomicTypes at: 'double'!

Item was removed:
- ----- Method: ExternalType class>>float (in category 'type constants') -----
- float
- 	^AtomicTypes at: 'float'!

Item was removed:
- ----- Method: ExternalType class>>int16_t (in category 'type constants - stdint.h') -----
- int16_t
- 
- 	^ AtomicTypes at: 'int16_t'!

Item was removed:
- ----- Method: ExternalType class>>int32_t (in category 'type constants - stdint.h') -----
- int32_t
- 
- 	^ AtomicTypes at: 'int32_t'!

Item was removed:
- ----- Method: ExternalType class>>int64_t (in category 'type constants - stdint.h') -----
- int64_t
- 
- 	^ AtomicTypes at: 'int64_t'!

Item was removed:
- ----- Method: ExternalType class>>int8_t (in category 'type constants - stdint.h') -----
- int8_t
- 
- 	^ AtomicTypes at: 'int8_t'!

Item was changed:
  ----- Method: ExternalType class>>noticeModificationOf: (in category 'housekeeping') -----
  noticeModificationOf: aClass
  	"A subclass of ExternalStructure has been redefined."
  
  	aClass withAllSubclassesDo: [:cls | | typeName type |
  		typeName := cls name.
  		
  		(type := StructTypes at: typeName ifAbsent: [])
+ 			ifNil: ["Give unused types a chance to establish a hard reference via type accessor."
+ 				type := self structTypeNamed: typeName]
  			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:."
  		self flag: #performance.
  		StructTypes do: [:each |
  			(each notNil and: [each isArrayType and: [each contentType == type]])
  				ifTrue: [each newContentType: type]]].!

Item was removed:
- ----- Method: ExternalType class>>uchar16_t (in category 'type constants - stdint.h') -----
- uchar16_t
- 
- 	^ AtomicTypes at: 'uchar16_t'!

Item was removed:
- ----- Method: ExternalType class>>uchar32_t (in category 'type constants - stdint.h') -----
- uchar32_t
- 
- 	^ AtomicTypes at: 'uchar32_t'!

Item was removed:
- ----- Method: ExternalType class>>uchar8_t (in category 'type constants - stdint.h') -----
- uchar8_t
- 
- 	^ AtomicTypes at: 'uchar8_t'!

Item was removed:
- ----- Method: ExternalType class>>uint16_t (in category 'type constants - stdint.h') -----
- uint16_t
- 
- 	^ AtomicTypes at: 'uint16_t'!

Item was removed:
- ----- Method: ExternalType class>>uint32_t (in category 'type constants - stdint.h') -----
- uint32_t
- 
- 	^ AtomicTypes at: 'uint32_t'!

Item was removed:
- ----- Method: ExternalType class>>uint64_t (in category 'type constants - stdint.h') -----
- uint64_t
- 
- 	^ AtomicTypes at: 'uint64_t'!

Item was removed:
- ----- Method: ExternalType class>>uint8_t (in category 'type constants - stdint.h') -----
- uint8_t
- 
- 	^ AtomicTypes at: 'uint8_t'!

Item was changed:
  ----- Method: ExternalType class>>useTypePool (in category 'preferences') -----
  useTypePool
+ 	<preference: 'Use type pool in generated accessors'
- 	<preference: 'Use type pool in structure fields'
  		categoryList: #('FFI Kernel')
+ 		description: 'When true, fill a pool of external types to be used in type accessors and struct-field accessors, which makes type access much faster. See ExternalTypePool.'
- 		description: 'When true, fill a pool of external types to be used in struct-field accessors. See ExternalTypePool.'
  		type: #Boolean>
  	^UseTypePool ifNil: [true]!

Item was changed:
  ----- Method: ExternalType class>>useTypePool: (in category 'preferences') -----
  useTypePool: aBoolean
  
  	UseTypePool = aBoolean ifTrue: [^ self].
- 
  	UseTypePool := aBoolean.
+ 	Cursor wait showWhile: [ExternalTypePool update].!
- 	
- 	Cursor wait showWhile: [
- 		"Either fill or clean out the type pool."
- 		ExternalTypePool reset.
- 		ExternalStructure defineAllFields.
- 		ExternalTypePool cleanUp].!

Item was removed:
- ----- Method: ExternalType class>>void (in category 'type constants') -----
- void
- 	^AtomicTypes at: 'void'!

Item was added:
+ ----- Method: ExternalType>>generateTypeAccessor (in category 'external structure') -----
+ generateTypeAccessor
+ 	"Generate a fast accessor for the receiver, usually implemented on the class-side of the referentClass."
+ 	
+ 	| poolVarName theClass selector source category |
+ 	referentClass ifNil: [^ self "See ExternalAtomicType >> #generateTypeAccessor"].
+ 
+ 	theClass := referentClass.
+ 	selector := #externalType.
+ 
+ 	self
+ 		assert: [theClass ~~ ExternalStructure]
+ 		description: 'You must not overwrite the generic type accessor'.
+ 
+ 	ExternalType useTypePool ifFalse: [
+ 		SystemChangeNotifier uniqueInstance doSilently: [theClass class removeSelector: selector].
+ 		^ self "See ExternalStructure class >> #externalType"].
+ 
+ 	poolVarName := ExternalTypePool assuredPoolVarNameFor: self.
+ 	
+ 	source := '{1}\	{2}\	<generated>\	^ {3}' withCRs
+ 		format: {
+ 			selector.
+ 			'"This method was automatically generated. See {1}>>{2}"'
+ 				format: {thisContext methodClass. thisContext selector}.
+ 			poolVarName }.
+ 	
+ 	category := '*autogenerated - external type'.
+ 	theClass class compileSilently: source classified: category.!

Item was changed:
+ (PackageInfo named: 'FFI-Kernel') postscript: '"Update for generated type accessors."
+ ExternalType initialize..'!
- (PackageInfo named: 'FFI-Kernel') postscript: '"Update for new 16-bit and 32-bit character types. Do not use #resetAllTypes to keep existing FFI context functional such as allocated executable pages in FFICallback."
- ExternalType initialize.'!



More information about the Squeak-dev mailing list