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

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

Name: FFI-Pools-mt.28
Author: mt
Time: 26 May 2021, 6:39:30.828386 pm
UUID: 9faaf707-ff49-c547-91c4-9bdbcd3e5834
Ancestors: FFI-Pools-mt.27

Complements FFI-Kernel-mt.172

=============== Diff against FFI-Pools-mt.27 ===============

Item was added:
+ ----- Method: Parser>>apicall (in category '*FFI-Pools') -----
+ apicall
+ 	<pragmaParser>
+ 	^ self externalFunctionDeclaration!

Item was added:
+ ----- Method: Parser>>callback (in category '*FFI-Pools') -----
+ callback
+ 	<pragmaParser>
+ 	
+ 	| descriptorClass retType externalName args argType |
+ 	descriptorClass := ExternalFunction.
+ 	"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: #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:[
+ 		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 added:
+ ----- Method: Parser>>cdecl (in category '*FFI-Pools') -----
+ cdecl
+ 	<pragmaParser>
+ 	^ self externalFunctionDeclaration!

Item was added:
+ ----- Method: Parser>>externalFunctionDeclaration (in category '*FFI-Pools') -----
+ 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: #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 added:
+ ----- Method: Parser>>externalType: (in category '*FFI-Pools') -----
+ externalType: descriptorClass
+ 	"Parse and return an external type. Ignore leading comma and 'const'."
+ 
+ 	| xType typeName isArrayType tokenString |
+ 	self matchToken: ','.
+ 	self matchToken: 'const'.
+ 	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']]].
+ 	(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: [
+ 		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]
+ 			ifFalse: [xType]]!