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

commits at source.squeak.org commits at source.squeak.org
Tue May 4 14:51:44 UTC 2021


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

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

Name: FFI-Kernel-mt.130
Author: mt
Time: 4 May 2021, 4:51:43.338881 pm
UUID: 5c667740-5577-4541-876e-0be05657a18c
Ancestors: FFI-Kernel-mt.129

Adds (simple?) support for array types such as char[12] or MyStruct[5].

Note that there is no plugin support for array types, which means that:
1. All FFI calls denoting array types will be passed as pointer type
2. Return types might work with atomic arrays (e.g. char[12]) but definitely not with struct arrays because the plugin will just give you a new instance of your struct with the handle, thus omitting the size information.

Still, now you can finally embed array types in your struct definition:

typedef struct {
   double d1;
   int32_t[5] a5i2;
} FFITestSdA5i

:-)

More open tasks:
- Array types are not cached and created on-demand. See #arrayTypeNamed: for placing a cache.
- #typedef (in Tools) is not yet supported.

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

Item was added:
+ ExternalType subclass: #ExternalArrayType
+ 	instanceVariableNames: ''
+ 	classVariableNames: ''
+ 	poolDictionaries: ''
+ 	category: 'FFI-Kernel'!

Item was added:
+ ----- Method: ExternalArrayType class>>newTypeForContentType:size: (in category 'as yet unclassified') -----
+ newTypeForContentType: contentType size: numElements
+ 	"!!!!!! Be aware that only the pointer type can be used in calls. As of SqueakFFIPrims VMMaker.oscog-eem.2950, there is no actual support for array types in the FFI plugin !!!!!!"
+ 
+ 	| type pointerType headerWord byteSize |
+ 	contentType ifNil: [^ nil].
+ 	numElements < 0 ifTrue: [^ nil].
+ 	
+ 	self
+ 		assert: [contentType isPointerType not]
+ 		description: 'No support for pointers as content type yet!!'.
+ 
+ 	type := self basicNew.
+ 	pointerType := ExternalType basicNew.
+ 	
+ 	"1) Regular type"
+ 	byteSize := numElements * contentType byteSize.
+ 	self assert: [byteSize <= FFIStructSizeMask].
+ 	headerWord := contentType headerWord copy.
+ 	headerWord := headerWord bitClear: FFIStructSizeMask.
+ 	headerWord := headerWord bitOr: byteSize.
+ 	type
+ 		setReferencedType: pointerType;
+ 		compiledSpec: (WordArray with: headerWord);
+ 		byteAlignment: contentType byteAlignment;
+ 		setReferentClass: contentType referentClass.	
+ 
+ 	"2) Pointer type. Reuse the compiledSpec of the content-type's pointer type."
+ 	pointerType
+ 		setReferencedType: type;
+ 		compiledSpec: contentType asPointerType compiledSpec copy;
+ 		byteAlignment: contentType asPointerType byteAlignment;
+ 		setReferentClass: contentType asPointerType referentClass.
+ 		
+ 	^ type!

Item was added:
+ ----- Method: ExternalArrayType>>checkType (in category 'external structure') -----
+ checkType
+ 
+ 	self class extraTypeChecks ifFalse: [^ self].
+ 	
+ 	self
+ 		assert: [self isPointerType not]
+ 		description: 'Convert to ExternalType to use this feature'.!

Item was added:
+ ----- Method: ExternalArrayType>>contentType (in category 'accessing') -----
+ contentType
+ 
+ 	^ ExternalType typeNamed: super typeName!

Item was added:
+ ----- Method: ExternalArrayType>>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:."
+ 
+ 	self checkType.
+ 
+ 	^ (ExternalData
+ 		fromHandle: (handle structAt: byteOffset length: self byteSize)
+ 		type: self contentType) size: self size; yourself!

Item was added:
+ ----- Method: ExternalArrayType>>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.
+ 
+ 	handle
+ 		structAt: byteOffset
+ 		put: value getHandle
+ 		length: self byteSize.!

Item was added:
+ ----- Method: ExternalArrayType>>isArrayType (in category 'testing') -----
+ isArrayType
+ 
+ 	^ true!

Item was added:
+ ----- Method: ExternalArrayType>>readFieldAt: (in category 'external structure') -----
+ 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 checkType.
+ 
+ 	^ String streamContents:[:s |
+ 		s nextPutAll:'^ (ExternalData fromHandle: (handle structAt: ';
+ 			print: byteOffset;
+ 			nextPutAll: ' length: ';
+ 			print: self byteSize;
+ 			nextPutAll: ') type: '.
+ 			
+ 		self contentType isAtomic
+ 			ifTrue: [s nextPutAll: 'ExternalType ', self contentType typeName]
+ 			ifFalse: [s nextPutAll: self contentType typeName, ' externalType'].
+ 			
+ 		s nextPutAll: ') size: '; print: self size; nextPutAll: '; yourself']!

Item was added:
+ ----- Method: ExternalArrayType>>size (in category 'accessing') -----
+ size
+ 	"Answers the number of elements for this array type."
+ 	
+ 	^ self byteSize / self contentType byteSize!

Item was added:
+ ----- Method: ExternalArrayType>>storeOn: (in category 'printing') -----
+ storeOn: aStream
+ 	
+ 	aStream
+ 		nextPut: $(;
+ 		nextPutAll: ExternalType name; space;
+ 		nextPutAll: #arrayTypeNamed:; space;
+ 		store: self typeName;
+ 		nextPut: $).!

Item was added:
+ ----- Method: ExternalArrayType>>typeName (in category 'accessing') -----
+ typeName
+ 
+ 	^ String streamContents: [:stream |
+ 		stream
+ 			nextPutAll: super typeName;
+ 			nextPut: $[;
+ 			nextPutAll: self size asString;
+ 			nextPut: $]]!

Item was added:
+ ----- Method: ExternalArrayType>>writeFieldArgName (in category 'external structure') -----
+ writeFieldArgName
+ 
+ 	^ 'anExternalData_', self contentType typeName, self size!

Item was added:
+ ----- Method: ExternalArrayType>>writeFieldAt:with: (in category 'external structure') -----
+ writeFieldAt: byteOffset with: valueName
+ 	
+ 	self checkType.
+ 
+ 	^ String streamContents:[:s |
+ 		s nextPutAll:'handle structAt: ';
+ 			print: byteOffset;
+ 			nextPutAll: ' put: ';
+ 			nextPutAll: valueName;
+ 			nextPutAll: ' getHandle length: ';
+ 			print: self byteSize]!

Item was added:
+ ----- Method: ExternalType class>>arrayTypeNamed: (in category 'instance lookup') -----
+ arrayTypeNamed: typeName
+ 	"Lookup fails if content type is not present."
+ 	
+ 	| contentType |
+ 	self flag: #todo. "mt: Cache array types?"
+ 	
+ 	(contentType := self typeNamed: (typeName copyFrom: 1 to: (typeName indexOf: $[) - 1))
+ 		ifNil: [^ nil].
+ 	
+ 	^ self newTypeNamed: typeName!

Item was added:
+ ----- Method: ExternalType class>>newTypeForContentType:size: (in category 'instance creation') -----
+ newTypeForContentType: contentType size: numElements
+ 
+ 	^ ExternalArrayType newTypeForContentType: contentType size: numElements!

Item was changed:
  ----- Method: ExternalType class>>newTypeNamed: (in category 'instance creation') -----
  newTypeNamed: aTypeName
+ 	"Create a new struct type or array type. Not needed for atomic types; see #initializeDefaultTypes."
+ 	
+ 	| structClass contentType contentTypeName numElements |
- 
- 	| structClass |
  	self
  		assert: [aTypeName last ~~ $*]
  		description: 'Pointer type will be created automatically'.
+ 			
+ 	aTypeName last == $] ifTrue: [
+ 		"array type, e.g., char[50]"
+ 		contentTypeName:= aTypeName copyFrom: 1 to: (aTypeName indexOf: $[) - 1.
+ 		contentType := (self typeNamed: contentTypeName) "Create new if not already there."
+ 			ifNil: [self newTypeNamed: contentTypeName].	
+ 		numElements := ((aTypeName copyFrom: (aTypeName indexOf: $[) + 1 to: aTypeName size - 1) asInteger)
+ 			ifNil: [0].
+ 		^ self
+ 			newTypeForContentType: contentType
+ 			size: numElements].
  	
  	structClass := (self environment classNamed: aTypeName)
  		ifNotNil: [:class | (class includesBehavior: ExternalStructure) ifTrue: [class]].
  
  	^ structClass
  		ifNil: [self newTypeForUnknownNamed: aTypeName]
  		ifNotNil: [self newTypeForStructureClass: structClass]!

Item was changed:
  ----- Method: ExternalType class>>typeNamed: (in category 'instance lookup') -----
  typeNamed: typeName
  	"Supports pointer-type lookup for both atomic and structure types.
  	Examples: 'long', 'long*', 'long *' or 'MyStruct', 'MyStruct*', 'MyStruct *'"
  	
+ 	| isPointerType isArrayType actualTypeName type |
+ 	isArrayType := false.
- 	| isPointerType actualTypeName type |
  	(isPointerType := typeName last == $*)
  		ifTrue: [actualTypeName := typeName allButLast withoutTrailingBlanks]
+ 		ifFalse: [(isArrayType := typeName last == $])
+ 			ifFalse: [actualTypeName := typeName]].
- 		ifFalse: [actualTypeName := typeName].
  
+ 	isArrayType
+ 		ifTrue: [^ self arrayTypeNamed: typeName].
+ 
  	(Symbol lookup: actualTypeName)
  		ifNotNil: [:sym | actualTypeName := sym].
  
  	type := (self atomicTypeNamed: actualTypeName)
  		ifNil: [self structTypeNamed: actualTypeName].
  
  	^ type ifNotNil: [isPointerType ifTrue: [type asPointerType] ifFalse: [type]]!

Item was added:
+ ----- Method: ExternalType>>isArrayType (in category 'testing') -----
+ isArrayType
+ 
+ 	^ false!

Item was changed:
  ----- Method: Parser>>externalType: (in category '*FFI-Kernel') -----
  externalType: descriptorClass
  	"Parse and return an external type"
+ 	| xType typeName isArrayType |
- 	| xType typeName |
  	typeName := here. "Note that pointer token is not yet parsed!!"
+ 	self advance.
+ 	(isArrayType := self matchToken: $[)
+ 		ifTrue: [
+ 			typeName := typeName, '[', here, ']'.
+ 			self advance.
+ 			self matchToken: $]].
  	(xType := descriptorClass typeNamed: typeName)
  		ifNil: [
  			"Raise an error if user is there"
  			self interactive ifTrue: [^nil].
  			"otherwise go over it silently -- use an unknown struct type"
+ 			xType := descriptorClass newTypeNamed: typeName].
+ 	isArrayType ifTrue: [
+ 		self flag: #todo. "mt: We must send arrays as pointers."
+ 		xType := xType asPointerType].
- 			xType := descriptorClass newTypeNamed: here].
- 	self advance.
  	^ (self matchToken: #*)
  		ifTrue:[xType asPointerType]
  		ifFalse:[(self matchToken: #**)
  			ifTrue: [xType asPointerToPointerType]
  			ifFalse: [xType]]!



More information about the Squeak-dev mailing list