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

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

Name: FFI-Pools-mt.30
Author: mt
Time: 27 May 2021, 9:31:42.419843 am
UUID: 4ea34330-670f-f844-833b-349561dc6e3a
Ancestors: FFI-Pools-mt.29

Complements FFI-Kernel-mt.174

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

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

Item was removed:
- ----- Method: Parser>>callback (in category '*FFI-Pools') -----
- callback
- 	<pragmaParser>
- 	
- 	| descriptorClass retType externalName args argType |
- 	descriptorClass := self environment classNamed: #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 removed:
- ----- Method: Parser>>cdecl (in category '*FFI-Pools') -----
- cdecl
- 	<pragmaParser>
- 	^ self externalFunctionDeclaration!

Item was removed:
- ----- 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].
- 	
- 	self environment 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 removed:
- ----- 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]]!