FFI: FFI-Kernel-mt.174.mcz

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

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

Name: FFI-Kernel-mt.174
Author: mt
Time: 27 May 2021, 9:31:07.812843 am
UUID: 13aff407-23c6-a04d-a83d-6d8abf6f524d
Ancestors: FFI-Kernel-mt.173

Clean up yesterday's dependency hick-up. Sorry for the inconvenience. :-/

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

Item was removed:
- ExternalLibrary subclass: #CStandardLibrary
- instanceVariableNames: ''
- classVariableNames: 'ModuleName'
- poolDictionaries: ''
- category: 'FFI-Kernel-Support'!
-
- !CStandardLibrary commentStamp: 'mt 5/26/2021 10:08' prior: 0!
- The ISO C standard library, also known as "CRT" and "libc."
-
- Further reading:
- https://www.gnu.org/software/libc/
- https://docs.microsoft.com/en-us/cpp/c-runtime-library
- https://www.cplusplus.com/reference/clibrary/
- https://www.iso.org/standard/82075.html!

Item was removed:
- ----- Method: CStandardLibrary class>>guessModuleName (in category 'preferences') -----
- guessModuleName
- "The the platform's module name for the C library."
-
- | platform |
- platform := FFIPlatformDescription current.
-
- platform isMacOS ifTrue: [
- ^ platform osVersionMajor >= 11 "Big Sur and beyond"
- ifTrue:['libSystem.dylib']
- ifFalse: [platform osVersionMajor >= 10
- ifFalse: ['libc.dylib' "Mac OS 9"]
- ifTrue: [platform osVersionMinor >= 7 "at least OS X 10.7 (Lion)"
- ifTrue: ['libobjc.dylib']
- ifFalse: [platform osVersionMinor >= 5 "at least Mac OS X 10.5 (Leopard)"
- ifTrue: ['libgcc_s.1.dylib']
- ifFalse: ['libc.dylib']]]]].
-
- platform isWindows ifTrue: [
- ^ 'msvcrt.dll'].
-
- platform isUnix ifTrue: [
- ^ platform osVersion = 'linux-gnu'
- ifTrue: ['libc.so.6']
- ifFalse: ['libc.so']].
-
- ^ nil!

Item was removed:
- ----- Method: CStandardLibrary class>>moduleName (in category 'preferences') -----
- moduleName
- <preference: 'C runtime/standard library (aka. CRT and libc)'
- categoryList: #('FFI Kernel')
- description: 'Name for or path to the ISO/IEC 9899 C standard library.'
- type: #String>
- ^ ModuleName ifNil: [self guessModuleName]!

Item was removed:
- ----- Method: CStandardLibrary class>>moduleName: (in category 'preferences') -----
- moduleName: nameOrNil
-
- ModuleName := nameOrNil = String empty ifFalse: [nameOrNil].
- self clearAllCaches.
-
- "Check the provided name only if overwritten by clients. See #guessModuleName and FFIPlatformDescription class>> #startUp:."
- ModuleName ifNotNil: [FFIPlatformDescription checkCStandardLibrary].!

Item was removed:
- ----- Method: CStandardLibrary class>>resetDefault (in category 'instance creation') -----
- resetDefault
- "Overwritten to release all function handles."
-
- super resetDefault.
- CStandardLibrary methodsDo: [:m | m externalLibraryName: nil].!

Item was removed:
- ----- Method: CStandardLibrary>>abs: (in category 'stdlib.h - integer arithmetics') -----
- abs: n
- "Returns the absolute value of parameter n"
-
- <cdecl: int32_t abs (int32_t)>
- ^ self externalCallFailed  !

Item was removed:
- ----- Method: CStandardLibrary>>bsearch:with:with:with:with: (in category 'stdlib.h - searching and sorting') -----
- bsearch: key with: base with: num with: size with: compar
-
- <cdecl: void* bsearch (const void*, const void*, size_t, size_t, void*)>
- ^ self externalCallFailed  !

Item was removed:
- ----- Method: CStandardLibrary>>qsort:with:with:with: (in category 'stdlib.h - searching and sorting') -----
- qsort: base with: num with: size with: compar
-
- <cdecl: void qsort (void*, size_t, size_t, void*)>
- ^ self externalCallFailed  !

Item was changed:
  ----- Method: ExternalLibrary class>>resetDefault (in category 'instance creation') -----
  resetDefault
 
+ default := nil.
+ self methodsDo: [:m | m externalLibraryName: nil].!
- default := nil.!

Item was changed:
  Object subclass: #FFIPlatformDescription
  instanceVariableNames: 'name osVersion subtype wordSize endianness'
+ classVariableNames: 'CheckFFIOnStartUp LastPlatform'
- classVariableNames: 'CheckCStandardLibraryOnStartUp CheckFFIOnStartUp LastPlatform'
  poolDictionaries: ''
  category: 'FFI-Kernel-Support'!
 
  !FFIPlatformDescription commentStamp: 'mt 6/2/2020 15:18' prior: 0!
  This class stores the information about the current (host) platform. It supports testing instances for platform compatibility and specificity. The entire FFI machinery should go through here, when making platform-specific decisions such as when figuring out the #wordSize for pointers to external memory (i.e., ExternalAddress class >> #new) or when looking up compatible definitions for external pools (i.e., ExternalPool class >> #compatibleResolvedDefinitions).
 
 
  1. DETECT PLATFORM CHANGE ON STARTUP
 
  This class is registered for system startup. It then checks whether the current platform is different from the last one. In that case, a selection of FFI classes gets notified such as ExternalObject and ExternalType.
 
 
  2. PLATFORM SPECIFICITY
 
  Platform descriptions may be unspecific, that is, some of their values may be undefined. For example, (FFIPlatformDescription name: 'unix') creates a valid description but is not specific about #osVersion or #wordSize. When comparing such descriptions, precedence of the platform values are:
 
  platform name > osVersion > subtype > wordSize
 
  So, if one description has a #name and the other does not, the first one is more specific. If both have #name but only the second one has #osVersion, the second one is more specific. If one has only #wordSize and another one has only #subtype, the second one is more specific because #subtype has a higher precedence than #wordSize.
 
 
  3. PLATFORM COMPATIBILITY
 
  Platform descriptions implement a notion of compatibility, which is coupled to its notion of specificity as mentioned before. Using the same rules of precedence, compatibility is checked by comparing the description's values. If not specificed, compatibility is assumed. If specified, values must match via #= to be regarded compatible.
 
  Here is an interesting edge case of two compatible platform descriptions:
 
  | p1 p2 |
  p1 := FFIPlatformDescription name: 'Win32' osVersion: '' subtype: 'IX86' wordSize: nil.
  p2 := FFIPlatformDescription name: '' osVersion: 'linux-gnu' subtype: '' wordSize: 8.
  p1 isCompatibleWith: p2.
 
  Consequently, the developer has to be careful with unspecific platform descriptions, which are used, for example, in the definitions of external pools.
 
 
  4. FURTHER READING
 
  - all references to FFIPlatformDescription
  - all senders of #wordSize
  - class comments of ExternalAddress, ExternalType, ExternalPool, ExternalObject
  !

Item was removed:
- ----- Method: FFIPlatformDescription class>>checkCStandardLibrary (in category 'system startup') -----
- checkCStandardLibrary
- "Try to use C Standard Library. Warn if not possible."
-
- [ [self assert: [(CStandardLibrary default abs: -5) = 5]
- ] ifError: [:msg |
- self notify: 'C standard library not available. Please check module name in preferences.', String cr, String cr, msg]
- ] fork. "Do not interrupt the startup list."!

Item was removed:
- ----- Method: FFIPlatformDescription class>>checkCStandardLibraryOnStartUp (in category 'preferences') -----
- checkCStandardLibraryOnStartUp
- <preference: 'Check C standard library on start-up'
- categoryList: #('FFI Kernel')
- description: 'When enabled, performs a simple check of the C standard library when Squeak is resuming.'
- type: #Boolean>
- ^ CheckCStandardLibraryOnStartUp ifNil: [true]!

Item was removed:
- ----- Method: FFIPlatformDescription class>>checkCStandardLibraryOnStartUp: (in category 'preferences') -----
- checkCStandardLibraryOnStartUp: aBoolean
-
- CheckCStandardLibraryOnStartUp := aBoolean.!

Item was changed:
  ----- Method: FFIPlatformDescription class>>startUp: (in category 'system startup') -----
  startUp: resuming
  "Notify all FFI classes about platform changes."
 
  resuming ifTrue: [
  LastPlatform in: [:lastPlatform | self newCurrent in: [:currentPlatform |
  lastPlatform = currentPlatform
  ifTrue: [
  self flag: #discuss. "mt: Maybe add #platformResuming?"
  ExternalAddress allBeNull.
  ExternalType cleanupUnusedTypes ]
  ifFalse: [
  LastPlatform := currentPlatform. "Update now. See #current."
  { ExternalAddress. ExternalType. ExternalStructure. ExternalPool. ExternalLibrary }
  do: [:cls | cls
  platformChangedFrom: lastPlatform
  to: currentPlatform] ]]].
+ self checkFFIOnStartUp ifTrue: [self checkFFI]].!
- self checkFFIOnStartUp ifTrue: [self checkFFI].
- self checkCStandardLibraryOnStartUp ifTrue: [self checkCStandardLibrary]].!

Item was removed:
- CStandardLibrary subclass: #LibC
- instanceVariableNames: ''
- classVariableNames: ''
- poolDictionaries: ''
- category: 'FFI-Kernel-Support'!
-
- !LibC commentStamp: 'mt 5/26/2021 10:09' prior: 0!
- Just a synonym for convenient reference.!

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

Item was added:
+ ----- Method: Parser>>callback (in category '*FFI-Kernel') -----
+ 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 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: #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 added:
+ ----- 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'.
+ 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]]!