[squeak-dev] FFI Inbox: FFI-Kernel-mt.80.mcz

commits at source.squeak.org commits at source.squeak.org
Sat May 30 16:39:09 UTC 2020


A new version of FFI-Kernel was added to project FFI Inbox:
http://source.squeak.org/FFIinbox/FFI-Kernel-mt.80.mcz

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

Name: FFI-Kernel-mt.80
Author: mt
Time: 30 May 2020, 6:39:07.324231 pm
UUID: 4750dd07-8701-3146-9348-7a9064273fcf
Ancestors: FFI-Kernel-mt.79

Assure that #pointerSize in an external type can never be nil. Make it more clear that #pointerAt:(put:) is just a shortcut to be used for pointer arithmetic (see ExternalAddress >> #+). Struct field methods must be recompiled because of the field alignment. So, emitting #pointerAt:(put:) is of no use at all. Now we emit #(short|long)PointerAt:(put:).

Note that we only support 4-byte and 8-byte pointers. Thus, fail as early as possible if -- at some day -- #wordSize would be bigger than 8. 

See discussion on vm-dev: http://forum.world.st/Re-squeak-dev-64-bit-FFI-was-porting-Croquet-to-Squeak6-0-alpha-tp5113318p5117466.html

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

Item was changed:
  ----- Method: ByteArray>>pointerAt: (in category '*FFI-Kernel') -----
  pointerAt: byteOffset
  	"Answer a pointer object stored at the given byte address"
+ 
+ 	^ ExternalAddress wordSize caseOf: {
+ 		[4] -> [self shortPointerAt: byteOffset].
+ 		[8] -> [self longPointerAt: byteOffset] }!
- 	| addr |
- 	addr := ExternalAddress new.
- 	1 to: ExternalAddress wordSize do:
- 		[:i|
- 		addr basicAt: i put: (self unsignedByteAt: byteOffset+i-1)].
- 	^addr!

Item was changed:
  ----- Method: ByteArray>>pointerAt:put: (in category '*FFI-Kernel') -----
  pointerAt: byteOffset put: value
  	"Store a pointer object at the given byte address"
+ 
+ 	^ ExternalAddress wordSize caseOf: {
+ 		[4] -> [self shortPointerAt: byteOffset put: value].
+ 		[8] -> [self longPointerAt: byteOffset put: value] }!
- 	value isExternalAddress ifFalse:
- 		[^self error:'Only external addresses can be stored'].
- 	1 to: ExternalAddress wordSize do:
- 		[:i|
- 		self unsignedByteAt: byteOffset+i-1 put: (value basicAt: i)].
- 	^value!

Item was changed:
  ----- Method: ExternalStructure class>>compileFields:withAccessors: (in category 'field definition') -----
  compileFields: specArray withAccessors: aSymbol 
  	"Compile a type specification for the FFI machinery.
  	Return the newly compiled spec.
  	Eventually generate the field accessors according to following rules:
  	- aSymbol = #always always generate the accessors
  	- aSymbol = #never never generate the accessors
  	- aSymbol = #generated only generate the auto-generated accessors
  	- aSymbol = #absent only generate the absent accessors"
  	| newByteAlignment byteOffset typeSpec newCompiledSpec |
  	(specArray size > 0 and: [specArray first class ~~ Array]) ifTrue:
  		[^ self compileAlias: specArray withAccessors: aSymbol].
  	byteOffset := 0.
  	newByteAlignment := self minStructureAlignment.
  	typeSpec := WriteStream on: (WordArray new: 10).
  	typeSpec nextPut: FFIFlagStructure.
  	"dummy for size"
  	specArray do:
  		[:spec | | fieldName fieldType isPointerField externalType typeSize fieldAlignment selfRefering |
  		fieldName := spec first.
  		fieldType := spec second.
  		isPointerField := fieldType last = $*.
  		fieldType := (fieldType findTokens: '*') first withBlanksTrimmed.
  		externalType := ExternalType atomicTypeNamed: fieldType.
  		selfRefering := isPointerField and: [externalType isNil and: [fieldType = self asString]].
  		selfRefering ifTrue: [
  			externalType := ExternalType void asPointerType
  		] ifFalse:[
+ 			externalType ifNil: ["non-atomic"
+ 				(Symbol lookup: fieldType) ifNotNil: [:sym |
+ 					externalType := ExternalType structTypeNamed: sym].
- 			externalType == nil ifTrue: ["non-atomic"
- 				Symbol
- 					hasInterned: fieldType
- 					ifTrue: [:sym | externalType := ExternalType structTypeNamed: sym].
  			].
+ 			externalType ifNil: [
- 			externalType == nil ifTrue:[
  				Transcript show: '(' , fieldType , ' is void)'.
  				externalType := ExternalType void.
  			].
+ 			isPointerField ifTrue: [externalType := externalType asPointerType]].
- 			isPointerField ifTrue: [externalType := externalType asPointerType: self pointerSize]].
  			typeSize := externalType byteSize.
  			fieldAlignment := (externalType byteAlignment max: self minFieldAlignment)
  				min: self maxFieldAlignment.
  			byteOffset := byteOffset alignedTo: fieldAlignment.
  			newByteAlignment := newByteAlignment max: fieldAlignment.
  			spec size > 2 ifTrue: ["extra size"
  				spec third < typeSize
  					ifTrue: [^ self error: 'Explicit type size is less than expected'].
  				typeSize := spec third.
  			].
  			(fieldName notNil and: [self shouldGenerate: fieldName policy: aSymbol]) ifTrue: [
  				self defineFieldAccessorsFor: fieldName startingAt: byteOffset + 1 type: externalType.
  			].
  			typeSpec nextPutAll: (externalType embeddedSpecWithSize: typeSize).
  			byteOffset := byteOffset + typeSize.
  		].
  	
  	newByteAlignment := newByteAlignment min: self maxStructureAlignment.
  	byteOffset := byteOffset alignedTo: newByteAlignment.
  	newCompiledSpec := typeSpec contents.
  	newCompiledSpec at: 1 put: (byteOffset bitOr: FFIFlagStructure).
  	byteAlignment := newByteAlignment.
  	^ newCompiledSpec!

Item was removed:
- ----- Method: ExternalStructure class>>pointerSize (in category 'accessing') -----
- pointerSize
- 	"Answer the size of pointers for this class.  By default answer nil.
- 	 Subclasses that contain pointers must define the size of a pointer if the code is to operate on 64-bit and 32-bit platforms.
- 	 Currently we have no way of converting a type between 32- and 64- bit versions beyond recompiling it."
- 	^nil!

Item was changed:
  Object subclass: #ExternalType
+ 	instanceVariableNames: 'compiledSpec referentClass referencedType byteAlignment'
- 	instanceVariableNames: 'compiledSpec referentClass referencedType pointerSize byteAlignment'
  	classVariableNames: 'AtomicSelectors AtomicTypeNames AtomicTypes StructTypes'
  	poolDictionaries: 'FFIConstants'
  	category: 'FFI-Kernel'!
  
  !ExternalType commentStamp: 'eem 6/25/2019 10:39' 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
  	pointerSize		<Integer | nil>		The size of a pointer if the external type is a pointer or is a structure containing a pointer.
  	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 removed:
- ----- Method: ExternalType>>asPointerType: (in category 'converting') -----
- asPointerType: anotherPointerSize
- 	"convert the receiver into a pointer type"
- 	| type |
- 	type := self asPointerType.
- 	^type pointerSize = anotherPointerSize
- 		ifTrue: [type]
- 		ifFalse:
- 			[type copy pointerSize: anotherPointerSize; yourself]!

Item was changed:
  ----- Method: ExternalType>>pointerSize (in category 'accessing') -----
  pointerSize
+ 
+ 	^ self asPointerType headerWord bitAnd: FFIStructSizeMask!
- 	"Answer the pointer size of the receiver, if specified."
- 	^pointerSize!

Item was changed:
  ----- Method: ExternalType>>readFieldAt: (in category 'private') -----
  readFieldAt: byteOffset
  	"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 isPointerType ifTrue:
  		[| accessor |
  		accessor := self pointerSize caseOf: {
- 						[nil]	->	[#pointerAt:].
  						[4]	->	[#shortPointerAt:].
  						[8]	->	[#longPointerAt:] }.
  		 ^String streamContents:
  			[:s|
  			 referentClass
  				ifNil:
  					[s nextPutAll: '^ExternalData fromHandle: (handle ', accessor, ' ';
  						print: byteOffset;
  						nextPutAll: ') type: ExternalType ';
  						nextPutAll: (AtomicTypeNames at: self atomicType);
  						nextPutAll: ' asPointerType']
  				ifNotNil:
  					[s nextPutAll: '^';
  						print: referentClass;
  						nextPutAll: ' fromHandle: (handle ', accessor, ' ';
  						print: byteOffset;
  						nextPut: $)]]].
  
  	self isAtomic ifFalse: "structure type"
  		[^String streamContents:[:s|
  			s nextPutAll:'^';
  				print: referentClass;
  				nextPutAll:' fromHandle: (handle structAt: ';
  				print: byteOffset;
  				nextPutAll:' length: ';
  				print: self byteSize;
  				nextPutAll:')']].
  
  	"Atomic non-pointer types"
  	^String streamContents:
  		[:s|
  		s nextPutAll:'^handle ';
  			nextPutAll: (AtomicSelectors at: self atomicType);
  			space; print: byteOffset].!

Item was changed:
  ----- Method: ExternalType>>writeFieldAt:with: (in category 'private') -----
  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 isPointerType ifTrue:
  		[| accessor |
  		accessor := self pointerSize caseOf: {
- 						[nil]	->	[#pointerAt:].
  						[4]	->	[#shortPointerAt:].
  						[8]	->	[#longPointerAt:] }.
  		^String streamContents:
  			[:s|
  			s nextPutAll:'handle ', accessor, ' ';
  				print: byteOffset;
  				nextPutAll:' put: ';
  				nextPutAll: valueName;
  				nextPutAll:' getHandle.']].
  
  	self isAtomic ifFalse:[
  		^String streamContents:[:s|
  			s nextPutAll:'handle structAt: ';
  				print: byteOffset;
  				nextPutAll:' put: ';
  				nextPutAll: valueName;
  				nextPutAll:' getHandle';
  				nextPutAll:' length: ';
  				print: self byteSize;
  				nextPutAll:'.']].
  
  	^String streamContents:[:s|
  		s nextPutAll:'handle ';
  			nextPutAll: (AtomicSelectors at: self atomicType);
  			space; print: byteOffset;
  			nextPutAll:' put: ';
  			nextPutAll: valueName].!

Item was changed:
  ----- Method: ExternalUnion class>>compileFields:withAccessors: (in category 'field definition') -----
  compileFields: specArray withAccessors: aSymbol 
  	"Compile a type specification for the FFI machinery.
  	Return the newly compiled spec.
  	Eventually generate the field accessors according to the policy defined in aSymbol."
  	| byteOffset maxByteSize typeSpec newCompiledSpec newByteAlignment |
  	(specArray size > 0 and: [specArray first class ~~ Array]) ifTrue:
  		[^ self error: 'unions must have fields defined by sub-Array'].
  	byteOffset := 1.
  	newByteAlignment := 1.
  	maxByteSize := 0.
  	typeSpec := WriteStream on: (WordArray new: specArray size + 1).
  	typeSpec nextPut: FFIFlagStructure.
  	"dummy for size"
  	specArray do:
  		[:spec |
  		| fieldName fieldType isPointerField externalType typeSize typeAlignment selfRefering |
  		fieldName := spec first.
  		fieldType := spec second.
  		isPointerField := fieldType last = $*.
  		fieldType := (fieldType findTokens: '*') first withBlanksTrimmed.
  		externalType := ExternalType atomicTypeNamed: fieldType.
  		selfRefering := isPointerField and: [externalType isNil and: [fieldType = self asString]].
  		selfRefering ifTrue: [
  			externalType := ExternalType void asPointerType
  		] ifFalse:[
+ 			externalType ifNil: ["non-atomic"
+ 				(Symbol lookup: fieldType) ifNotNil: [:sym |
+ 					externalType := ExternalType structTypeNamed: sym].
- 			externalType == nil ifTrue: ["non-atomic"
- 				Symbol
- 					hasInterned: fieldType
- 					ifTrue: [:sym | externalType := ExternalType structTypeNamed: sym].
  			].
+ 			externalType ifNil: [
- 			externalType == nil ifTrue:[
  				Transcript show: '(' , fieldType , ' is void)'.
  				externalType := ExternalType void.
  			].
+ 			isPointerField ifTrue: [externalType := externalType asPointerType]].
- 			isPointerField ifTrue: [externalType := externalType asPointerType: self pointerSize]].
  			typeSize := externalType byteSize.
  			typeAlignment := externalType byteAlignment.
  			spec size > 2 ifTrue: ["extra size"
  				spec third < typeSize
  					ifTrue: [^ self error: 'Explicit type size is less than expected'].
  				typeSize := spec third.
  			].
  			(fieldName notNil and: [self shouldGenerate: fieldName policy: aSymbol]) ifTrue: [
  				self defineFieldAccessorsFor: fieldName startingAt: byteOffset type: externalType.
  			].
  			typeSpec nextPutAll: (externalType embeddedSpecWithSize: typeSize).
  			maxByteSize := maxByteSize max: typeSize.
  			newByteAlignment := newByteAlignment max: typeAlignment
  		].
  	maxByteSize := maxByteSize alignedTo: newByteAlignment.
  	newCompiledSpec := typeSpec contents.
  	newCompiledSpec at: 1 put: (maxByteSize bitOr: FFIFlagStructure).
  	byteAlignment := newByteAlignment.
  	^ newCompiledSpec!

Item was changed:
  (PackageInfo named: 'FFI-Kernel') postscript: 'Smalltalk removeFromStartUpList: ExternalAddress.
+ Smalltalk removeFromStartUpList: ExternalObject.
+ 
+ "Since #pointerSize in ExternalType is never nil anymore, make the code generated for fields more specific, i.e., #shortPointerAt:(put:) or #longPointerAt:(put:).
+ ExternalStructure withAllSubclassesDo: [:cls | cls defineFields].
+ '!
- Smalltalk removeFromStartUpList: ExternalObject.'!



More information about the Squeak-dev mailing list