"
 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 callType returnType argumentTypes'
	classVariableNames:''
	poolDictionaries:''
	category:'System-Support'
!

!ExternalLibraryFunction primitiveDefinitions!
%{

/*
 * does this architecture support FFI ?
 * NOTICE: this is going to be moved to an architecture-specific xxxIntern.h file.
 */
#ifdef WIN32
# define HAVE_FFI
#endif


#ifdef HAVE_FFI
# include <ffi.h>
# define MAX_ARGS    128
#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 callType:callType returnType:returnType argumentTypes:argTypes
    ^ self new
	name:functionName module:moduleName callType:callType
	returnType:returnType argumentTypes:argTypes
! !

!ExternalLibraryFunction class methodsFor:'constants'!

callTypeAPI
    ^ #callTypeAPI
!

callTypeC
    ^ #callTypeC
!

callTypeCDecl
    ^ #callTypeCDecl
!

callTypeOLE
    ^ #callTypeOLE
! !

!ExternalLibraryFunction methodsFor:'accessing'!

argumentTypes
    ^ argumentTypes
! !

!ExternalLibraryFunction methodsFor:'invoking'!

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

invokeVirtualOn:anInstance
    self hasCode ifFalse:[
        self prepareInvoke.
    ].
    ^ self invokeVirtualFFIOn:anInstance withArguments:#()
!

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

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

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

invokeVirtualOn:instance with:arg1 with:arg2 with:arg3 with:arg4
    self hasCode ifFalse:[
        self prepareInvoke.
    ].
    ^ self invokeVirtualFFIOn: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
! !

!ExternalLibraryFunction methodsFor:'printing'!

printOn:aStream
    aStream nextPutAll:'<'.
    callType printOn:aStream.
    aStream nextPutAll:' '.
    name printOn:aStream.
    aStream nextPutAll:' module:'.
    moduleName printOn:aStream.
    aStream nextPutAll:'>'.
! !

!ExternalLibraryFunction methodsFor:'private'!

invokeFFIWithArguments:arguments
    |argTypeSymbols returnTypeSymbol failureCode|

    argumentTypes notNil ifTrue:[
        argTypeSymbols := argumentTypes collect:[:argType | self ffiTypeSymbolForType:argType].
    ].
    returnTypeSymbol := self ffiTypeSymbolForType:returnType.

%{  /* UNLIMITEDSTACK */
#ifdef HAVE_FFI   
    ffi_cif __cif;
    ffi_type *__argTypes[MAX_ARGS];
    ffi_type *__returnType = NULL;
    union u {
        int iVal;
        float fVal;
        double dVal;
        void *pointerVal;
    };
    union u __argValues[MAX_ARGS];
    union u __returnValue;
    void *__argValuePointers[MAX_ARGS];
    void *__returnValuePointer;
    int __numArgs;
    static int null = 0;
    int i;
    ffi_abi __callType = FFI_DEFAULT_ABI;

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

    /*
     * validate the return type
     */
    __returnValuePointer = &__returnValue;
    if (returnTypeSymbol == @symbol(int)) {
        __returnType = __get_ffi_type_sint();
    } else if (returnTypeSymbol == @symbol(uint)) {
        __returnType = __get_ffi_type_uint();
    } else if (returnTypeSymbol == @symbol(long)) {
        if (sizeof(long) == 4) {
           __returnType = __get_ffi_type_sint32();
        } else if (sizeof(long) == 8) {
           __returnType = __get_ffi_type_sint64();
        } else {
            failureCode = @symbol(UnknownReturnType);
            goto error;
        }
    } else if (returnTypeSymbol == @symbol(ulong)) {
        if (sizeof(long) == 4) {
           __returnType = __get_ffi_type_uint32();
        }else if (sizeof(long) == 8) {
           __returnType = __get_ffi_type_uint64();
        } else {
            failureCode = @symbol(UnknownReturnType);
            goto error;
        }
    } else if (returnTypeSymbol == @symbol(boolean)) {
        __returnType = __get_ffi_type_uint();
    } else if (returnTypeSymbol == @symbol(uint8)) {
        __returnType = __get_ffi_type_uint8();
    } else if (returnTypeSymbol == @symbol(sint8)) {
        __returnType = __get_ffi_type_sint8();
    } else if (returnTypeSymbol == @symbol(uint16)) {
        __returnType = __get_ffi_type_uint16();
    } else if (returnTypeSymbol == @symbol(sint16)) {
        __returnType = __get_ffi_type_sint16();
    } 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)) {
        __returnType = __get_ffi_type_pointer();
    } else {
        failureCode = @symbol(UnknownReturnType);
        goto error;
    }

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

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

        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 error;
                }
            }
            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 error;
                }
            }
            argValuePtr = &(__argValues[i].iVal);
        } else if (typeSymbol == @symbol(uint8)) {
            thisType = __get_ffi_type_uint8();
            if (! __isSmallInteger(arg)) {
                failureCode = @symbol(InvalidArgument);
                goto error;
            }
            __argValues[i].iVal = __intVal(arg);
            if (((unsigned)(__argValues[i].iVal)) > 0xFF) {
                failureCode = @symbol(InvalidArgument);
                goto error;
            }
            argValuePtr = &(__argValues[i].iVal);
        } else if (typeSymbol == @symbol(sint8)) {
            thisType = __get_ffi_type_sint8();
            if (! __isSmallInteger(arg)) {
                failureCode = @symbol(InvalidArgument);
                goto error;
            }
            __argValues[i].iVal = __intVal(arg);
            if (((__argValues[i].iVal) < -0x80) || ((__argValues[i].iVal) > 0x7F))  {
                failureCode = @symbol(InvalidArgument);
                goto error;
            }
            argValuePtr = &(__argValues[i].iVal);
        } else if (typeSymbol == @symbol(uint16)) {
            thisType = __get_ffi_type_uint16();
            if (! __isSmallInteger(arg)) {
                failureCode = @symbol(InvalidArgument);
                goto error;
            }
            __argValues[i].iVal = __intVal(arg);
            if (((unsigned)(__argValues[i].iVal)) > 0xFFFF) {
                failureCode = @symbol(InvalidArgument);
                goto error;
            }
            argValuePtr = &(__argValues[i].iVal);
        } else if (typeSymbol == @symbol(sint16)) {
            thisType = __get_ffi_type_sint16();
            if (! __isSmallInteger(arg)) {
                failureCode = @symbol(InvalidArgument);
                goto error;
            }
            __argValues[i].iVal = __intVal(arg);
            if (((__argValues[i].iVal) < -0x8000) || ((__argValues[i].iVal) > 0x7FFF))  {
                failureCode = @symbol(InvalidArgument);
                goto error;
            }
            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 error;
            }
            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 error;
            }
            argValuePtr = &(__argValues[i].dVal);
        } else if (typeSymbol == @symbol(void)) {
            thisType = __get_ffi_type_void();
            argValuePtr = &null;
        } else if (typeSymbol == @symbol(pointer)) {
            thisType = __get_ffi_type_pointer();
            if (__isExternalAddressLike(arg)) {
                __argValues[i].pointerVal = (void *)(__externalAddressVal(arg));
            } else if (__isExternalBytesLike(arg)) {
                __argValues[i].pointerVal = (void *)(__externalBytesVal(arg));
            } else if (__isByteArray(arg)) {
                __argValues[i].pointerVal = (void *)(__byteArrayVal(arg));
            } else if (__isFloatArray(arg)) {
                __argValues[i].pointerVal = (void *)(__FloatArrayInstPtr(arg)->f_element);
            } else if (__isDoubleArray(arg)) {
                __argValues[i].pointerVal = (void *)(__DoubleArrayInstPtr(arg)->d_element);
            } else if (__isString(arg) || __isSymbol(arg)) {
                __argValues[i].pointerVal = (void *)(__stringVal(arg));
            } else {
                failureCode = @symbol(InvalidArgument);
                goto error;
            }
            argValuePtr = &(__argValues[i].pointerVal);;
        } else if (typeSymbol == @symbol(boolean)) {
            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 error;
                }
            }
            argValuePtr = &(__argValues[i].iVal);
        } else {
            failureCode = @symbol(UnknownArgumentType);
            goto error;
        }

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

    __callType = FFI_DEFAULT_ABI;

#ifdef CALLTYPE_FFI_STDCALL
    if ((__INST(callType) == @symbol(callTypeAPI))
     || (__INST(callType) == @symbol(WINAPI))
     || (__INST(callType) == @symbol(STDCALL))) {
        __callType = CALLTYPE_FFI_STDCALL;
    }
#endif
#ifdef CALLTYPE_FFI_V8
    if ((__INST(callType) == @symbol(callTypeV8))
     || (__INST(callType) == @symbol(V8))) {
        __callType = CALLTYPE_FFI_V8;
    }
#endif
#ifdef CALLTYPE_FFI_V9
    if ((__INST(callType) == @symbol(callTypeV9))
     || (__INST(callType) == @symbol(V9))) {
        __callType = CALLTYPE_FFI_V9;
    }
#endif
#ifdef CALLTYPE_FFI_UNIX64
    if ((__INST(callType) == @symbol(callTypeUnix64))
     || (__INST(callType) == @symbol(UNIX64))) {
        __callType = CALLTYPE_FFI_UNIX64;
    }
#endif

    if (ffi_prep_cif(&__cif, __callType, __numArgs, __returnType, __argTypes) != FFI_OK) {
        failureCode = @symbol(FFIPrepareFailed);
        goto error;
    }
    ffi_call(&__cif, (VOIDFUNC)__INST(code_), __returnValuePointer, __argValuePointers);

    if ((returnTypeSymbol == @symbol(int))
     || (returnTypeSymbol == @symbol(int8))
     || (returnTypeSymbol == @symbol(int16))) {
        RETURN ( __MKINT(__returnValue.iVal) );
    }
    if ((returnTypeSymbol == @symbol(uint))
     || (returnTypeSymbol == @symbol(uint8))
     || (returnTypeSymbol == @symbol(uint16))) {
        RETURN ( __MKUINT(__returnValue.iVal) );
    }
    if (returnTypeSymbol == @symbol(boolean)) {
        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(pointer)) {
printf("returnvalue: %x\n", __returnValue.pointerVal);
        RETURN ( __MKEXTERNALADDRESS(__returnValue.pointerVal) );
    }
    failureCode = @symbol(UnknownReturnType2);
error: ;

#else /* no FFI support */
    failureCode = @symbol(FFINotSupported);
#endif /* HAVE_FFI */
%}.
    failureCode notNil ifTrue:[
        self primitiveFailed
    ].
!

invokeVirtualFFIOn:instance withArguments:arguments
    |argTypeSymbols returnTypeSymbol failureCode|

    argumentTypes notNil ifTrue:[
        argTypeSymbols := argumentTypes collect:[:argType | self ffiTypeSymbolForType:argType].
    ].
    returnTypeSymbol := self ffiTypeSymbolForType:returnType.
self halt:'unfinished'.

%{  /* UNLIMITEDSTACK */
#ifdef HAVE_FFI   
    ffi_cif __cif;
    ffi_type *__argTypes[MAX_ARGS];
    ffi_type *__returnType = NULL;
    union u {
        int iVal;
        float fVal;
        double dVal;
        void *pointerVal;
    };
    union u __argValues[MAX_ARGS];
    union u __returnValue;
    void *__argValuePointers[MAX_ARGS];
    void *__returnValuePointer;
    int __numArgs;
    static int null = 0;
    int i;
    ffi_abi __callType = FFI_DEFAULT_ABI;

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

    /*
     * validate the return type
     */
    __returnValuePointer = &__returnValue;
    if (returnTypeSymbol == @symbol(int)) {
        __returnType = __get_ffi_type_sint();
    } else if (returnTypeSymbol == @symbol(uint)) {
        __returnType = __get_ffi_type_uint();
    } else if (returnTypeSymbol == @symbol(long)) {
        if (sizeof(long) == 4) {
           __returnType = __get_ffi_type_sint32();
        } else if (sizeof(long) == 8) {
           __returnType = __get_ffi_type_sint64();
        } else {
            failureCode = @symbol(UnknownReturnType);
            goto error;
        }
    } else if (returnTypeSymbol == @symbol(ulong)) {
        if (sizeof(long) == 4) {
           __returnType = __get_ffi_type_uint32();
        }else if (sizeof(long) == 8) {
           __returnType = __get_ffi_type_uint64();
        } else {
            failureCode = @symbol(UnknownReturnType);
            goto error;
        }
    } else if (returnTypeSymbol == @symbol(boolean)) {
        __returnType = __get_ffi_type_uint();
    } else if (returnTypeSymbol == @symbol(uint8)) {
        __returnType = __get_ffi_type_uint8();
    } else if (returnTypeSymbol == @symbol(sint8)) {
        __returnType = __get_ffi_type_sint8();
    } else if (returnTypeSymbol == @symbol(uint16)) {
        __returnType = __get_ffi_type_uint16();
    } else if (returnTypeSymbol == @symbol(sint16)) {
        __returnType = __get_ffi_type_sint16();
    } 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)) {
        __returnType = __get_ffi_type_pointer();
    } else {
        failureCode = @symbol(UnknownReturnType);
        goto error;
    }

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

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

        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 error;
                }
            }
            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 error;
                }
            }
            argValuePtr = &(__argValues[i].iVal);
        } else if (typeSymbol == @symbol(uint8)) {
            thisType = __get_ffi_type_uint8();
            if (! __isSmallInteger(arg)) {
                failureCode = @symbol(InvalidArgument);
                goto error;
            }
            __argValues[i].iVal = __intVal(arg);
            if (((unsigned)(__argValues[i].iVal)) > 0xFF) {
                failureCode = @symbol(InvalidArgument);
                goto error;
            }
            argValuePtr = &(__argValues[i].iVal);
        } else if (typeSymbol == @symbol(sint8)) {
            thisType = __get_ffi_type_sint8();
            if (! __isSmallInteger(arg)) {
                failureCode = @symbol(InvalidArgument);
                goto error;
            }
            __argValues[i].iVal = __intVal(arg);
            if (((__argValues[i].iVal) < -0x80) || ((__argValues[i].iVal) > 0x7F))  {
                failureCode = @symbol(InvalidArgument);
                goto error;
            }
            argValuePtr = &(__argValues[i].iVal);
        } else if (typeSymbol == @symbol(uint16)) {
            thisType = __get_ffi_type_uint16();
            if (! __isSmallInteger(arg)) {
                failureCode = @symbol(InvalidArgument);
                goto error;
            }
            __argValues[i].iVal = __intVal(arg);
            if (((unsigned)(__argValues[i].iVal)) > 0xFFFF) {
                failureCode = @symbol(InvalidArgument);
                goto error;
            }
            argValuePtr = &(__argValues[i].iVal);
        } else if (typeSymbol == @symbol(sint16)) {
            thisType = __get_ffi_type_sint16();
            if (! __isSmallInteger(arg)) {
                failureCode = @symbol(InvalidArgument);
                goto error;
            }
            __argValues[i].iVal = __intVal(arg);
            if (((__argValues[i].iVal) < -0x8000) || ((__argValues[i].iVal) > 0x7FFF))  {
                failureCode = @symbol(InvalidArgument);
                goto error;
            }
            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 error;
            }
            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 error;
            }
            argValuePtr = &(__argValues[i].dVal);
        } else if (typeSymbol == @symbol(void)) {
            thisType = __get_ffi_type_void();
            argValuePtr = &null;
        } else if (typeSymbol == @symbol(pointer)) {
            thisType = __get_ffi_type_pointer();
            if (__isExternalAddressLike(arg)) {
                __argValues[i].pointerVal = (void *)(__externalAddressVal(arg));
            } else if (__isExternalBytesLike(arg)) {
                __argValues[i].pointerVal = (void *)(__externalBytesVal(arg));
            } else if (__isByteArray(arg)) {
                __argValues[i].pointerVal = (void *)(__byteArrayVal(arg));
            } else if (__isFloatArray(arg)) {
                __argValues[i].pointerVal = (void *)(__FloatArrayInstPtr(arg)->f_element);
            } else if (__isDoubleArray(arg)) {
                __argValues[i].pointerVal = (void *)(__DoubleArrayInstPtr(arg)->d_element);
            } else if (__isString(arg) || __isSymbol(arg)) {
                __argValues[i].pointerVal = (void *)(__stringVal(arg));
            } else {
                failureCode = @symbol(InvalidArgument);
                goto error;
            }
            argValuePtr = &(__argValues[i].pointerVal);;
        } else if (typeSymbol == @symbol(boolean)) {
            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 error;
                }
            }
            argValuePtr = &(__argValues[i].iVal);
        } else {
            failureCode = @symbol(UnknownArgumentType);
            goto error;
        }

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

    __callType = FFI_DEFAULT_ABI;

#ifdef CALLTYPE_FFI_STDCALL
    if ((__INST(callType) == @symbol(callTypeAPI))
     || (__INST(callType) == @symbol(WINAPI))
     || (__INST(callType) == @symbol(STDCALL))) {
        __callType = CALLTYPE_FFI_STDCALL;
    }
#endif
#ifdef CALLTYPE_FFI_V8
    if ((__INST(callType) == @symbol(callTypeV8))
     || (__INST(callType) == @symbol(V8))) {
        __callType = CALLTYPE_FFI_V8;
    }
#endif
#ifdef CALLTYPE_FFI_V9
    if ((__INST(callType) == @symbol(callTypeV9))
     || (__INST(callType) == @symbol(V9))) {
        __callType = CALLTYPE_FFI_V9;
    }
#endif
#ifdef CALLTYPE_FFI_UNIX64
    if ((__INST(callType) == @symbol(callTypeUnix64))
     || (__INST(callType) == @symbol(UNIX64))) {
        __callType = CALLTYPE_FFI_UNIX64;
    }
#endif

    if (ffi_prep_cif(&__cif, __callType, __numArgs, __returnType, __argTypes) != FFI_OK) {
        failureCode = @symbol(FFIPrepareFailed);
        goto error;
    }
    ffi_call(&__cif, (VOIDFUNC)__INST(code_), __returnValuePointer, __argValuePointers);

    if ((returnTypeSymbol == @symbol(int))
     || (returnTypeSymbol == @symbol(int8))
     || (returnTypeSymbol == @symbol(int16))) {
        RETURN ( __MKINT(__returnValue.iVal) );
    }
    if ((returnTypeSymbol == @symbol(uint))
     || (returnTypeSymbol == @symbol(uint8))
     || (returnTypeSymbol == @symbol(uint16))) {
        RETURN ( __MKUINT(__returnValue.iVal) );
    }
    if (returnTypeSymbol == @symbol(boolean)) {
        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(pointer)) {
printf("returnvalue: %x\n", __returnValue.pointerVal);
        RETURN ( __MKEXTERNALADDRESS(__returnValue.pointerVal) );
    }
    failureCode = @symbol(UnknownReturnType2);
error: ;

#else /* no FFI support */
    failureCode = @symbol(FFINotSupported);
#endif /* HAVE_FFI */
%}.
    failureCode notNil ifTrue:[
        self primitiveFailed
    ].
!

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

    |handle|

    moduleName isNil ifTrue:[
        self error:'Missing moduleName'.
    ].
    moduleHandle isNil ifTrue:[
        handle := ObjectFileLoader loadDynamicObject:moduleName.
        handle isNil ifTrue:[
            handle := ObjectFileLoader 
                        loadDynamicObject:(Filename currentDirectory construct:moduleName) pathName.
            handle isNil ifTrue:[
                self error:'Cannot load module: ', moduleName.
            ].
        ].
        moduleHandle := handle.
    ].
    name isNumber ifFalse:[
        (moduleHandle getFunctionAddress:name into:self) isNil ifTrue:[
            self error:'Missing function: ', name, ' in module: ', moduleName.
        ]
    ].
!

prepareInvoke
    self hasCode ifFalse:[
	moduleHandle isNil ifTrue:[
	    self linkToModule.
	].
    ].
! !

!ExternalLibraryFunction methodsFor:'private-accessing'!

ffiTypeSymbolForType:aType
    |t|

    "/ kludge for those who do not have the CType package...
    t := aType.
    t isSymbol ifFalse:[
        aType isString ifFalse:[ 
            CType isNil ifTrue:[
                self error:'unknown type'.
            ].
            t := aType typeSymbol.
        ].
        aType isString ifTrue:[ 
            self halt
        ].
        t isSymbol ifFalse:[
            self error:'unknown type'.
        ].
    ].

    ^ t
!

name:functionName module:aModuleName callType:aCallType returnType:aReturnType argumentTypes:argTypes
    name := functionName.
    moduleName := aModuleName.
    callType := aCallType.
    returnType := aReturnType.
    argumentTypes := argTypes.
! !

!ExternalLibraryFunction class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/ExternalLibraryFunction.st,v 1.17 2006-05-02 22:13:59 cg Exp $'
! !