"

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

!

    self hasCode ifFalse:[

        self prepareInvoke.

    ].

!

    self hasCode ifFalse:[

        self prepareInvoke.

    ].

!

    self hasCode ifFalse:[

        self prepareInvoke.

    ].

!

    self hasCode ifFalse:[

        self prepareInvoke.

    ].

!

    self hasCode ifFalse:[

        self prepareInvoke.

    ].

!

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

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 methodsFor:'private-invoking'!

!

    |argTypeSymbols returnTypeSymbol failureCode returnValue stClass vtOffset|

    argumentTypes notNil ifTrue:[

        argTypeSymbols := argumentTypes collect:[:argType | self ffiTypeSymbolForType:argType].

    ].

    returnTypeSymbol := self ffiTypeSymbolForType:returnType.

    aCPlusPlusObjectOrNil notNil ifTrue:[

        "/ it must be a kind of ExternalStructure !!

        (aCPlusPlusObjectOrNil isKindOf:ExternalStructure) ifFalse:[

            self primitiveFailed.

        ].

        ].

    ].

%{  /* UNLIMITEDSTACK */

#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(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 getOutOfHere;

        }

    } 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 getOutOfHere;

        }

    } 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 if (returnTypeSymbol == @symbol(handle)) {

        __returnType = __get_ffi_type_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;

    } else {

        __numArgsIncludingThis = __numArgs;

    }

    /*

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