FFI: FFI-Kernel-mt.170.mcz

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