ExternalLibraryFunction.st
author Claus Gittinger <cg@exept.de>
Wed, 16 Jan 2013 13:20:15 +0100
changeset 14659 410089913ca1
parent 14632 6fe0dc1d5377
child 14729 1432f384b1cc
child 18011 deb0c3355881
permissions -rw-r--r--
allow use of the standard (system) ffi

"
 COPYRIGHT (c) 2004 by eXept Software AG
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
"{ Package: 'stx:libbasic' }"

ExternalFunction subclass:#ExternalLibraryFunction
	instanceVariableNames:'flags moduleName returnType argumentTypes owningClass'
	classVariableNames:'DLLPATH FLAG_VIRTUAL FLAG_NONVIRTUAL FLAG_OBJECTIVEC FLAG_ASYNC
		FLAG_UNLIMITEDSTACK FLAG_RETVAL_IS_CONST CALLTYPE_MASK
		CALLTYPE_API CALLTYPE_C CALLTYPE_OLE CALLTYPE_V8 CALLTYPE_V9
		CALLTYPE_UNIX64 DllMapping'
	poolDictionaries:''
	category:'System-Support'
!

!ExternalLibraryFunction primitiveDefinitions!
%{

#ifdef HAVE_FFI
# include <ffi.h>
# define MAX_ARGS    128

# ifdef USE_STANDARD_FFI
#  define __get_ffi_type_sint() &ffi_type_sint
#  define __get_ffi_type_sint8() &ffi_type_sint8
#  define __get_ffi_type_sint16() &ffi_type_sint16
#  define __get_ffi_type_sint32() &ffi_type_sint32
#  define __get_ffi_type_sint64() &ffi_type_sint64
#  define __get_ffi_type_uint() &ffi_type_uint
#  define __get_ffi_type_uint8() &ffi_type_uint8
#  define __get_ffi_type_uint16() &ffi_type_uint16
#  define __get_ffi_type_uint32() &ffi_type_uint32
#  define __get_ffi_type_uint64() &ffi_type_uint64
#  define __get_ffi_type_float() &ffi_type_float
#  define __get_ffi_type_double() &ffi_type_double
#  define __get_ffi_type_void() &ffi_type_void
#  define __get_ffi_type_pointer() &ffi_type_pointer
# else
extern ffi_type *__get_ffi_type_sint();
extern ffi_type *__get_ffi_type_sint8();
extern ffi_type *__get_ffi_type_sint16();
extern ffi_type *__get_ffi_type_sint32();
extern ffi_type *__get_ffi_type_sint64();
extern ffi_type *__get_ffi_type_uint();
extern ffi_type *__get_ffi_type_uint8();
extern ffi_type *__get_ffi_type_uint16();
extern ffi_type *__get_ffi_type_uint32();
extern ffi_type *__get_ffi_type_uint64();
extern ffi_type *__get_ffi_type_float();
extern ffi_type *__get_ffi_type_double();
extern ffi_type *__get_ffi_type_void();
extern ffi_type *__get_ffi_type_pointer();
# endif

#endif

%}
! !

!ExternalLibraryFunction class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2004 by eXept Software AG
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

documentation
"
    instances of me are used to interface to external library functions (as found in a dll/shared object).

    Inside a method, when a special external-call pragma such as:
	<api: bool MessageBeep(uint)>

    is encountered by the parser, the compiler generates a call via
	<correspondingExternalLibraryFunctionObject> invokeWithArguments: argumentArray.

    In the invoke method, the library is checked to be loaded (and loaded if not already),
    the arguments are converted to C and pushed onto the C-stack, the function is called,
    and finally, the return value is converted back from C to a smalltalk object.

    The parser supports the call-syntax of various other smalltalk dialects:
	Squeak / ST-X:
	    <cdecl:   [async] [virtual|nonVirtual][const] returnType functionNameStringOrIndex ( argType1..argTypeN ) module: moduleName >
	    <apicall: [async] [virtual|nonVirtual][const] returnType functionNameStringOrIndex ( argType1..argTypeN ) module: moduleName >

	Dolphin:
	    <stdcall: [virtual|nonVirtual][const] returnType functionNameStringOrIndex argType1..argTypeN>
	    <cdecl:   [virtual|nonVirtual][const] returnType functionNameStringOrIndex argType1..argTypeN>

	ST/V:
	    <api: functionName argType1 .. argTypeN returnType>
	    <ccall: functionName argType1 .. argTypeN returnType>
	    <ole: vFunctionIndex argType1 .. argTypeN returnType>

	VisualWorks:
	    <c: ...>
	    <c: #define NAME value>
"
!

example
"
								[exBegin]
	|f|

	f := ExternalLibraryFunction new.
	f beCallTypeWINAPI.

	f name:'MessageBeep'
	  module:'user32.dll'
	  returnType:#boolean
	  argumentTypes:#(uint).

	f invokeWith:1.
								[exEnd]

  Synchronous vs. Asynchronous calls:

    by default, foreign function calls are synchronous, effectively blocking the whole ST/X system
    (that is by purpose,ībecause most C-code is not prepared for being interrupted, and also, normal
     code is not prepared for a garbage collector to move objects around, while another C thread might
     access the data...).
    Therefore, the following will block all ST/X activity for 10 seconds
    (try interacting with the launcher while the Sleep is performing):

								[exBegin]
	|f|

	f := ExternalLibraryFunction new.
	f beCallTypeWINAPI.

	f name:'Sleep'
	  module:'kernel32.dll'
	  returnType:#void
	  argumentTypes:#(uint).

	f invokeWith:10000.
								[exEnd]

    if you know what you do and you do not pass any possibly moving objects (such as strings) as argument,
    the call can be made asynchronous. In that case, ONLY the calling thread will be blocked; all other smalltalk
    threads wil continue to execute.
    (try interacting now with the launcher while the Sleep is performing):
								[exBegin]
	|f|

	f := ExternalLibraryFunction new.
	f beCallTypeWINAPI.
	f beAsync.

	f name:'Sleep'
	  module:'kernel32.dll'
	  returnType:#void
	  argumentTypes:#(uint).

	f invokeWith:10000.
								[exEnd]

"
! !

!ExternalLibraryFunction class methodsFor:'instance creation'!

name:functionName module:moduleName returnType:returnType argumentTypes:argTypes
    ^ self new
	name:functionName module:moduleName
	returnType:returnType argumentTypes:argTypes

    "Created: / 01-08-2006 / 15:19:08 / cg"
! !

!ExternalLibraryFunction class methodsFor:'class initialization'!

addToDllPath:aDirectoryPathName
    "can be used during initialization, to add more places for dll-loading"

    |oldPath|

    oldPath := self dllPath.
    (oldPath includes:aDirectoryPathName) ifFalse:[
	self dllPath:(oldPath asOrderedCollection copyWith:aDirectoryPathName)
    ]
!

dllMapping
    "allows for dll's to be replaced,
     for example, if you want to use the mozilla sqlite dll
	C:\Program Files\Mozilla Firefox\mozsqlite3.dll
     for the sqlite3, execute:
	ExternalLibraryFunction
	    dllMapping at:'sqlite3'
	    put: 'C:\Program Files\Mozilla Firefox\mozsqlite3.dll'
    "

    DllMapping isNil ifTrue:[
	DllMapping := Dictionary new.
    ].
    ^ DllMapping

    "Created: / 10-04-2012 / 12:21:45 / cg"
!

dllPath
    ^ DLLPATH
!

dllPath:aCollectionOfDirectoryPathNames
    DLLPATH := aCollectionOfDirectoryPathNames
!

initialize
    "using inline access to corresponding c--defines to avoid duplicate places of knowledge"

    DLLPATH isNil ifTrue:[
	DLLPATH := #('.').
	FLAG_VIRTUAL := %{ __MKSMALLINT(__EXTL_FLAG_VIRTUAL) %}.                "/ a virtual c++ call
	FLAG_NONVIRTUAL := %{ __MKSMALLINT(__EXTL_FLAG_NONVIRTUAL) %}.          "/ a non-virtual c++ call
	FLAG_OBJECTIVEC := %{ __MKSMALLINT(__EXTL_FLAG_OBJECTIVEC) %}.          "/ an objectiveC message send
	FLAG_UNLIMITEDSTACK := %{ __MKSMALLINT(__EXTL_FLAG_UNLIMITEDSTACK) %}.  "/ unlimitedstack under unix
	FLAG_ASYNC := %{ __MKSMALLINT(__EXTL_FLAG_ASYNC) %}.                    "/ async under win32
	FLAG_RETVAL_IS_CONST := %{ __MKSMALLINT(__EXTL_FLAG_RETVAL_IS_CONST) %}."/ return value is not to be registered for finalization

	CALLTYPE_API := %{ __MKSMALLINT(__EXTL_CALLTYPE_API) %}.                "/ WINAPI-call (win32 only)
	CALLTYPE_C := %{ __MKSMALLINT(__EXTL_CALLTYPE_C) %}.                    "/ regular C-call (the default)
	CALLTYPE_V8 := %{ __MKSMALLINT(__EXTL_CALLTYPE_V8) %}.                  "/ v8 call (sparc only)
	CALLTYPE_V9 := %{ __MKSMALLINT(__EXTL_CALLTYPE_V9) %}.                  "/ v9 call (sparc only)
	CALLTYPE_UNIX64 := %{ __MKSMALLINT(__EXTL_CALLTYPE_UNIX64) %}.          "/ unix64 call (alpha only)

	CALLTYPE_MASK := %{ __MKSMALLINT(__EXTL_CALLTYPE_MASK) %}.
    ].

    "
     self initialize
    "

    "Modified: / 03-10-2006 / 21:27:47 / cg"
!

removeFromDllPath:aDirectoryPathName
    "remove added places from dll-loading"

    |oldPath|

    oldPath := self dllPath.
    self dllPath:(oldPath asOrderedCollection copyWithout:aDirectoryPathName)

    "
     self dllPath.
     self addToDllPath:'C:\aaa\bbb'.
     self dllPath.
     self removeFromDllPath:'C:\aaa\bbb'.
     self dllPath.
    "
! !

!ExternalLibraryFunction class methodsFor:'constants'!

callTypeAPI
    ^ CALLTYPE_API

    "Modified: / 01-08-2006 / 13:44:41 / cg"
!

callTypeC
    ^ CALLTYPE_C

    "Modified: / 01-08-2006 / 13:44:49 / cg"
!

callTypeCDecl
    ^ CALLTYPE_C

    "Modified: / 01-08-2006 / 13:44:52 / cg"
!

callTypeMASK
    ^ CALLTYPE_MASK

    "Modified: / 01-08-2006 / 13:44:57 / cg"
!

callTypeOLE
    ^ CALLTYPE_OLE

    "Modified: / 01-08-2006 / 13:44:57 / cg"
! !

!ExternalLibraryFunction methodsFor:'accessing'!

argumentTypes
    ^ argumentTypes
!

argumentTypesString
    ^ String
	streamContents:[:s |
	    argumentTypes do:[:eachArgType |
		eachArgType printOn:s.
	    ] separatedBy:[
		s nextPutAll:','.
	    ].
	].
!

beAsync
    "let this execute in a separate thread, in par with the other execution thread(s).
     Ignored under unix/linux (until those support multiple threads too)."

    flags := (flags ? 0) bitOr: FLAG_ASYNC.

    "Created: / 01-08-2006 / 13:42:38 / cg"
!

beCallTypeAPI
    flags := (flags ? 0) bitOr: CALLTYPE_API.

    "Created: / 01-08-2006 / 15:12:40 / cg"
!

beCallTypeC
    flags := (flags ? 0) bitOr: CALLTYPE_C.

    "Created: / 01-08-2006 / 15:12:40 / cg"
!

beCallTypeOLE
    flags := (flags ? 0) bitOr: FLAG_VIRTUAL.

    "Created: / 01-08-2006 / 15:12:40 / cg"
!

beCallTypeUNIX64
    flags := (flags ? 0) bitOr: CALLTYPE_UNIX64.

    "Created: / 01-08-2006 / 15:13:38 / cg"
!

beCallTypeV8
    flags := (flags ? 0) bitOr: CALLTYPE_V8.

    "Created: / 01-08-2006 / 15:13:28 / cg"
!

beCallTypeV9
    flags := (flags ? 0) bitOr: CALLTYPE_V9.

    "Created: / 01-08-2006 / 15:13:31 / cg"
!

beCallTypeWINAPI
    self beCallTypeAPI

    "Modified: / 01-08-2006 / 15:14:02 / cg"
!

beConstReturnValue
    "specify that a pointer return value is not to be finalized
     (i.e. points to static data or data which is freed by c)"

    flags := (flags ? 0) bitOr: FLAG_RETVAL_IS_CONST.

    "Created: / 01-08-2006 / 13:56:48 / cg"
!

beNonVirtualCPP
    "specify this as a non-virtual c++-function"

    flags := (flags ? 0) bitOr: FLAG_NONVIRTUAL.

    "Created: / 01-08-2006 / 13:56:44 / cg"
!

beUnlimitedStack
    "let this execute on the c-stack (as opposed to the thread-stack)
     for unlimited auto-sized-stack under unix/linux.
     Ignored under windows."

    flags := (flags ? 0) bitOr: FLAG_UNLIMITEDSTACK.

    "Created: / 01-08-2006 / 13:41:54 / cg"
!

beVirtualCPP
    "specify this as a virtual c++-function"

    flags := (flags ? 0) bitOr: FLAG_VIRTUAL.

    "Created: / 01-08-2006 / 13:56:48 / cg"
!

beObjectiveC
    "specify this as an objective-c message send"

    flags := (flags ? 0) bitOr: FLAG_OBJECTIVEC.

    "Created: / 01-08-2006 / 13:56:48 / cg"
!

callTypeNumber
    ^ (flags ? 0) bitAnd: CALLTYPE_MASK.

    "Created: / 01-08-2006 / 15:12:10 / cg"
!

isAsync
    "is this executed in a separate thread, in par with the other execution thread(s) ?"

    ^ (flags ? 0) bitTest: FLAG_ASYNC.

    "Created: / 01-08-2006 / 13:46:53 / cg"
!

isCPPFunction
    "is this a virtual or non-virtual c++-function ?"

    ^ (flags ? 0) bitTest: (FLAG_VIRTUAL bitOr: FLAG_NONVIRTUAL).

    "Created: / 01-08-2006 / 13:56:54 / cg"
!

isObjectiveC
    "is this an objective-C message?"

    ^ (flags ? 0) bitTest: FLAG_OBJECTIVEC.
!

isCallTypeAPI
    ^ ((flags ? 0) bitAnd: CALLTYPE_MASK) == CALLTYPE_API.

    "Created: / 01-08-2006 / 15:21:16 / cg"
!

isCallTypeC
    ^ ((flags ? 0) bitAnd: CALLTYPE_MASK) == CALLTYPE_C.

    "Created: / 01-08-2006 / 15:21:23 / cg"
!

isCallTypeOLE
    ^ ((flags ? 0) bitTest: FLAG_VIRTUAL).

    "Created: / 01-08-2006 / 15:21:23 / cg"
!

isConstReturnValue
    "is the pointer return value not to be finalized
     (i.e. points to static data or data which is freed by c)"

    ^ (flags ? 0) bitTest: FLAG_RETVAL_IS_CONST.

    "Created: / 01-08-2006 / 13:56:48 / cg"
!

isNonVirtualCPP
    "is this a non-virtual c++-function ?"

    ^ (flags ? 0) bitTest: FLAG_NONVIRTUAL.

    "Created: / 01-08-2006 / 13:56:51 / cg"
!

isUnlimitedStack
    "will this execute on the c-stack (as opposed to the thread-stack)
     for unlimited auto-sized-stack under unix/linux.
     Ignored under windows."

    ^ (flags ? 0) bitTest: FLAG_UNLIMITEDSTACK.

    "Created: / 01-08-2006 / 14:17:07 / cg"
!

isVirtualCPP
    "is this a virtual c++-function ?"

    ^ (flags ? 0) bitTest: FLAG_VIRTUAL.

    "Created: / 01-08-2006 / 13:56:54 / cg"
!

moduleName
    ^ moduleName
!

returnType
    ^ returnType
!

vtableIndex
    name isNumber ifFalse:[^ nil].
    ^ name.
! !

!ExternalLibraryFunction methodsFor:'invoking'!

invoke
    self hasCode ifFalse:[
	self prepareInvoke.
    ].
    ^ self invokeFFIWithArguments:nil
!

invokeCPPVirtualOn:anInstance
    self hasCode ifFalse:[
	self prepareInvoke.
    ].
    ^ self invokeCPPVirtualFFIOn:anInstance withArguments:nil
!

invokeCPPVirtualOn:instance with:arg
    self hasCode ifFalse:[
	self prepareInvoke.
    ].
    ^ self invokeCPPVirtualFFIOn:instance withArguments:(Array with:arg)
!

invokeCPPVirtualOn:instance with:arg1 with:arg2
    self hasCode ifFalse:[
	self prepareInvoke.
    ].
    ^ self invokeCPPVirtualFFIOn:instance withArguments:(Array with:arg1 with:arg2)
!

invokeCPPVirtualOn:instance with:arg1 with:arg2 with:arg3
    self hasCode ifFalse:[
	self prepareInvoke.
    ].
    ^ self invokeCPPVirtualFFIOn:instance withArguments:(Array with:arg1 with:arg2 with:arg3)
!

invokeCPPVirtualOn:instance with:arg1 with:arg2 with:arg3 with:arg4
    self hasCode ifFalse:[
	self prepareInvoke.
    ].
    ^ self invokeCPPVirtualFFIOn:instance withArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4)
!

invokeCPPVirtualOn:instance withArguments:args
    self hasCode ifFalse:[
	self prepareInvoke.
    ].
    ^ self invokeCPPVirtualFFIOn:instance withArguments:args
!

invokeWith:arg
    self hasCode ifFalse:[
	self prepareInvoke.
    ].
    ^ self invokeFFIWithArguments:(Array with:arg)
!

invokeWith:arg1 with:arg2
    self hasCode ifFalse:[
	self prepareInvoke.
    ].
    ^ self invokeFFIWithArguments:(Array with:arg1 with:arg2)
!

invokeWith:arg1 with:arg2 with:arg3
    self hasCode ifFalse:[
	self prepareInvoke.
    ].
    ^ self invokeFFIWithArguments:(Array with:arg1 with:arg2 with:arg3)
!

invokeWith:arg1 with:arg2 with:arg3 with:arg4
    self hasCode ifFalse:[
	self prepareInvoke.
    ].
    ^ self invokeFFIWithArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4)
!

invokeWithArguments:argArray
    self hasCode ifFalse:[
	self prepareInvoke.
    ].
    ^ self invokeFFIwithArguments:argArray forCPPInstance:nil

    "Modified: / 01-08-2006 / 16:04:08 / cg"
! !

!ExternalLibraryFunction methodsFor:'printing'!

printOn:aStream
    aStream nextPutAll:'<'.
    self isCallTypeAPI ifTrue:[
	'API:' printOn:aStream.
    ] ifFalse:[
	self isCallTypeOLE ifTrue:[
	    'OLE:' printOn:aStream.
	] ifFalse:[
	    self isCallTypeC ifTrue:[
		'C:' printOn:aStream.
	    ] ifFalse:[
		self error.
	    ].
	].
    ].
    aStream nextPutAll:' '.
    name printOn:aStream.
    moduleName notNil ifTrue:[
	aStream nextPutAll:' module:'.
	moduleName printOn:aStream.
    ].
    aStream nextPutAll:'>'.

    "Modified: / 25-09-2012 / 12:06:14 / cg"
! !

!ExternalLibraryFunction methodsFor:'private'!

adjustTypes
    argumentTypes notNil ifTrue:[
	argumentTypes := argumentTypes collect:[:argType | self ffiTypeSymbolForType:argType].
    ].
    returnType := self ffiTypeSymbolForType:returnType.
!

linkToModule
    "link this function to the external module.
     I.e. retrieve the module handle and the code pointer."

    |handle moduleNameUsed functionName|

    name isNumber ifTrue:[
	self isCPPFunction ifTrue:[
	    "/ no need to load a dll.
	    ^ self
	]
    ].

    "/ in some other smalltalks, there is no moduleName in the ffi-spec;
    "/ instead, the class provides the libraryName...
    (moduleNameUsed := moduleName) isNil ifTrue:[
	owningClass isNil ifTrue:[
	    self error:'Missing moduleName'.
	].
	moduleNameUsed := owningClass theNonMetaclass libraryName asSymbol.
    ].
    moduleHandle isNil ifTrue:[
	handle := self loadLibrary:moduleNameUsed.
	handle isNil ifTrue:[
	    self error:('Cannot find or load dll/module: "%1"' bindWith: moduleNameUsed).
	].
	moduleHandle := handle.
    ].
    name isNumber ifFalse:[
	functionName := name.
	(moduleHandle getFunctionAddress:functionName into:self) isNil ifTrue:[
	    functionName := ('_', functionName) asSymbol.

	    (moduleHandle getFunctionAddress:functionName into:self) isNil ifTrue:[
		moduleHandle := nil.
		self error:'Missing function: ', name, ' in module: ', moduleNameUsed.
	    ].
	].
    ].

    "Modified: / 10-04-2012 / 12:12:44 / cg"
!

loadLibrary:dllName
    |handle nameString filename|

    filename := dllName.
    DllMapping notNil ifTrue:[
	filename := DllMapping at:filename ifAbsent:[ filename ]
    ].

    filename := filename asFilename.
    nameString := filename name.

    "try to load, maybe the system knows where to find the dll"
    handle := ObjectFileLoader loadDynamicObject:filename.
    handle notNil ifTrue:[^ handle ].

    filename isAbsolute ifFalse:[
	"First ask the class defining the ExternalFunction for the location of the dlls ..."
	owningClass notNil ifTrue:[
	    owningClass dllPath do:[:eachDirectory |
		handle := ObjectFileLoader
			    loadDynamicObject:(eachDirectory asFilename construct:nameString) pathName.
		handle notNil ifTrue:[^ handle ].
	    ].
	].
	".. then ask the system"
	self class dllPath do:[:eachDirectory |
	    handle := ObjectFileLoader
			loadDynamicObject:(eachDirectory asFilename construct:nameString) pathName.
	    handle notNil ifTrue:[^ handle ].
	].
    ].

    filename suffix isEmpty ifTrue:[
	"/ try again with the OS-specific dll-extension
	^ self loadLibrary:(filename withSuffix:ObjectFileLoader sharedLibrarySuffix)
    ].

    ^ nil

    "Modified: / 10-04-2012 / 12:21:06 / cg"
!

prepareInvoke
    (moduleHandle isNil or:[self hasCode not]) ifTrue:[
	self linkToModule.
	self adjustTypes.
    ].
! !

!ExternalLibraryFunction methodsFor:'private-accessing'!

ffiTypeSymbolForType:aType
    "map type to one of the ffi-supported ones:
	sint8, sint16, sint32, sint64
	uint8, uint16, uint32, uint64
	bool void pointer handle
    "

    aType == #sint8           ifTrue:[^ aType ].
    aType == #sint16          ifTrue:[^ aType ].
    aType == #sint32          ifTrue:[^ aType ].
    aType == #sint64          ifTrue:[^ aType ].
    aType == #uint8           ifTrue:[^ aType ].
    aType == #uint16          ifTrue:[^ aType ].
    aType == #uint32          ifTrue:[^ aType ].
    aType == #uint64          ifTrue:[^ aType ].
    aType == #double          ifTrue:[^ aType ].
    aType == #float           ifTrue:[^ aType ].
    aType == #char            ifTrue:[^ aType ].
    aType == #void            ifTrue:[^ aType ].
    aType == #bool            ifTrue:[^ aType ].
    aType == #pointer         ifTrue:[^ aType ].
    aType == #charPointer     ifTrue:[^ aType ].
    aType == #wcharPointer    ifTrue:[^ aType ].

    aType == #int8            ifTrue:[^ #sint8 ].
    aType == #int16           ifTrue:[^ #sint16 ].
    aType == #int32           ifTrue:[^ #sint32 ].
    aType == #int64           ifTrue:[^ #sint64 ].

    aType == #voidPointer         ifTrue:[^ #pointer ].
    aType == #uint8Pointer        ifTrue:[^ #pointer ].
    aType == #voidPointerPointer  ifTrue:[^ #pointer ].

    aType == #short           ifTrue:[^ #sint16 ].
    aType == #long            ifTrue:[^ #long ].
    aType == #int             ifTrue:[^ #int ].
    aType == #uint            ifTrue:[^ #uint ].
    aType == #ushort          ifTrue:[^ #uint16 ].
    aType == #unsignedShort   ifTrue:[^ #uint16 ].
    aType == #ulong           ifTrue:[^ #ulong ].
    aType == #unsignedLong    ifTrue:[^ #ulong ].
    aType == #uchar           ifTrue:[^ #uint8 ].
    aType == #unsignedChar    ifTrue:[^ #uint8 ].
    aType == #byte            ifTrue:[^ #uint8 ].
    aType == #dword           ifTrue:[^ #uint32 ].
    aType == #sdword          ifTrue:[^ #sint32 ].
    aType == #word            ifTrue:[^ #uint16 ].
    aType == #sword           ifTrue:[^ #sint16 ].
    aType == #longlong        ifTrue:[^ #sint64 ].
    aType == #longLong        ifTrue:[^ #sint64 ].
    aType == #ulonglong       ifTrue:[^ #uint64 ].
    aType == #ulongLong       ifTrue:[^ #uint64 ].
    aType == #handle          ifTrue:[^ #pointer ].
    aType == #lpstr           ifTrue:[^ #charPointer ].
    aType == #hresult         ifTrue:[^ #uint32 ].
    aType == #boolean         ifTrue:[^ #bool ].
    aType == #ulongReturn     ifTrue:[^ #uint32 ].    "/ TODO - care for 64bit machines
    aType == #none            ifTrue:[^ #void ].
    aType == #struct          ifTrue:[^ #pointer ].
    aType == #structIn        ifTrue:[^ #pointer ].
    aType == #structOut       ifTrue:[^ #pointer ].
    aType == #unsigned        ifTrue:[^ #uint ].

    (aType isString or:[aType isSymbol]) ifFalse:[
	CType isNil ifTrue:[
	    self error:'unknown type'.
	].
	^ aType typeSymbol.
    ].

    (aType endsWith:'*') ifTrue:[
	^ #pointer.
    ].
    (aType endsWith:'Pointer') ifTrue:[
	^ #pointer.
    ].
    ^ aType

    "Modified: / 14-06-2007 / 17:21:42 / cg"
!

name:functionNameOrVirtualIndex module:aModuleName returnType:aReturnType argumentTypes:argTypes
    name := functionNameOrVirtualIndex.
    functionNameOrVirtualIndex isNumber ifTrue:[
	self beVirtualCPP.
    ].
    moduleName := aModuleName.
    returnType := aReturnType.
    argumentTypes := argTypes.

    "Created: / 01-08-2006 / 15:19:52 / cg"
    "Modified: / 02-08-2006 / 17:20:13 / cg"
!

owningClass
    ^ owningClass
!

owningClass:aClass
    owningClass := aClass.

    "Created: / 01-08-2006 / 15:22:50 / cg"
!

setModuleName:aModuleName
    aModuleName ~= moduleName ifTrue:[
	self code:nil.
	moduleHandle := nil.
	moduleName := aModuleName.
    ].

    "Created: / 07-06-2007 / 10:20:17 / cg"
! !

!ExternalLibraryFunction methodsFor:'private-invoking'!

invokeCPPVirtualFFIOn:instance withArguments:arguments
    ^ self invokeFFIwithArguments:arguments forCPPInstance:instance

    "Modified: / 01-08-2006 / 13:55:30 / cg"
!

invokeFFIWithArguments:arguments
    ^ self invokeFFIwithArguments:arguments forCPPInstance:nil

    "Modified: / 01-08-2006 / 13:55:35 / cg"
!

invokeFFIwithArguments:argumentsOrNil forCPPInstance:aReceiverOrNil
    "basic invoke mechanism. Calls the function represented by the receiver with argumentsOrNil.
     For cplusplus, aReceiverOrNil is required to be an externalStructure like object;
     for objectiveC, it must be an ObjectiveC object"

    |argTypeSymbols returnTypeSymbol failureCode failureInfo returnValue stClass vtOffset
     virtual objectiveC async unlimitedStack callTypeNumber returnValueClass argValueClass
     oldReturnType oldArgumentTypes|

    argTypeSymbols := argumentTypes.
    returnTypeSymbol := returnType.

    virtual := self isVirtualCPP.
    objectiveC := self isObjectiveC.
    (virtual "or:[self isNonVirtualCPP]") ifTrue:[
	aReceiverOrNil isNil ifTrue:[
	    "/ must have a c++ object instance
	    self primitiveFailed.
	].

	"/ and it must be a kind of ExternalStructure !!
	(aReceiverOrNil isKindOf:ExternalStructure) ifFalse:[
	    self primitiveFailed.
	].
	virtual ifTrue:[
	    vtOffset := name.
	    (vtOffset between:0 and:10000) ifFalse:[
		self primitiveFailed.
	    ]
	].
    ] ifFalse:[
	objectiveC ifTrue:[
	    aReceiverOrNil isNil ifTrue:[
	        "/ must have an objective-c object instance
	        self primitiveFailed.
	    ].
	    (aReceiverOrNil isObjectiveCObject) ifFalse:[
		self primitiveFailed
	    ]
	] ifFalse:[
	    aReceiverOrNil notNil ifTrue:[
	        "/ must NOT have a c++/objectiveC object instance
	        self primitiveFailed.
	    ]
	].
    ].
    async := self isAsync.
    unlimitedStack := self isUnlimitedStack.
    callTypeNumber := self callTypeNumber.
    "/ Transcript show:name; show:' async:'; showCR:async.

%{  /* STACK: 100000 */

#ifdef HAVE_FFI
# ifdef __GNUC__
#  ifndef HAS_LONGLONG
#   define HAS_LONGLONG
#  endif
# endif
# if defined(__BORLANDC__) || defined(__VISUALC__)
#  define HAS_INT64
# endif

    ffi_cif __cif;
    ffi_type *__argTypesIncludingThis[MAX_ARGS+1];
    ffi_type **__argTypes = __argTypesIncludingThis;
    ffi_type *__returnType = NULL;

    union u {
	int iVal;
	float fVal;
	double dVal;
	void *pointerVal;
# if defined(HAS_LONGLONG)
	long long longLongVal;
# else
#  ifdef HAS_INT64
	__int64__ longLongVal;
#  else
	struct ll { long low; long hi; } longLongVal;
#  endif
# endif
    };
    union u __argValuesIncludingThis[MAX_ARGS+1];
    union u *__argValues = __argValuesIncludingThis;
    union u __returnValue;
    void *__argValuePointersIncludingThis[MAX_ARGS+1];
    void **__argValuePointers = __argValuePointersIncludingThis;
    void *__returnValuePointer;
    int __numArgs, __numArgsIncludingThis;
    static int null = 0;
    int i;
    ffi_abi __callType = FFI_DEFAULT_ABI;
    VOIDFUNC codeAddress = (VOIDFUNC)__INST(code_);
    int __numArgsWanted;

#   define __FAIL__(fcode) \
    { \
	failureCode = fcode; goto getOutOfHere; \
    }

    if (argumentsOrNil == nil) {
	__numArgs = 0;
    } else if (__isArray(argumentsOrNil)) {
	__numArgs = __arraySize(argumentsOrNil);
    } else {
	__FAIL__(@symbol(BadArgumentVector))
    }
    if (argTypeSymbols == nil) {
	__numArgsWanted = 0;
    } else if (__isArray(argTypeSymbols)) {
	__numArgsWanted = __arraySize(argTypeSymbols);
    } else {
	__FAIL__(@symbol(BadArgumentTypeVector))
    }

    if (__numArgs != __numArgsWanted) {
	__FAIL__(@symbol(ArgumentCountMismatch))
    }
    if (__numArgs > MAX_ARGS) {
	__FAIL__(@symbol(TooManyArguments))
    }

    /*
     * validate the return type
     */
    __returnValuePointer = &__returnValue;

    if (returnTypeSymbol == @symbol(voidPointer)) {
	returnTypeSymbol = @symbol(handle);
    }

    if (returnTypeSymbol == @symbol(int)) {
	__returnType = __get_ffi_type_sint();
    } else if (returnTypeSymbol == @symbol(uint)) {
	__returnType = __get_ffi_type_uint();
    } else if (returnTypeSymbol == @symbol(uint8)) {
	__returnType = __get_ffi_type_uint8();
    } else if (returnTypeSymbol == @symbol(uint16)) {
	__returnType = __get_ffi_type_uint16();
    } else if (returnTypeSymbol == @symbol(uint32)) {
	__returnType = __get_ffi_type_uint32();
    } else if (returnTypeSymbol == @symbol(uint64)) {
	__returnType = __get_ffi_type_uint64();

    } else if (returnTypeSymbol == @symbol(sint)) {
	__returnType = __get_ffi_type_sint();
    } else if (returnTypeSymbol == @symbol(sint8)) {
	__returnType = __get_ffi_type_sint8();
    } else if (returnTypeSymbol == @symbol(sint16)) {
	__returnType = __get_ffi_type_sint16();
    } else if (returnTypeSymbol == @symbol(sint32)) {
	__returnType = __get_ffi_type_sint32();
    } else if (returnTypeSymbol == @symbol(sint64)) {
	__returnType = __get_ffi_type_sint64();

    } else if (returnTypeSymbol == @symbol(long)) {
	if (sizeof(long) == 4) {
	   returnTypeSymbol = @symbol(sint32);
	   __returnType = __get_ffi_type_sint32();
	} else if (sizeof(long) == 8) {
	   returnTypeSymbol = @symbol(sint64);
	   __returnType = __get_ffi_type_sint64();
	} else {
	    __FAIL__(@symbol(UnknownReturnType))
	}

    } else if (returnTypeSymbol == @symbol(ulong)) {
	if (sizeof(long) == 4) {
	   returnTypeSymbol = @symbol(uint32);
	   __returnType = __get_ffi_type_uint32();
	}else if (sizeof(long) == 8) {
	   returnTypeSymbol = @symbol(uint64);
	   __returnType = __get_ffi_type_uint64();
	} else {
	    __FAIL__(@symbol(UnknownReturnType))
	}

    } else if (returnTypeSymbol == @symbol(bool)) {
	__returnType = __get_ffi_type_uint();

    } else if (returnTypeSymbol == @symbol(float)) {
	__returnType = __get_ffi_type_float();
    } else if (returnTypeSymbol == @symbol(double)) {
	__returnType = __get_ffi_type_double();

    } else if (returnTypeSymbol == @symbol(void)) {
	__returnType = __get_ffi_type_void();
	__returnValuePointer = NULL;
    } else if ((returnTypeSymbol == @symbol(pointer))
	       || (returnTypeSymbol == @symbol(handle))
	       || (returnTypeSymbol == @symbol(charPointer))
	       || (returnTypeSymbol == @symbol(bytePointer))
	       || (returnTypeSymbol == @symbol(floatPointer))
	       || (returnTypeSymbol == @symbol(doublePointer))
	       || (returnTypeSymbol == @symbol(intPointer))
	       || (returnTypeSymbol == @symbol(shortPointer))
	       || (returnTypeSymbol == @symbol(wcharPointer))) {
	__returnType = __get_ffi_type_pointer();
    } else {
	if (__isSymbol(returnTypeSymbol)
	 && ((returnValueClass = __GLOBAL_GET(returnTypeSymbol)) != nil)) {
	    if (! __isBehaviorLike(returnValueClass)) {
		__FAIL__(@symbol(NonBehaviorReturnType))
	    }
	    if (! __qIsSubclassOfExternalAddress(returnValueClass)) {
		__FAIL__(@symbol(NonExternalAddressReturnType))
	    }
	    __returnType = __get_ffi_type_pointer();
	    returnTypeSymbol = @symbol(pointer);
	} else {
	    __FAIL__(@symbol(UnknownReturnType))
	}
    }

    /*
     * validate the c++ object
     */
    if (aReceiverOrNil != nil) {
	struct cPlusPlusInstance {
	    void **vTable;
	};
	struct cPlusPlusInstance *inst;

	if (__isExternalAddressLike(aReceiverOrNil)) {
	    inst = (void *)(__externalAddressVal(aReceiverOrNil));
	} else if (__isExternalBytesLike(aReceiverOrNil)) {
	    inst = (void *)(__externalBytesVal(aReceiverOrNil));
	} else {
	    __FAIL__(@symbol(InvalidInstance))
	}
	__argValues[0].pointerVal = inst;
	__argValuePointersIncludingThis[0] = &(__argValues[0]);
	__argTypes[0] = __get_ffi_type_pointer();

	__argValuePointers = &__argValuePointersIncludingThis[1];
	__argTypes = &__argTypesIncludingThis[1];
	__argValues = &__argValuesIncludingThis[1];
	__numArgsIncludingThis = __numArgs + 1;

	if (virtual == true) {
	    if (! __isSmallInteger(vtOffset)) {
		__FAIL__(@symbol(InvalidVTableIndex))
	    }
	    codeAddress = inst->vTable[__intVal(vtOffset)];
# ifdef VERBOSE
	    printf("virtual codeAddress: %x\n", codeAddress);
# endif
	}
    } else {
	__numArgsIncludingThis = __numArgs;
# ifdef VERBOSE
	printf("codeAddress: %x\n", codeAddress);
# endif
    }

    /*
     * validate all arg types and setup arg-buffers
     */
    for (i=0; i<__numArgs; i++) {
	ffi_type *thisType;
	void *argValuePtr;
	OBJ typeSymbol;
	OBJ arg;

	failureInfo = __mkSmallInteger(i+1);   /* in case there is one */

	typeSymbol = __ArrayInstPtr(argTypeSymbols)->a_element[i];
	arg = __ArrayInstPtr(argumentsOrNil)->a_element[i];

	if (typeSymbol == @symbol(handle)) {
	    typeSymbol = @symbol(pointer);
	} else if (typeSymbol == @symbol(voidPointer)) {
	    typeSymbol = @symbol(pointer);
	}

	if (typeSymbol == @symbol(long)) {
	    if (sizeof(long) == sizeof(int)) {
		typeSymbol = @symbol(sint);
	    } else {
		if (sizeof(long) == 4) {
		    typeSymbol = @symbol(sint32);
		} else if (sizeof(long) == 8) {
		    typeSymbol = @symbol(sint64);
		}
	    }
	}
	if (typeSymbol == @symbol(ulong)) {
	    if (sizeof(unsigned long) == sizeof(unsigned int)) {
		typeSymbol = @symbol(uint);
	    } else {
		if (sizeof(long) == 4) {
		    typeSymbol = @symbol(uint32);
		} else if (sizeof(long) == 8) {
		    typeSymbol = @symbol(uint64);
		}
	    }
	}

	if (typeSymbol == @symbol(int) || typeSymbol == @symbol(sint)) {
	    thisType = __get_ffi_type_sint();
	    if (__isSmallInteger(arg)) {
		__argValues[i].iVal = __intVal(arg);
	    } else {
		__argValues[i].iVal = __signedLongIntVal(arg);
		if (__argValues[i].iVal == 0) {
		    __FAIL__(@symbol(InvalidArgument))
		}
	    }
	    argValuePtr = &(__argValues[i].iVal);

	} else if (typeSymbol == @symbol(uint)) {
	    thisType = __get_ffi_type_uint();

	    if (__isSmallInteger(arg)) {
		__argValues[i].iVal = __intVal(arg);
	    } else {
		__argValues[i].iVal = __unsignedLongIntVal(arg);
		if (__argValues[i].iVal == 0) {
		    __FAIL__(@symbol(InvalidArgument))
		}
	    }
	    argValuePtr = &(__argValues[i].iVal);

	} else if (typeSymbol == @symbol(uint8)) {
	    thisType = __get_ffi_type_uint8();
	    if (! __isSmallInteger(arg)) {
		__FAIL__(@symbol(InvalidArgument))
	    }
	    __argValues[i].iVal = __intVal(arg);
	    if (((unsigned)(__argValues[i].iVal)) > 0xFF) {
		__FAIL__(@symbol(InvalidArgument))
	    }
	    argValuePtr = &(__argValues[i].iVal);

	} else if (typeSymbol == @symbol(sint8)) {
	    thisType = __get_ffi_type_sint8();
	    if (! __isSmallInteger(arg)) {
		__FAIL__(@symbol(InvalidArgument))
	    }
	    __argValues[i].iVal = __intVal(arg);
	    if (((__argValues[i].iVal) < -0x80) || ((__argValues[i].iVal) > 0x7F))  {
		__FAIL__(@symbol(InvalidArgument))
	    }
	    argValuePtr = &(__argValues[i].iVal);

	} else if (typeSymbol == @symbol(uint16)) {
	    thisType = __get_ffi_type_uint16();
	    if (! __isSmallInteger(arg)) {
		__FAIL__(@symbol(InvalidArgument))
	    }
	    __argValues[i].iVal = __intVal(arg);
	    if (((unsigned)(__argValues[i].iVal)) > 0xFFFF) {
		__FAIL__(@symbol(InvalidArgument))
	    }
	    argValuePtr = &(__argValues[i].iVal);

	} else if (typeSymbol == @symbol(sint16)) {
	    thisType = __get_ffi_type_sint16();
	    if (! __isSmallInteger(arg)) {
		__FAIL__(@symbol(InvalidArgument))
	    }
	    __argValues[i].iVal = __intVal(arg);
	    if (((__argValues[i].iVal) < -0x8000) || ((__argValues[i].iVal) > 0x7FFF))  {
		__FAIL__(@symbol(InvalidArgument))
	    }
	    argValuePtr = &(__argValues[i].iVal);

	} else if ((typeSymbol == @symbol(uint32)) || (typeSymbol == @symbol(sint32))) {
	    thisType = __get_ffi_type_uint32();
	    if (__isSmallInteger(arg)) {
		__argValues[i].iVal = __intVal(arg);
	    } else {
		__argValues[i].iVal = __unsignedLongIntVal(arg);
		if (__argValues[i].iVal == 0) {
		    __FAIL__(@symbol(InvalidArgument))
		}
	    }
	    argValuePtr = &(__argValues[i].iVal);

	} else if (typeSymbol == @symbol(float)) {
	    thisType = __get_ffi_type_float();
	    if (__isSmallInteger(arg)) {
		__argValues[i].fVal = (float)(__intVal(arg));
	    } else if (__isFloat(arg)) {
		__argValues[i].fVal = (float)(__floatVal(arg));
	    } else if (__isShortFloat(arg)) {
		__argValues[i].fVal = (float)(__shortFloatVal(arg));
	    } else {
		__FAIL__(@symbol(InvalidArgument))
	    }
	    argValuePtr = &(__argValues[i].fVal);

	} else if (typeSymbol == @symbol(double)) {
	    thisType = __get_ffi_type_double();
	    if (__isSmallInteger(arg)) {
		__argValues[i].dVal = (double)(__intVal(arg));
	    } else if (__isFloat(arg)) {
		__argValues[i].dVal = (double)(__floatVal(arg));
	    } else if (__isShortFloat(arg)) {
		__argValues[i].dVal = (double)(__shortFloatVal(arg));
	    } else {
		__FAIL__(@symbol(InvalidArgument))
	    }
	    argValuePtr = &(__argValues[i].dVal);

	} else if (typeSymbol == @symbol(void)) {
	    thisType = __get_ffi_type_void();
	    argValuePtr = &null;

	} else if (typeSymbol == @symbol(charPointer)) {
	    thisType = __get_ffi_type_pointer();
	    if (__isStringLike(arg)) {
		if (async == true) goto badArgForAsyncCall;
		__argValues[i].pointerVal = (void *)(__stringVal(arg));
	    } else if (__isBytes(arg)) {
		if (async == true) goto badArgForAsyncCall;
		__argValues[i].pointerVal = (void *)(__byteArrayVal(arg));
	    } else if (__isExternalAddressLike(arg)) {
		__argValues[i].pointerVal = (void *)(__externalAddressVal(arg));
	    } else if (__isExternalBytesLike(arg)) {
		__argValues[i].pointerVal = (void *)(__externalBytesVal(arg));
	    } else {
		if (arg == nil) {
		    __argValues[i].pointerVal = (void *)0;
		} else {
		    __FAIL__(@symbol(InvalidArgument))
		}
	    }
	    argValuePtr = &(__argValues[i].pointerVal);;

	} else if (typeSymbol == @symbol(wcharPointer)) {
	    thisType = __get_ffi_type_pointer();
	    if (__isUnicode16String(arg)) {
		if (async == true) goto badArgForAsyncCall;
		__argValues[i].pointerVal = (void *)(__unicode16StringVal(arg));
	    } else if (__isBytes(arg)) {
		if (async == true) goto badArgForAsyncCall;
		__argValues[i].pointerVal = (void *)(__byteArrayVal(arg));
	    } else if (__isExternalAddressLike(arg)) {
		__argValues[i].pointerVal = (void *)(__externalAddressVal(arg));
	    } else if (__isExternalBytesLike(arg)) {
		__argValues[i].pointerVal = (void *)(__externalBytesVal(arg));
	    } else {
		if (arg == nil) {
		    __argValues[i].pointerVal = (void *)0;
		} else {
		    __FAIL__(@symbol(InvalidArgument))
		}
	    }
	    argValuePtr = &(__argValues[i].pointerVal);;

	} else if (typeSymbol == @symbol(floatPointer)) {
	    thisType = __get_ffi_type_pointer();
	    if (__isBytes(arg)) {
		if (async == true) goto badArgForAsyncCall;
		__argValues[i].pointerVal = (void *)(__byteArrayVal(arg));
	    } else if (__isExternalAddressLike(arg)) {
		__argValues[i].pointerVal = (void *)(__externalAddressVal(arg));
	    } else if (__isExternalBytesLike(arg)) {
		__argValues[i].pointerVal = (void *)(__externalBytesVal(arg));
	    } else if (__isFloats(arg)) {
		char *p = (char *)(__FloatArrayInstPtr(arg)->f_element);
		int nInstBytes;
		OBJ cls;

		if (async == true) goto badArgForAsyncCall;
		cls = __qClass(arg);
		nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
		p = p + nInstBytes;
		__argValues[i].pointerVal = p;
	    } else {
		if (arg == nil) {
		    __argValues[i].pointerVal = (void *)0;
		} else {
		    __FAIL__(@symbol(InvalidArgument))
		}
	    }
	    argValuePtr = &(__argValues[i].pointerVal);;

	} else if (typeSymbol == @symbol(doublePointer)) {
	    thisType = __get_ffi_type_pointer();
	    if (__isBytes(arg)) {
		if (async == true) goto badArgForAsyncCall;
		__argValues[i].pointerVal = (void *)(__byteArrayVal(arg));
	    } else if (__isExternalAddressLike(arg)) {
		__argValues[i].pointerVal = (void *)(__externalAddressVal(arg));
	    } else if (__isExternalBytesLike(arg)) {
		__argValues[i].pointerVal = (void *)(__externalBytesVal(arg));
	    } else if (__isDoubles(arg)) {
		char *p = (char *)(__DoubleArrayInstPtr(arg)->d_element);
		int nInstBytes;
		OBJ cls;

		if (async == true) goto badArgForAsyncCall;
		cls = __qClass(arg);
		nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
		p = p + nInstBytes;
# ifdef __NEED_DOUBLE_ALIGN
		if ((INT)(__DoubleArrayInstPtr(arg)->d_element) & (__DOUBLE_ALIGN-1)) {
		    int delta = __DOUBLE_ALIGN - ((INT)p & (__DOUBLE_ALIGN-1));

		    p += delta;
		}
# endif
		__argValues[i].pointerVal = p;
	    } else {
		if (arg == nil) {
		    __argValues[i].pointerVal = (void *)0;
		} else {
		    __FAIL__(@symbol(InvalidArgument))
		}
	    }
	    argValuePtr = &(__argValues[i].pointerVal);;

	} else if (typeSymbol == @symbol(pointer)) {
commonPointerTypeArg: ;
	    thisType = __get_ffi_type_pointer();
	    if (arg == nil) {
		__argValues[i].pointerVal = NULL;
	    } else if (__isExternalAddressLike(arg)) {
		__argValues[i].pointerVal = (void *)(__externalAddressVal(arg));
	    } else if (__isExternalBytesLike(arg)) {
		__argValues[i].pointerVal = (void *)(__externalBytesVal(arg));
	    } else if (__isByteArrayLike(arg)) {
		if (async == true) goto badArgForAsyncCall;
		__argValues[i].pointerVal = (void *)(__byteArrayVal(arg));
	    } else if (__isWordArray(arg) || __isSignedWordArray(arg)
		    || __isIntegerArray(arg) || __isSignedIntegerArray(arg)) {
		if (async == true) goto badArgForAsyncCall;
		__argValues[i].pointerVal = (void *)(__integerArrayVal(arg));
	    } else if (__isFloatArray(arg)) {
		if (async == true) goto badArgForAsyncCall;
		__argValues[i].pointerVal = (void *)(__FloatArrayInstPtr(arg)->f_element);
	    } else if (__isDoubleArray(arg)) {
		if (async == true) goto badArgForAsyncCall;
		__argValues[i].pointerVal = (void *)(__DoubleArrayInstPtr(arg)->d_element);
	    } else if (__isStringLike(arg)) {
		if (async == true) {
badArgForAsyncCall: ;
		    __FAIL__(@symbol(BadArgForAsyncCall))
		}
		__argValues[i].pointerVal = (void *)(__stringVal(arg));
	    } else if (__isBytes(arg) || __isWords(arg) || __isLongs(arg)) {
		char *p = (char *)(__byteArrayVal(arg));
		int nInstBytes;
		OBJ cls;

		if (async == true) goto badArgForAsyncCall;
		cls = __qClass(arg);
		nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
		__argValues[i].pointerVal = p + nInstBytes;
	    } else {
		__FAIL__(@symbol(InvalidArgument))
	    }
	    argValuePtr = &(__argValues[i].pointerVal);;

	} else if (typeSymbol == @symbol(bool)) {
	    thisType = __get_ffi_type_uint();

	    if (arg == true) {
		__argValues[i].iVal = 1;
	    } else if (arg == false) {
		__argValues[i].iVal = 0;
	    } else if (__isSmallInteger(arg)) {
		__argValues[i].iVal = __intVal(arg);
	    } else {
		__argValues[i].iVal = __unsignedLongIntVal(arg);
		if (__argValues[i].iVal == 0) {
		    __FAIL__(@symbol(InvalidArgument))
		}
	    }
	    argValuePtr = &(__argValues[i].iVal);
	} else {
	    if (__isSymbol(typeSymbol)
	     && ((argValueClass = __GLOBAL_GET(typeSymbol)) != nil)) {
		if (! __isBehaviorLike(argValueClass)) {
		    __FAIL__(@symbol(NonBehaviorArgumentType))
		}
		if (! __qIsSubclassOfExternalAddress(argValueClass)) {
		    __FAIL__(@symbol(NonExternalAddressArgumentType))
		}
		goto commonPointerTypeArg; /* sorry */
	    } else {
		__FAIL__(@symbol(UnknownArgumentType))
	    }
	}

	__argTypes[i] = thisType;
	__argValuePointers[i] = argValuePtr;

# ifdef VERBOSE
	printf("arg%d: %x\n", i, __argValues[i].iVal);
# endif
    }
    failureInfo = nil;

    __callType = FFI_DEFAULT_ABI;

# ifdef CALLTYPE_FFI_STDCALL
    if (callTypeNumber == @global(CALLTYPE_API)) {
	__callType = CALLTYPE_FFI_STDCALL;
    }
# endif
# ifdef CALLTYPE_FFI_V8
    if (callTypeNumber == @global(CALLTYPE_V8)) {
	__callType = CALLTYPE_FFI_V8;
    }
# endif
# ifdef CALLTYPE_FFI_V9
    if (callTypeNumber == @global(CALLTYPE_V9)) {
	__callType = CALLTYPE_FFI_V9;
    }
# endif
# ifdef CALLTYPE_FFI_UNIX64
    if (callTypeNumber == @global(CALLTYPE_UNIX64)) {
	__callType = CALLTYPE_FFI_UNIX64;
    }
# endif

    if (ffi_prep_cif(&__cif, __callType, __numArgsIncludingThis, __returnType, __argTypesIncludingThis) != FFI_OK) {
	__FAIL__(@symbol(FFIPrepareFailed))
    }
    if (async == true) {
# ifdef VERBOSE
	printf("async call 0x%x\n", codeAddress);
# endif
# ifdef WIN32
	__STX_C_CALL4( "ffi_call", ffi_call, &__cif, codeAddress, __returnValuePointer, __argValuePointersIncludingThis);
# else
	__BEGIN_INTERRUPTABLE__
	ffi_call(&__cif, codeAddress, __returnValuePointer, __argValuePointersIncludingThis);
	__END_INTERRUPTABLE__
# endif
    } else {
	if (unlimitedStack == true) {
# ifdef VERBOSE
	    printf("UNLIMITEDSTACKCALL call 0x%x\n", codeAddress);
# endif
# if 0
	    __UNLIMITEDSTACKCALL__(ffi_call, &__cif, codeAddress, __returnValuePointer, __argValuePointersIncludingThis);
# endif
	} else {
# ifdef VERBOSE
	    printf("call 0x%x\n", codeAddress);
# endif
	    ffi_call(&__cif, codeAddress, __returnValuePointer, __argValuePointersIncludingThis);
	}
    }
# ifdef VERBOSE
    printf("retval is %d (0x%x)\n", __returnValue.iVal, __returnValue.iVal);
# endif
    if ((returnTypeSymbol == @symbol(int))
     || (returnTypeSymbol == @symbol(sint))
     || (returnTypeSymbol == @symbol(sint8))
     || (returnTypeSymbol == @symbol(sint16))
     || (returnTypeSymbol == @symbol(sint32))) {
	RETURN ( __MKINT(__returnValue.iVal) );
    }
    if ((returnTypeSymbol == @symbol(uint))
     || (returnTypeSymbol == @symbol(uint8))
     || (returnTypeSymbol == @symbol(uint16))
     || (returnTypeSymbol == @symbol(uint32))) {
	RETURN ( __MKUINT(__returnValue.iVal) );
    }
    if (returnTypeSymbol == @symbol(bool)) {
	RETURN ( __returnValue.iVal ? true : false );
    }
    if (returnTypeSymbol == @symbol(float)) {
	RETURN ( __MKFLOAT(__returnValue.fVal ));
    }
    if (returnTypeSymbol == @symbol(double)) {
	RETURN ( __MKFLOAT(__returnValue.dVal ));
    }
    if (returnTypeSymbol == @symbol(void)) {
	RETURN ( nil );
    }
    if (returnTypeSymbol == @symbol(char)) {
	RETURN ( __MKCHARACTER(__returnValue.iVal & 0xFF) );
    }
    if (returnTypeSymbol == @symbol(wchar)) {
	RETURN ( __MKUCHARACTER(__returnValue.iVal & 0xFFFF) );
    }
    if (returnTypeSymbol == @symbol(sint64)) {
	RETURN ( __MKINT64(&__returnValue.longLongVal) );
    }
    if (returnTypeSymbol == @symbol(uint64)) {
	RETURN ( __MKUINT64(&__returnValue.longLongVal) );
    }

# ifdef VERBOSE
    printf("%x\n", __returnValue.pointerVal);
# endif
    if (returnTypeSymbol == @symbol(handle)) {
	returnValue = __MKEXTERNALADDRESS(__returnValue.pointerVal);
    } else if (returnTypeSymbol == @symbol(pointer)) {
	returnValue = __MKEXTERNALBYTES(__returnValue.pointerVal);
    } else if (returnTypeSymbol == @symbol(bytePointer)) {
	returnValue = __MKEXTERNALBYTES(__returnValue.pointerVal);
    } else if (returnTypeSymbol == @symbol(charPointer)) {
	returnValue = __MKSTRING(__returnValue.pointerVal);
    } else if (returnTypeSymbol == @symbol(wcharPointer)) {
	returnValue = __MKU16STRING(__returnValue.pointerVal);
    } else {
	__FAIL__(@symbol(UnknownReturnType2))
    }
#else /* no FFI support */
    failureCode = @symbol(FFINotSupported);
#endif /* HAVE_FFI */
getOutOfHere: ;
%}.
    failureCode notNil ifTrue:[
	(failureCode == #UnknownReturnType or:[ failureCode == #UnknownArgumentType ]) ifTrue:[
	    oldReturnType := returnType.
	    oldArgumentTypes := argumentTypes.
	    self adjustTypes.
	    ((oldReturnType ~= returnType) or:[oldArgumentTypes ~= argumentTypes]) ifTrue:[
		thisContext restart
	    ].
	].
	(failureCode == #BadArgForAsyncCall) ifTrue:[
	    ^ self tryAgainWithAsyncSafeArguments:argumentsOrNil forCPPInstance:aReceiverOrNil
	].

	self primitiveFailed.   "see failureCode and failureInfo for details"
	^ nil
    ].

    returnType isSymbol ifTrue:[
	returnValueClass notNil ifTrue:[
	    self isConstReturnValue ifTrue:[
		returnValue changeClassTo:returnValueClass.
		^ returnValue
	    ].
	    ^ returnValueClass fromExternalAddress:returnValue.
	].
    ] ifFalse:[
	returnType isCPointer ifTrue:[
	    returnType baseType isCStruct ifTrue:[
		stClass := Smalltalk classNamed:returnType baseType name.
		stClass notNil ifTrue:[
		    self isConstReturnValue ifTrue:[
			returnValue changeClassTo:returnValueClass.
			^ returnValue
		    ].
		    ^ stClass fromExternalAddress:returnValue.
		].
	    ].
	    returnType baseType isCChar ifTrue:[
		^ returnValue stringAt:1
	    ].
	].
    ].

    ^ returnValue

    "Created: / 01-08-2006 / 13:56:23 / cg"
    "Modified: / 11-06-2007 / 01:50:36 / cg"
!

tryAgainWithAsyncSafeArguments:argumentsOrNil forCPPInstance:aReceiverOrNil
    "invoked by the call primitive, iff GC-unsave arguments where passed to the call.
     Here, allocate non-movable blocks of memory and copy the arguments into them,
     then try the call again, copy changed values back, and release the memeory."

    |saveArguments anyBadArg result originalToSaveArgMapping|

    argumentsOrNil isNil ifTrue:[
	^ self primitiveFailed
    ].
    thisContext isRecursive ifTrue: [^self primitiveFailed].

    anyBadArg := false.
    originalToSaveArgMapping := IdentityDictionary new.

    saveArguments := argumentsOrNil
			collect:[:eachArg |
			    |saveArg|

			    (originalToSaveArgMapping includesKey:eachArg) ifTrue:[
				saveArg := originalToSaveArgMapping at:eachArg
			    ] ifFalse:[
				eachArg isString ifTrue:[
				    saveArg := (ExternalBytes fromString:eachArg) register.
				    anyBadArg := true.
				    originalToSaveArgMapping at:eachArg put:saveArg.
				] ifFalse:[
				    eachArg isByteCollection ifTrue:[
					saveArg := (ExternalBytes from:eachArg) register.
					originalToSaveArgMapping at:eachArg put:saveArg.
					anyBadArg := true.
				    ] ifFalse:[
					saveArg := eachArg
				    ]
				].
			    ].
			    saveArg
			].

    anyBadArg ifFalse:[
	"avoid recursion..."
	^ self primitiveFailed
    ].

    result := self invokeFFIwithArguments:saveArguments forCPPInstance:aReceiverOrNil.

    "/ copy back !!
    originalToSaveArgMapping keysAndValuesDo:[:arg :saveArg |
	arg isSymbol ifFalse:[
	    arg replaceFrom:1 to:(arg size) with:saveArg startingAt:1.
	].
	saveArg free.
    ].
    ^ result.

    "Modified (format): / 06-11-2012 / 10:52:41 / anwild"
! !

!ExternalLibraryFunction methodsFor:'testing'!

isExternalLibraryFunction
    "return true, if the receiver is some kind of externalLibrary function;
     true is returned here"

    ^true

    "Created: / 07-06-2007 / 10:36:40 / cg"
! !

!ExternalLibraryFunction class methodsFor:'documentation'!

version_CVS
    ^ '$Header: /cvs/stx/stx/libbasic/ExternalLibraryFunction.st,v 1.93 2013-01-16 12:20:15 cg Exp $'
!

version_SVN
    ^ '§ Id: ExternalLibraryFunction.st 10643 2011-06-08 21:53:07Z vranyj1  §'
! !

ExternalLibraryFunction initialize!