[squeak-dev] FFI: FFI-Kernel.terf-eem.187.mcz

commits at source.squeak.org commits at source.squeak.org
Mon Aug 2 18:15:32 UTC 2021


Eliot Miranda uploaded a new version of FFI-Kernel to project FFI:
http://source.squeak.org/FFI/FFI-Kernel.terf-eem.187.mcz

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

Name: FFI-Kernel.terf-eem.187
Author: eem
Time: 2 August 2021, 11:15:30.36735 am
UUID: 54737d19-448d-4377-859b-be958a51dec6
Ancestors: FFI-Kernel-eem.186

Performance:
- cache an ExternalStructure class's externalType in a class inst var.
- directly allocate an ExternalStructure[Type] using self byteSize rather than deferring to the externalType.

Minor: avoid variable shadowing warnings in compileStructureSpec:withAccessors:, compileTypeAliasSpec:withAccessors:, & maybeCompileAccessor:withSelector:.

=============== Diff against FFI-Kernel-eem.186 ===============

Item was changed:
  ----- Method: ExternalArrayType>>contentType (in category 'external data') -----
  contentType "^ <ExternalType>"
+ 	"We are an array of things. Our content type is encoded in the compiledSpec's headerWord. The super implementation of #typeName can figure that out."
  	
+ 	self flag: #contentVsContainer. "mt: For n-dimensional containers, we might have to adapt this."
+ 	^ contentType ifNil: [contentType := ExternalType typeNamed: super typeName ]!
- 	^ contentType!

Item was changed:
  ExternalObject subclass: #ExternalStructure
  	instanceVariableNames: ''
  	classVariableNames: ''
  	poolDictionaries: 'ExternalTypePool FFIConstants'
  	category: 'FFI-Kernel'!
  ExternalStructure class
+ 	instanceVariableNames: 'compiledSpec byteAlignment externalType'!
- 	instanceVariableNames: 'compiledSpec byteAlignment'!
  
  !ExternalStructure commentStamp: 'eem 6/26/2019 15:26' prior: 0!
  An ExternalStructure is for representing external data that is
  - either a structure composed of different fields (a struct of C language)
  - or an alias for another type (like a typedef of C language)
  
  It reserves enough bytes of data for representing all the fields.
  
  The data is stored into the handle instance variable which can be of two different types:
  	- ExternalAddress
  		If the handle is an external address then the object described does not reside in the Smalltalk object memory.
  	- ByteArray
  		If the handle is a byte array then the object described resides in Smalltalk memory.
  
  
  Instance Variables (class side)
  	byteAlignment:		<Integer>
  	compiledSpec:		<WordArray>
  
  byteAlignment
  	- the required alignment for the structure
  
  compiledSpec
  	- the bit-field definiton of the structure in the ExternalType encoding understood by the VM's FFI call marshalling machinery.
  
  
  A specific structure is defined by subclassing ExternalStructure and specifying its #fields via a class side method.
  For example if we define a subclass:
  	ExternalStructure subclass: #StructExample
  		instanceVariableNames: ''
  		classVariableNames: ''
  		poolDictionaries: ''
  		category: 'garbage'.
  Then declare the fields like this:
      StructExample class compile: 'fields  ^#( (name ''char*'') (color ''ulong'') )' classified: 'garbage'.
  
  It means that this type is composed of two different fields:
  - a string (accessed thru the field #name)
  - and an unsigned 32bit integer (accessed thru the field #color).
  It represents the following C type:
     struct StructExample {char *name; uint32_t color; };
  
  The accessors for those fields can be generated automatically like this:
  	StructExample defineFields.
  As can be verified in a Browser:
  	StructExample browse.
  We see that name and color fields are stored sequentially in different zones of data.
  
  The total size of the structure can be verified with:
  	StructExample byteSize = (Smalltalk wordSize + 4).
  
  An ExternalStructure can also be used for defining an alias.
  The fields definition must contain only 2 elements: an eventual accessor (or nil) and the type.
  For example, We can define a machine dependent 'unsigned long' like this:
  	ExternalStructure subclass: #UnsignedLong
  		instanceVariableNames: ''
  		classVariableNames: ''
  		poolDictionaries: ''
  		category: 'garbage'.
  Then set the fields like this:
      UnsignedLong class compile: 'fields  ^(Smalltalk wordSize=4 or: [Smalltalk platformName=''Win64''])
  		ifTrue: [#(nil ''ulong'')] ifFalse: [#(nil ''ulonglong'')]' classified: 'garbage'.
  And verify the size on current platform:
  	UnsignedLong byteSize.
  	
  Then, the class names 'UnsignedLong' and 'StructExamples' acts as a type specification.
  They can be used for composing other types, and for defining prototype of external functions:
  
  LibraryExample>>initMyStruct: aStructExample name: name color: anInteger
  	<cdecl: void 'init_my_struct'( StructExample * char * UnsignedLong )>
  	self externalCallFailed
  
  
  !
  ExternalStructure class
+ 	instanceVariableNames: 'compiledSpec byteAlignment externalType'!
- 	instanceVariableNames: 'compiledSpec byteAlignment'!

Item was changed:
  ----- Method: ExternalStructure class>>allocate (in category 'instance creation') -----
  allocate
+ 	^ self fromHandle: (ByteArray new: self byteSize)!
- 
- 	^self externalType allocate!

Item was changed:
  ----- Method: ExternalStructure class>>compileStructureSpec:withAccessors: (in category 'field definition - support') -----
  compileStructureSpec: specArray withAccessors: aSymbol 
  	"Compile a type specification for the FFI calls.
  	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 |
  	byteOffset := 0.
  	newByteAlignment := self minStructureAlignment.
  	typeSpec := WriteStream on: (WordArray new: 10).
  	typeSpec nextPut: FFIFlagStructure.
+ 	specArray do:
+ 		[:spec | | fieldName fieldTypeName fieldType typeSize fieldAlignment |
- 	specArray do: [:spec |
- 		| fieldName fieldTypeName externalType typeSize fieldAlignment |
  		fieldName := spec first.
  		fieldTypeName := spec second.
+ 		fieldType := (ExternalType typeNamed: fieldTypeName) ifNil: [self errorTypeNotFound: spec second].
+ 		typeSize := fieldType byteSize.
+ 		fieldAlignment := (fieldType byteAlignment max: self minFieldAlignment) min: self maxFieldAlignment.
- 		externalType := (ExternalType typeNamed: fieldTypeName)
- 			ifNil: [self errorTypeNotFound: spec second].
- 		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
- 		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 generateStructureFieldAccessorsFor: fieldName startingAt: byteOffset + 1 type: fieldType].
+ 		typeSpec nextPutAll: (fieldType embeddedSpecWithSize: typeSize).
+ 		byteOffset := byteOffset + typeSize].
- 			typeSize := spec third.
- 		].
- 		(fieldName notNil and: [self shouldGenerate: fieldName policy: aSymbol]) ifTrue: [
- 			self generateStructureFieldAccessorsFor: 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).
  	self
  		setCompiledSpec: newCompiledSpec
+ 		byteAlignment: newByteAlignment!
- 		byteAlignment: newByteAlignment.!

Item was changed:
  ----- Method: ExternalStructure class>>compileTypeAliasSpec:withAccessors: (in category 'field definition - support') -----
  compileTypeAliasSpec: spec withAccessors: aSymbol
  	"Define all the fields in the receiver.
  	Return the newly compiled spec."
+ 	| fieldName fieldTypeName fieldType |
- 	| fieldName fieldTypeName externalType |
  	fieldName := spec first.
  	fieldTypeName := spec second.
+ 	fieldType := (ExternalType typeNamed: fieldTypeName) ifNil: [self errorTypeNotFound: spec second].
+ 	(fieldName notNil and: [self shouldGenerate: fieldName policy: aSymbol]) ifTrue:
+ 		[self generateTypeAliasAccessorsFor: fieldName type: fieldType].
+ 	fieldType isPointerType
+ 		ifTrue: "Special case. Typedef for a pointer type, e.g., typedef char* LPSTR in Win32 API. Mark it as both structure and pointer. Note that #isPointerType will only answer true for the in-image pointer type, not the non-pointer alias for the pointer."
+ 			[self
- 	externalType := (ExternalType typeNamed: fieldTypeName)
- 		ifNil: [self errorTypeNotFound: spec second].
- 	(fieldName notNil and:[self shouldGenerate: fieldName policy: aSymbol]) ifTrue:[
- 		self generateTypeAliasAccessorsFor: fieldName type: externalType].
- 	externalType isPointerType
- 		ifTrue: ["Special case. Typedef for a pointer type, e.g., typedef char* LPSTR in Win32 API. Mark it as both structure and pointer. Note that #isPointerType will only answer true for the in-image pointer type, not the non-pointer alias for the pointer."
- 			self
  				setCompiledSpec: (WordArray with: ExternalType pointerAliasSpec)
  				byteAlignment: ExternalType pointerAliasAlignment]
+ 		ifFalse: "Usual case. Typedef for another struct type or atomic type. Just re-use compiled spec and extras from the aliased type."
+ 			[self
- 		ifFalse: ["Usual case. Typedef for another struct type or atomic type. Just re-use compiled spec and extras from the aliased type."
- 			self
  				flag: #isTypeAlias;
+ 				setCompiledSpec: fieldType compiledSpec
+ 				byteAlignment: fieldType byteAlignment]!
- 				setCompiledSpec: externalType compiledSpec
- 				byteAlignment: externalType byteAlignment].!

Item was changed:
  ----- Method: ExternalStructure class>>externalType (in category 'external type') -----
  externalType
  	"Return an external type describing the receiver as a structure"
+ 	^externalType ifNil: [externalType := ExternalType structTypeNamed: self name]!
- 	^ExternalType structTypeNamed: self name!

Item was changed:
  ----- Method: ExternalStructure class>>maybeCompileAccessor:withSelector: (in category 'field definition - support') -----
  maybeCompileAccessor: aString withSelector: selector
  	"Only compile if category or source changed."
  	
+ 	| theCategory ref |
+ 	theCategory := #'*autogenerated - accessing'.
- 	| category ref |
- 	category := #'*autogenerated - accessing'.
  	((ref := MethodReference class: self selector: selector) isValid
+ 	 and: [ref sourceString = aString]) ifTrue:
+ 		[ref category ~= theCategory ifTrue:
+ 			[self organization classify: selector under: theCategory].
+ 		 ^self].
+ 	self compile: aString classified: theCategory!
- 		and: [ref category = category]
- 		and: [ref sourceString = aString])
- 			ifTrue: [^ self].
- 	self compile: aString classified: category.!

Item was added:
+ ----- Method: ExternalStructureType>>allocate (in category 'external data') -----
+ allocate
+ 	^ referentClass fromHandle: (ByteArray new: self byteSize)!



More information about the Squeak-dev mailing list