FFI: FFI-Kernel-mt.107.mcz

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

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

Name: FFI-Kernel-mt.107
Author: mt
Time: 14 June 2020, 8:06:15.521471 am
UUID: 2ba15d4f-0579-c144-b72f-9eca272421f5
Ancestors: FFI-Kernel-mt.106

Complements Compiler-mt.437

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

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

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

Item was added:
+ ----- 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: #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 added:
+ ----- Method: Parser>>externalType: (in category '*FFI-Kernel') -----
+ externalType: descriptorClass
+ "Parse and return an external type"
+ | xType typeName |
+ typeName := here. "Note that pointer token is not yet parsed!!"
+ (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: here].
+ self advance.
+ ^ (self matchToken: #*)
+ ifTrue:[xType asPointerType]
+ ifFalse:[(self matchToken: #**)
+ ifTrue: [xType asPointerToPointerType]
+ ifFalse: [xType]]!