ExternalLibraryFunction.st
author Claus Gittinger <cg@exept.de>
Tue, 07 Nov 2006 14:00:21 +0100
changeset 10156 d35f30a7fde5
parent 10025 053904a63549
child 10213 31717eee6fb2
permissions -rw-r--r--
changed #who

"
 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:'FLAG_VIRTUAL FLAG_NONVIRTUAL FLAG_ASYNC FLAG_UNLIMITEDSTACK
		FLAG_RETVAL_IS_CONST CALLTYPE_MASK CALLTYPE_API CALLTYPE_C
		CALLTYPE_OLE CALLTYPE_V8 CALLTYPE_V9 CALLTYPE_UNIX64'
	poolDictionaries:''
	category:'System-Support'
!

!ExternalLibraryFunction primitiveDefinitions!
%{

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

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

%}
! !

!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).
    When a special external-call pragma such as:
	<api: bool MessageBeep(uint)>

    is encountered by the parser in a method, 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.
"
!

example
"
								[exBegin]
	|f|

	f := ExternalLibraryFunction new.
	f name:'MessageBeep'
	  module:'user32.dll'
	  callType:#WINAPI
	  returnType:#boolean
	  argumentTypes:#(uint).

	f invokeWith:1.
								[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'!

initialize
    "using inline access to corresponding c--defines to avoid duplicate places of knowledge"
    FLAG_VIRTUAL := %{ __MKSMALLINT(__EXTL_FLAG_VIRTUAL) %}.                "/ a virtual c++ call
    FLAG_NONVIRTUAL := %{ __MKSMALLINT(__EXTL_FLAG_NONVIRTUAL) %}.          "/ a non-virtual c++ call
    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"
! !

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

callTypeOLE
    ^ CALLTYPE_OLE

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

!ExternalLibraryFunction methodsFor:'accessing'!

argumentTypes
    ^ argumentTypes
!

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

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

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

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

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

!ExternalLibraryFunction methodsFor:'invoking'!

invoke
    self hasCode ifFalse:[
	self prepareInvoke.
    ].
    ^ self invokeFFIWithArguments:#()
!

invokeCPPVirtualOn:anInstance
    self hasCode ifFalse:[
	self prepareInvoke.
    ].
    ^ self invokeCPPVirtualFFIOn:anInstance withArguments:#()
!

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

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:[
	'C:' printOn:aStream.
    ].
    aStream nextPutAll:' '.
    name printOn:aStream.
    moduleName notNil ifTrue:[
	aStream nextPutAll:' module:'.
	moduleName printOn:aStream.
    ].
    aStream nextPutAll:'>'.

    "Modified: / 01-08-2006 / 15:21:42 / cg"
! !

!ExternalLibraryFunction methodsFor:'private'!

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

    |handle moduleNameUsed functionName|

    (moduleNameUsed := moduleName) isNil ifTrue:[
	owningClass isNil ifTrue:[
	    self error:'Missing moduleName'.
	].
	moduleNameUsed := owningClass theNonMetaclass libraryName asSymbol.
    ].
    moduleHandle isNil ifTrue:[
	handle := ObjectFileLoader loadDynamicObject:(moduleNameUsed asString).
	handle isNil ifTrue:[
	    handle := ObjectFileLoader
			loadDynamicObject:(Filename currentDirectory construct:moduleNameUsed) pathName.
	    handle isNil ifTrue:[
		self error:'Cannot load module: ', 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: / 01-08-2006 / 16:24:14 / cg"
!

prepareInvoke
    moduleHandle isNil ifTrue:[
	self linkToModule.
	self adjustTypes.
    ].
!

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

!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 handle
    "

    |t|

    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 == #int8            ifTrue:[^ #sint8 ].
    aType == #int16           ifTrue:[^ #sint16 ].
    aType == #int32           ifTrue:[^ #sint32 ].
    aType == #int64           ifTrue:[^ #sint64 ].
    aType == #voidPointer     ifTrue:[^ #pointer ].

    aType == #short           ifTrue:[^ #int16 ].
    aType == #long            ifTrue:[^ #int32 ].     "/ TODO - care for 64bit machines
    aType == #int             ifTrue:[^ #int32 ].     "/ TODO - care for 64bit machines
    aType == #ushort          ifTrue:[^ #uint16 ].
    aType == #unsignedShort   ifTrue:[^ #uint16 ].
    aType == #ulong           ifTrue:[^ #uint32 ].    "/ TODO - care for 64bit machines
    aType == #unsignedLong    ifTrue:[^ #uint32 ].    "/ TODO - care for 64bit machines
    aType == #uchar           ifTrue:[^ #uint8 ].
    aType == #unsignedChar    ifTrue:[^ #uint8 ].
    aType == #byte            ifTrue:[^ #uint8 ].
    aType == #dword           ifTrue:[^ #uint32 ].
    aType == #sdword          ifTrue:[^ #int32 ].
    aType == #word            ifTrue:[^ #uint16 ].
    aType == #sword           ifTrue:[^ #int16 ].
    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 isString or:[aType isSymbol]) ifFalse:[
	CType isNil ifTrue:[
	    self error:'unknown type'.
	].
	^ aType typeSymbol.
    ].

    ^ aType
!

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:aClass
    owningClass := aClass.

    "Created: / 01-08-2006 / 15:22:50 / 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:arguments forCPPInstance:aCPlusPlusObjectOrNil
    |argTypeSymbols returnTypeSymbol failureCode failureInfo returnValue stClass vtOffset
     virtual async unlimitedStack callTypeNumber returnValueClass argValueClass|

    argTypeSymbols := argumentTypes.
    returnTypeSymbol := returnType.

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

	"/ and it must be a kind of ExternalStructure !!
	(aCPlusPlusObjectOrNil isKindOf:ExternalStructure) ifFalse:[
	    self primitiveFailed.
	].
	virtual ifTrue:[
	    vtOffset := name.
	    (vtOffset between:0 and:10000) ifFalse:[
		self primitiveFailed.
	    ]
	].
    ] ifFalse:[
	aCPlusPlusObjectOrNil notNil ifTrue:[
	    "/ must NOT have a c++ object instance
	    self primitiveFailed.
	].
    ].
    async := self isAsync.
    unlimitedStack := self isUnlimitedStack.
    callTypeNumber := self callTypeNumber.

%{  /* STACK: 100000 */
#ifdef HAVE_FFI
    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;
    };
    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_);

    if (arguments == nil) {
	__numArgs = 0;
	if (argTypeSymbols != nil) {
	    if (! __isArray(argTypeSymbols)
	     || (__arraySize(argTypeSymbols) != __numArgs)) {
		failureCode = @symbol(ArgumentCountMismatch);
		goto getOutOfHere;
	    }
	}
    } else {
	if (! __isArray(arguments)
	 || ! __isArray(argTypeSymbols)
	 || (__arraySize(argTypeSymbols) != (__numArgs = __arraySize(arguments)))) {
	    failureCode = @symbol(ArgumentCountMismatch);
	    goto getOutOfHere;
	}
    }
    if (__numArgs > MAX_ARGS) {
	failureCode = @symbol(TooManyArguments);
	goto getOutOfHere;
    }

    /*
     * 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 {
	    failureCode = @symbol(UnknownReturnType);
	    goto getOutOfHere;
	}

    } 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 {
	    failureCode = @symbol(UnknownReturnType);
	    goto getOutOfHere;
	}

    } 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))) {
	__returnType = __get_ffi_type_pointer();
    } else if (returnTypeSymbol == @symbol(charPointer)) {
	__returnType = __get_ffi_type_pointer();
    } else if (returnTypeSymbol == @symbol(wcharPointer)) {
	__returnType = __get_ffi_type_pointer();
    } else {
	if (__isSymbol(returnTypeSymbol)
	 && ((returnValueClass = __GLOBAL_GET(returnTypeSymbol)) != nil)) {
	    if (! __isBehaviorLike(returnValueClass)) {
		failureCode = @symbol(NonBehaviorReturnType);
		goto getOutOfHere;
	    }
	    if (! __qIsSubclassOfExternalAddress(returnValueClass)) {
		failureCode = @symbol(NonExternalAddressReturnType);
		goto getOutOfHere;
	    }
	    __returnType = __get_ffi_type_pointer();
	    returnTypeSymbol = @symbol(pointer);
	} else {
	    failureCode = @symbol(UnknownReturnType);
	    goto getOutOfHere;
	}
    }

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

	if (__isExternalAddressLike(aCPlusPlusObjectOrNil)) {
	    inst = (void *)(__externalAddressVal(aCPlusPlusObjectOrNil));
	} else if (__isExternalBytesLike(aCPlusPlusObjectOrNil)) {
	    inst = (void *)(__externalBytesVal(aCPlusPlusObjectOrNil));
	} else {
	    failureCode = @symbol(InvalidInstance);
	    goto getOutOfHere;
	}
	__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)) {
		failureCode = @symbol(InvalidVTableIndex);
		goto getOutOfHere;
	    }
	    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(arguments)->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)) {
	    thisType = __get_ffi_type_sint();
	    if (__isSmallInteger(arg)) {
		__argValues[i].iVal = __intVal(arg);
	    } else {
		__argValues[i].iVal = __signedLongIntVal(arg);
		if (__argValues[i].iVal == 0) {
		    failureCode = @symbol(InvalidArgument);
		    goto getOutOfHere;
		}
	    }
	    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) {
		    failureCode = @symbol(InvalidArgument);
		    goto getOutOfHere;
		}
	    }
	    argValuePtr = &(__argValues[i].iVal);

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

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

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

	} else if (typeSymbol == @symbol(sint16)) {
	    thisType = __get_ffi_type_sint16();
	    if (! __isSmallInteger(arg)) {
		failureCode = @symbol(InvalidArgument);
		goto getOutOfHere;
	    }
	    __argValues[i].iVal = __intVal(arg);
	    if (((__argValues[i].iVal) < -0x8000) || ((__argValues[i].iVal) > 0x7FFF))  {
		failureCode = @symbol(InvalidArgument);
		goto getOutOfHere;
	    }
	    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) {
		    failureCode = @symbol(InvalidArgument);
		    goto getOutOfHere;
		}
	    }
	    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 {
		failureCode = @symbol(InvalidArgument);
		goto getOutOfHere;
	    }
	    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 {
		failureCode = @symbol(InvalidArgument);
		goto getOutOfHere;
	    }
	    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 (__isString(arg) || __isSymbol(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 (arg == nil) {
			__argValues[i].pointerVal = (void *)0;
		    } else {
			failureCode = @symbol(InvalidArgument);
			goto getOutOfHere;
		    }
		}
	    }
	    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 (__isByteArray(arg)) {
		if (async == true) goto badArgForAsyncCall;
		__argValues[i].pointerVal = (void *)(__byteArrayVal(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 (__isString(arg) || __isSymbol(arg)) {
		if (async == true) {
badArgForAsyncCall: ;
		    failureCode = @symbol(BadArgForAsyncCall);
		    goto getOutOfHere;
		}
		__argValues[i].pointerVal = (void *)(__stringVal(arg));
	    } else if (__isBytes(arg)) {
		char *p = (char *)(__byteArrayVal(arg));
		int nInstBytes;
		OBJ cls;

		cls = __qClass(arg);
		nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
		__argValues[i].pointerVal = p + nInstBytes;
	    } else {
		failureCode = @symbol(InvalidArgument);
		goto getOutOfHere;
	    }
	    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) {
		    failureCode = @symbol(InvalidArgument);
		    goto getOutOfHere;
		}
	    }
	    argValuePtr = &(__argValues[i].iVal);
	} else {
	    if (__isSymbol(typeSymbol)
	     && ((argValueClass = __GLOBAL_GET(typeSymbol)) != nil)) {
		if (! __isBehaviorLike(argValueClass)) {
		    failureCode = @symbol(NonBehaviorArgumentType);
		    goto getOutOfHere;
		}
		if (! __qIsSubclassOfExternalAddress(argValueClass)) {
		    failureCode = @symbol(NonExternalAddressArgumentType);
		    goto getOutOfHere;
		}
		goto commonPointerTypeArg; /* sorry */
	    } else {
		failureCode = @symbol(UnknownArgumentType);
		goto getOutOfHere;
	    }
	}

	__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) {
	failureCode = @symbol(FFIPrepareFailed);
	goto getOutOfHere;
    }
    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(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(handle)) {
	returnValue = __MKEXTERNALADDRESS(__returnValue.pointerVal);
    } else if (returnTypeSymbol == @symbol(pointer)) {
	returnValue = __MKEXTERNALBYTES(__returnValue.pointerVal);
    } else if (returnTypeSymbol == @symbol(charPointer)) {
	returnValue = __MKSTRING(__returnValue.pointerVal);
    } else if (returnTypeSymbol == @symbol(wcharPointer)) {
	returnValue = __MKU16STRING(__returnValue.pointerVal);
    } else {
	failureCode = @symbol(UnknownReturnType2);
    }
getOutOfHere: ;

#else /* no FFI support */
    failureCode = @symbol(FFINotSupported);
#endif /* HAVE_FFI */
%}.
    failureCode notNil ifTrue:[
	self primitiveFailed.
	^ 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: / 01-08-2006 / 15:59:44 / cg"
! !

!ExternalLibraryFunction class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/ExternalLibraryFunction.st,v 1.45 2006-10-04 09:10:37 cg Exp $'
! !

ExternalLibraryFunction initialize!