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

commits at source.squeak.org commits at source.squeak.org
Tue May 4 07:54:27 UTC 2021


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

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

Name: FFI-Kernel-mt.127
Author: mt
Time: 4 May 2021, 9:54:26.141881 am
UUID: 143e5c5b-ccff-9143-823d-4d6657005d2c
Ancestors: FFI-Kernel-mt.126

Makes extra type checks optional, disabled by default. (This feature more care because some checks are wrong. Thanks to Ron for reporting this!)

(Also fixes Character zero, which should actually be the NUL character.)

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

Item was changed:
  ----- Method: Character class>>zero (in category '*FFI-Kernel') -----
  zero
  	"See ExternalStructure >> #zeroMemory."
  	
+ 	^ Character value: 0!
- 	^ $0!

Item was changed:
  ----- Method: ExternalStructureType>>checkType (in category 'external structure') -----
  checkType
  
+ 	self class extraTypeChecks ifFalse: [^ self].
+ 	
  	self
  		assert: [self isPointerType not]
  		description: 'Convert to ExternalType to use this feature'.
  
  	referentClass ifNil: [self error: 'Unknown structure type'].
  	self isEmpty ifTrue: [self error: 'Empty structure'].
  !

Item was changed:
  ----- Method: ExternalStructureType>>handle:at: (in category 'external data') -----
  handle: handle at: byteOffset
  	"Read the receiver's external type using the given handle and the byteOffset. This is the dynamic version of #readFieldAt:."
  	
  	| result |			
+ 	self checkType.
- 	self
- 		assert: [self isPointerType not]
- 		description: 'Use ExternalStructure to use this feature.'.
  
- 	referentClass ifNil: [self error: 'Unknown structure type'].
- 	self isEmpty ifTrue: [self error: 'Empty structure'].
- 
  	result := self isAtomic
  		ifTrue: [
  			handle "alias to atomic"
  				perform: (AtomicSelectors at: self atomicType)
  				with: byteOffset]
  		ifFalse: [
  			handle "regular struct or alias to struct or alias to pointer"
  				structAt: byteOffset length: self byteSize].
  
  	^ referentClass fromHandle: result!

Item was changed:
  ----- Method: ExternalStructureType>>handle:at:put: (in category 'external data') -----
  handle: handle at: byteOffset put: value
  	"Write a value using the receiver's external type at the given handle and byteOffset. This is the dynamic version of #writeFieldAt:with:."
  
+ 	self checkType.
- 	self
- 		assert: [self isPointerType not]
- 		description: 'Use ExternalType to use this feature.'.
- 
- 	referentClass ifNil: [self error: 'Unknown structure type'].			
- 	self isEmpty ifTrue: [self error: 'Empty structure'].
  	
  	self isAtomic
  		ifTrue: [ "alias to atomic"
  			self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
  			^ handle
  				perform: ((AtomicSelectors at: self atomicType), 'put:') asSymbol
  				with: byteOffset
  				with: value getHandle]
  		ifFalse: [ "regular struct or alias to struct or alias to pointer"
  			self assert: [value externalType == self].
  			^ handle
  				structAt: byteOffset
  				put: value getHandle
  				length: self byteSize].!

Item was changed:
  ----- Method: ExternalStructureType>>writeAliasWith: (in category 'external structure') -----
  writeAliasWith: valueName
  	"this is an aliased structure type"
  	"expect the value have that structure type with either byte array or external address as handle"
  
  	self checkType.
  	
  	^ String streamContents: [:s |
+ 		self class extraTypeChecks ifTrue: [
+ 			s nextPutAll: ('self assert: [{1} class externalType == {2}].' format: {valueName. self storeString}); crtab].
- 		s nextPutAll: ('self assert: [{1} class externalType == {2}].' format: {valueName. self storeString}); crtab.				
  		s nextPutAll:'handle := ', valueName,' getHandle']!

Item was changed:
  ----- Method: ExternalStructureType>>writeFieldAt:with: (in category 'external structure') -----
  writeFieldAt: byteOffset with: valueName
  	"Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset. 
  	 Private. Used for field definition only."
  
  	self checkType.
  
  	^String streamContents:[:s|
  		self isAtomic
  			ifTrue: [ "alias to atomic"
+ 				self class extraTypeChecks ifTrue: [
+ 					self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."].
- 				self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
  				s nextPutAll:'handle ';
  					nextPutAll: (AtomicSelectors at: self atomicType);
  					space; print: byteOffset;
  					nextPutAll:' put: ';
  					nextPutAll: valueName;
  					nextPutAll: ' getHandle']
  			ifFalse: [ "regular struct or alias to struct or alias to pointer"
+ 				self class extraTypeChecks ifTrue: ["expect either byte array or external address as handle"
+ 					s nextPutAll: ('self assert: [{1} class externalType == {2}].' format: {valueName. self storeString}); crtab].
- 				"expect either byte array or external address as handle"
- 				s nextPutAll: ('self assert: [{1} class externalType == {2}].' format: {valueName. self storeString}); crtab.
  				
  				self isTypeAliasForPointer
  					ifFalse: [
  						s nextPutAll:'handle structAt: ';
  							print: byteOffset;
  							nextPutAll:' put: ';
  							nextPutAll: valueName;
  							nextPutAll:' getHandle';
  							nextPutAll:' length: ';
  							print: self byteSize;
  							nextPutAll:'.']
  					ifTrue: [
  						s nextPutAll:'handle pointerAt: ';
  							print: byteOffset;
  							nextPutAll:' put: ';
  							nextPutAll: valueName;
  							nextPutAll:' getHandle asExternalPointer';
  							nextPutAll:' length: ';
  							print: self byteSize;
  							nextPutAll:'.']]].!

Item was changed:
  Object subclass: #ExternalType
  	instanceVariableNames: 'compiledSpec referentClass referencedType byteAlignment'
+ 	classVariableNames: 'AtomicSelectors AtomicTypeNames AtomicTypes ExtraTypeChecks StructTypes'
- 	classVariableNames: 'AtomicSelectors AtomicTypeNames AtomicTypes 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>>extraTypeChecks (in category 'preferences') -----
+ extraTypeChecks
+ 	<preference: 'Extra type checks'
+ 		categoryList: #('FFI Kernel')
+ 		description: 'When true, there will be extra type checks during dynamic or compiled access to external objects (e.g. structures, unions).'
+ 		type: #Boolean>
+ 	^ExtraTypeChecks ifNil:[false]!

Item was added:
+ ----- Method: ExternalType class>>extraTypeChecks: (in category 'preferences') -----
+ extraTypeChecks: aBoolean
+ 
+ 	ExtraTypeChecks = aBoolean ifTrue: [^ self].
+ 
+ 	ExtraTypeChecks := aBoolean.
+ 	
+ 	Cursor wait showWhile: [
+ 		"Recompile all compiled artifacts."
+ 		ExternalStructure defineAllFields].!

Item was changed:
  ----- Method: ExternalType>>checkType (in category 'external structure') -----
  checkType
  
+ 	self class extraTypeChecks ifFalse: [^ self].
+ 
  	(self isPointerType not and: [referentClass notNil])
  		ifTrue: [self error: 'Must convert to ExternalStructureType before use'].
  
  	self
  		assert: [self isStructureType not]
  		description: 'Convert to ExternalStructureType to use this feature'.!

Item was changed:
  ----- Method: ExternalType>>writeAliasWith: (in category 'external structure') -----
  writeAliasWith: valueName
  
  	self checkType.
  	
  	^ String streamContents: [:s |
  		self isPointerType
  			ifFalse: [
  				"this is an aliased atomic non-pointer type"
+ 				self class extraTypeChecks ifTrue: [
+ 					self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."].
- 				self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
  				s nextPutAll:'handle := ', valueName, '.']
  			ifTrue: [
  				"this is an aliased pointer type"
+ 				self class extraTypeChecks ifTrue: ["expect the value to be a structure/union/alias/data with an external address as handle"
+ 					s nextPutAll: ('self assert: [{1} externalType == {2}].' format: {valueName. self storeString}); crtab].				
- 				"expect the value to be a structure/union/alias/data with an external address as handle"
- 				s nextPutAll: ('self assert: [{1} externalType == {2}].' format: {valueName. self storeString}); crtab.				
  				s nextPutAll:'handle := ', valueName,' getHandle asByteArrayPointer']]!

Item was changed:
  ----- Method: ExternalType>>writeFieldAt:with: (in category 'external structure') -----
  writeFieldAt: byteOffset with: valueName
  	"Answer a string defining the accessor to an entity of the receiver type starting at the given byte offset. 
  	 Private. Used for field definition only."
  
  	self checkType.
  	
  	^ String streamContents: [:s |
  		self isPointerType
  			ifFalse: [
  				"Atomic value"
+ 				self class extraTypeChecks ifTrue: [
+ 					self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."].
- 				self flag: #addTypeCheck. "mt: Note that there is currently no mapping from objects that represent valid atomics to atomic types."
  				s nextPutAll:'handle ';
  					nextPutAll: (AtomicSelectors at: self atomicType);
  					space; print: byteOffset;
  					nextPutAll:' put: ';
  					nextPutAll: valueName]
  			ifTrue: [
  				"Pointer to structure, union, type alias, or external data."
+ 				self class extraTypeChecks ifTrue: [
+ 					s nextPutAll: ('self assert: [{1} externalType == {2}].' format: {valueName. self storeString}); crtab].				
- 				s nextPutAll: ('self assert: [{1} externalType == {2}].' format: {valueName. self storeString}); crtab.				
  				s nextPutAll:'handle pointerAt: ';
  					print: byteOffset;
  					nextPutAll:' put: ';
  					nextPutAll: valueName;
  					nextPutAll:' getHandle';
  					nextPutAll: ' length: ';
  					print: self byteSize;
  					nextPutAll: '.']]!

Item was changed:
  (PackageInfo named: 'FFI-Kernel') postscript: 'Smalltalk removeFromStartUpList: ExternalAddress.
  Smalltalk removeFromStartUpList: ExternalObject.
  
  "Split up types for external structures from atomic types."
  ExternalType resetAllStructureTypes.
  
+ "Re-generate all field accessors because type checks are now controlled by a new preference."
- "Re-generate all field accessors because there are now type checks, too."
  ExternalStructure defineAllFields.
  '!



More information about the Squeak-dev mailing list