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

commits at source.squeak.org commits at source.squeak.org
Wed May 26 13:28:49 UTC 2021


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

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

Name: FFI-Kernel-mt.170
Author: mt
Time: 26 May 2021, 3:28:49.060346 pm
UUID: 9cc52c33-866f-d44a-972c-af0d84acfcc3
Ancestors: FFI-Kernel-mt.169

More flexible parsing of external types in signatures. Skip commas and 'const' when parsing external types. Allow name-by-token in signatures to avoid those extra string quotation characters.

Fixes bug that occurred during parsing array types with unknown size, i.e. char[].

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

Item was changed:
  ----- Method: Parser>>callback (in category '*FFI-Kernel') -----
  callback
  	<pragmaParser>
  	
  	| descriptorClass retType externalName args argType |
  	descriptorClass := ExternalFunction.
  	"Parse return type"
  	self advance.
- 	here = 'const' ifTrue: [self advance].
  	retType := self externalType: descriptorClass.
  	retType == nil ifTrue:[^self expected:'return type'].
  	"Parse function name or index"
  	externalName := here.
  
  	(self match: #leftParenthesis) ifFalse:[^self expected:'function pointer (*)'].
  	(self matchToken: #*) ifFalse:[^self expected:'function pointer (*)'].
  	(self match: #rightParenthesis) ifFalse:[^self expected:'function pointer (*)'].
  
  	(self match: #leftParenthesis) ifFalse:[^self expected:'argument list'].
  	args := WriteStream on: Array new.
  	[self match: #rightParenthesis] whileFalse:[
- 		here = 'const' ifTrue: [self advance].
- 		here = ',' ifTrue: [self advance].
  		argType := self externalType: descriptorClass.
  		argType == nil ifTrue:[^self expected:'argument'].
  		argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType]].
  
  	self addPragma: (Pragma keyword: #callback: arguments: {{retType}, args contents}).
  	^true!

Item was changed:
  ----- Method: Parser>>externalFunctionDeclaration (in category '*FFI-Kernel') -----
  externalFunctionDeclaration
  	"Parse the function declaration for a call to an external library.
  	
  	(1) Create an instance of ExternalLibraryFunction and install it as first literal.
  	(2) Add a pragma to primitive call 120.
  	"
  	| descriptorClass callType modifier retType externalName args argType module fn |
  	descriptorClass := cue environment
  		valueOf: #ExternalFunction 
  		ifAbsent: [^ false].
  	callType := descriptorClass callingConventionFor: here.
  	callType == nil ifTrue:[^false].
  	[modifier := descriptorClass callingConventionModifierFor: token.
  	 modifier notNil] whileTrue:
  		[self advance.
  		 callType := callType bitOr: modifier].
  	"Parse return type"
  	self advance.
  	retType := self externalType: descriptorClass.
  	retType == nil ifTrue:[^self expected:'return type'].
  	"Parse function name or index"
  	externalName := here.
+ 	(self match: #number)
+ 		ifFalse: [ "Consume all tokens as function name"
+ 			self advance.
+ 			externalName := externalName asSymbol].
- 	(self match: #string) 
- 		ifTrue:[externalName := externalName asSymbol]
- 		ifFalse:[(self match:#number) ifFalse:[^self expected:'function name or index']].
  	(self match: #leftParenthesis) ifFalse:[^self expected:'argument list'].
  	args := WriteStream on: Array new.
  	[self match: #rightParenthesis] whileFalse:[
  		argType := self externalType: descriptorClass.
  		argType == nil ifTrue:[^self expected:'argument'].
  		argType isVoid & argType isPointerType not ifFalse:[args nextPut: argType]].
  	(self matchToken: 'module:') ifTrue:[
  		module := here.
  		(self match: #string) ifFalse:[^self expected: 'String'].
  		module := module asSymbol].
  	
  	Smalltalk at: #ExternalLibraryFunction ifPresent:[:xfn|
  		fn := xfn name: externalName 
  				module: module 
  				callType: callType
  				returnType: retType
  				argumentTypes: args contents.
  		self allocateLiteral: fn.
  		fn beWritableObject. "Undo the read-only setting in litIndex:"].
  	(self matchToken: 'error:')
  		ifTrue:
  			[| errorCodeVariable |
  			 errorCodeVariable := here.
  			(hereType == #string
  			 or: [hereType == #word]) ifFalse:[^self expected: 'error code (a variable or string)'].
  			 self advance.
  			 self addPragma: (Pragma keyword: #primitive:error: arguments: (Array with: 120 with: errorCodeVariable)).
  			 fn ifNotNil: [fn setErrorCodeName: errorCodeVariable]]
  		ifFalse:
  			[self addPragma: (Pragma keyword: #primitive: arguments: #(120))].
  	^true!

Item was changed:
  ----- Method: Parser>>externalType: (in category '*FFI-Kernel') -----
  externalType: descriptorClass
+ 	"Parse and return an external type. Ignore leading comma and 'const'."
+ 
+ 	| xType typeName isArrayType tokenString |
+ 	self matchToken: ','.
+ 	self matchToken: 'const'.
- 	"Parse and return an external type"
- 	| xType typeName isArrayType |
  	typeName := here. "Note that pointer token is not yet parsed!!"
  	self advance.
  	(isArrayType := self matchToken: $[)
  		ifTrue: [
+ 			(self matchToken: $])
+ 				ifTrue: [typeName := typeName, '[]']
+ 				ifFalse: [
+ 					typeName := typeName, '[', here, ']'.
+ 					self advance.
+ 					(self matchToken: $]) ifFalse: [^ self expected: 'closing bracket']]].
- 			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].
+ 	self flag: #todo. "mt: Extra commas are currently merged with pointer indicator as a single token."
+ 	tokenString := here asString.
+ 	^ (tokenString first == $*)
+ 		ifTrue: [self advance. xType asPointerType]
+ 		ifFalse:[(tokenString beginsWith: '**')
+ 			ifTrue: [self advance. xType asPointerToPointerType]
- 	^ (self matchToken: #*)
- 		ifTrue:[xType asPointerType]
- 		ifFalse:[(self matchToken: #**)
- 			ifTrue: [xType asPointerToPointerType]
  			ifFalse: [xType]]!



More information about the Squeak-dev mailing list