FFI: FFI-Pools-mt.30.mcz

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]]!