"

 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!

%{

# include <ffi.h>

# define MAX_ARGS    128

%}

! !

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

"

!

example

"

        |f|

        f := ExternalLibraryFunction new.

        f name:'MessageBeep'

          module:'user32.dll'

          callType:#WINAPI

          returnType:#boolean

          argumentTypes:#(uint).

        f invokeWith:1.

"

! !

!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:#()

!

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.

%{  /* STACK: 32000 */

    ffi_cif __cif;

    ffi_type *__argTypes[MAX_ARGS];

    union {

        int iVal;

    } __argValues[MAX_ARGS];

    void *__argValuePointers[MAX_ARGS];

    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;

    }

        ffi_type *thisType;

        void *argValuePtr;

        OBJ typeSymbol;

        OBJ arg;

        if (typeSymbol == @symbol(int)) {

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

            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(void)) {

            argValuePtr = &null;

        } else if (typeSymbol == @symbol(boolean)) {

            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 {

            goto error;

        }

    }

    if (__INST(callType) == @symbol(callTypeC)) {

        __callType = FFI_DEFAULT_ABI;

#ifdef WIN32

    } else if (__INST(callType) == @symbol(callTypeAPI)) {

        __callType = FFI_STDCALL;

    } else if (__INST(callType) == @symbol(WINAPI)) {

        __callType = FFI_STDCALL;

#endif /* WIN32 */

    } else if (__INST(callType) == @symbol(callTypeCDecl)) {

        __callType = FFI_DEFAULT_ABI;

    } else {

        failureCode = @symbol(UnknownCallType);

        goto error;

    }

    if (ffi_prep_cif(&__cif, __callType, __numArgs, __returnType, __argTypes) != FFI_OK) {

        failureCode = @symbol(FFIPrepareFailed);

        goto error;

    }

# if 0

    /* Initialize the cif */

    CHECK(ffi_prep_cif(&cif, FFI_DEFAULT_ABI, 1,

                       &ffi_type_sint64, args) == FFI_OK);

    argtypes = (ffi_type **)C_alloca(sizeof(ffi_type *) * (n + 3));

    argvalues = (void **)C_alloca(sizeof(void *) * (n + 3));

    argtypes[ 0 ] = &ffi_type_pointer;

    argtypes[ 1 ] = &ffi_type_pointer;

    argtypes[ 2 ] = &ffi_type_pointer;

    c = n + 2;

    argvalues[ 0 ] = &c;

    argvalues[ 1 ] = &fn;

    argvalues[ 2 ] = &k;

    for(i = 0; i < n; ++i) {

      argtypes[ i + 3 ] = &ffi_type_pointer;

      argvalues[ i + 3 ] = C_temporary_stack_bottom - (i + 1);

    }

    C_temporary_stack = C_temporary_stack_bottom;

    status = ffi_prep_cif(&cif, FFI_DEFAULT_ABI, n + 3, &ffi_type_void, argtypes);

    assert(status == FFI_OK);

    ffi_call(&cif, (void *)C_block_item(fn, 0), NULL, argvalues);

# endif

error: ;

%}.

    failureCode notNil ifTrue:[

        self primitiveFailed

    ].

!

linkToModule

    "link this function to the external module.

     I.e. retrieve the module handle and the code pointer."

    |handle code|

    moduleName isNil ifTrue:[

	self error:'Missing moduleName'.

    ].

    handle := ObjectFileLoader loadDynamicObject:moduleName.

    handle isNil ifTrue:[

	self error:'Cannot load module: ', moduleName.

    ].

    moduleHandle := handle.

    code := moduleHandle getFunctionAddress:name into:self.

    code isNil ifTrue:[

	self error:'Missing function: ', name, ' in module: ', moduleName.

    ].

!

prepareInvoke

    self hasCode ifFalse:[

	moduleHandle isNil ifTrue:[

	    self linkToModule.

	    self setupFFI.

	].

    ].

!

setupFFI

    "setup foreign function interface"

"/    %{

"/    #if defined(WIN32) && defined(i386)

"/        /* Have special code for this case - no need to use of ffi code. */

"/    #else

"/        if (ffi_prep_cif(&cif, FFI_DEFAULT_ABI, 1, &ffi_type_uint, args)) 

! !

!ExternalLibraryFunction methodsFor:'private-accessing'!

ffiTypeSymbolForType:aType

    "/ kludge for those who do not have the CType package...

    aType isSymbol ifTrue:[ ^ aType ].

    CType isNil ifTrue:[

        self error:'unknown type'.

    ].

    ^ aType typeSymbol

!

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

! !