"{ Encoding: utf8 }"

"

 COPYRIGHT (c) 2007 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' }"

"{ NameSpace: Smalltalk }"

ExternalFunction subclass:#ExternalFunctionCallback

	instanceVariableNames:'returnType argumentTypes flags action'

	classVariableNames:'CallBackRegistry'

	poolDictionaries:''

	category:'System-Support'

!

!ExternalFunctionCallback primitiveDefinitions!

%{

#include <stdlib.h>

#include <stdio.h>

#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

#ifdef __osx__

# define NEW_FFI

#endif

#ifndef NEW_FFI

# define ffi_closure_alloc  malloc

# define ffi_closure_free   free

#endif

%}

! !

!ExternalFunctionCallback primitiveFunctions!

%{

#ifdef HAVE_FFI

#define xxVERBOSE

void

ExternalFunctionCallback__closure_wrapper_fn(ffi_cif* cif, void* resp, void** args, void* userdata)

{

    INT actionIndex = (INT)userdata;

    int i;

    OBJ st_argVector = nil;

    OBJ st_actionVector, st_callBack = nil, st_result;

    OBJFUNC code;

    ffi_type *retType;

    INT sintResult;

    unsigned INT uintResult;

    float floatResult;

    double doubleResult;

    if (@global(ExternalFunctionCallback:Verbose) == true) {

	fprintf(stderr, "ExternalFunctionCallback(wrapper): actionIndex=%"_ld_" resp*=%"_lx_"\n", actionIndex, (INT)resp);

	fflush(stderr);

	fprintf(stderr, "ExternalFunctionCallback(wrapper): nargs=%d\n", cif->nargs);

	fflush(stderr);

    }

    st_argVector = __ARRAY_NEW_INT(cif->nargs);

    for (i=0; i<cif->nargs; i++) {

	ffi_type *argType;

	OBJ st_arg = nil;

	__PROTECT__(st_argVector);

	argType = cif->arg_types[i];

	if (argType == __get_ffi_type_sint()) {

	    st_arg = __MKINT( *(int *)(args[i]) );

	} else if (argType == __get_ffi_type_uint()) {

	    st_arg = __MKUINT( *(unsigned int *)(args[i]) );

	} else if (argType == __get_ffi_type_uint8()) {

	    st_arg = __MKSMALLINT( *(unsigned char *)(args[i]) );

	} else if (argType == __get_ffi_type_sint8()) {

	    st_arg = __MKSMALLINT( *(char *)(args[i]) );

	} else if (argType == __get_ffi_type_uint16()) {

	    st_arg = __MKSMALLINT( *(unsigned short *)(args[i]) );

	} else if (argType == __get_ffi_type_sint16()) {

	    st_arg = __MKSMALLINT( *(short *)(args[i]) );

	} else if (argType == __get_ffi_type_uint32()) {

	    st_arg = __MKUINT( *(unsigned int *)(args[i]) );

	} else if (argType == __get_ffi_type_sint32()) {

	    st_arg = __MKINT( *(int *)(args[i]) );

	} else if (argType == __get_ffi_type_uint64()) {

	    st_arg = __MKUINT( *(long unsigned int *)(args[i]) );

	} else if (argType == __get_ffi_type_sint64()) {

	    st_arg = __MKINT( *(long int *)(args[i]) );

	} else if (argType == __get_ffi_type_float()) {

	    st_arg = __MKSFLOAT( *(float *)(args[i]) );

	} else if (argType == __get_ffi_type_double()) {

	    st_arg = __MKFLOAT( *(double *)(args[i]) );

	} else if (argType == __get_ffi_type_pointer()) {

	    st_arg = __MKEXTERNALADDRESS( *(void **)(args[i]) );

	} else {

	    if (@global(ExternalFunctionCallback:Verbose) == true) {

		fprintf(stderr, "ExternalFunctionCallback(wrapper): invalid argument type %"_lx_" - arg %d\n", (INT)argType, i);

	    }

	}

	__UNPROTECT__(st_argVector);

	if (@global(ExternalFunctionCallback:Verbose) == true) {

	    fprintf(stderr, "ExternalFunctionCallback(wrapper): st-arg for %"_lx_" is %"_lx_"\n", *(unsigned INT *)(args[i]), (INT)st_arg);

	}

	__ArrayInstPtr(st_argVector)->a_element[i] = st_arg; __STORE(st_argVector, st_arg);

    }

    /* the action ... */

    st_actionVector = @global(ExternalFunctionCallback:CallBackRegistry);

    if (st_actionVector != nil) {

	OBJ cls = __Class(st_actionVector);

	if ((cls == Array) || (cls==WeakArray)) {

	    actionIndex += /* nInstVars */ __intVal(__ClassInstPtr(cls)->c_ninstvars);

	    if (__arraySize(st_actionVector) <= actionIndex) {

		st_callBack = __ArrayInstPtr(st_actionVector)->a_element[actionIndex-1];

	    }

	}

    }

    if (st_callBack == nil) {

	if (@global(ExternalFunctionCallback:Verbose) == true) {

	    fprintf(stderr, "ExternalFunctionCallback(wrapper): ignored nil callback\n");

	}

	*(void **)resp = 0;

	return;

    }

    if (@global(ExternalFunctionCallback:Verbose) == true) {

	fprintf(stderr, "ExternalFunctionCallback(wrapper): sending value: to %"_lx_"..\n", (INT)st_callBack);

    }

    {

	static struct inlineCache value_snd = __DUMMYILC1((@line+1));

	st_result = _SEND1(st_callBack, @symbol(callFromCWith:), nil, &value_snd, st_argVector);

    }

    if (@global(ExternalFunctionCallback:Verbose) == true) {

	fprintf(stderr, "ExternalFunctionCallback(wrapper): result is %"_lx_"\n", (INT)st_result);

    }

    retType = cif->rtype;

    if (st_result == true) {

	sintResult = uintResult = 1;

    } else if (st_result == false) {

	sintResult = uintResult = 0;

    } else if (st_result == nil) {

	sintResult = uintResult = 0;

    } else {

	sintResult = __signedLongIntVal(st_result);

	uintResult = __unsignedLongIntVal(st_result);

    }

    if (retType == __get_ffi_type_sint()) {

	*(int *)resp = sintResult;

    } else if (retType == __get_ffi_type_uint()) {

	*(int *)resp = uintResult;

    } else if (retType == __get_ffi_type_uint8()) {

	*(unsigned char *)resp = uintResult;

    } else if (retType == __get_ffi_type_sint8()) {

	*(char *)resp = sintResult;

    } else if (retType == __get_ffi_type_uint16()) {

	*(unsigned short *)resp = uintResult;

    } else if (retType == __get_ffi_type_sint16()) {

	*(short *)resp = sintResult;

    } else if (retType == __get_ffi_type_uint32()) {

	*(int *)resp = uintResult;

    } else if (retType == __get_ffi_type_sint32()) {

	*(int *)resp = sintResult;

    } else if (retType == __get_ffi_type_float()) {

	if (__isFloat(st_result)) {

	    *(float *)resp = (float)__floatVal(st_result);

	} else {

	    if (__isShortFloat(st_result)) {

		*(float *)resp = __shortFloatVal(st_result);

	    } else {

		*(float *)resp = (float)sintResult;

	    }

	}

    } else if (retType == __get_ffi_type_double()) {

	if (__isFloat(st_result)) {

	    *(double *)resp = __floatVal(st_result);

	} else {

	    if (__isShortFloat(st_result)) {

		*(double *)resp = (double)__shortFloatVal(st_result);

	    } else {

		*(double *)resp = (double)sintResult;

	    }

	}

    } else if (retType == __get_ffi_type_pointer()) {

	*(void **)resp = (void *)__externalAddressVal( st_result );

    } else {

	if (@global(ExternalFunctionCallback:Verbose) == true) {

	    fprintf(stderr, "ExternalFunctionCallback(wrapper): invalid result type %"_ld_"\n", (INT)retType);

	}

	*(void **)resp = 0;

    }

}

void

ExternalFunctionCallback__test_call_closure(INTLFUNC f)

{

    INT result = 0;

    printf("doCall_closure: calling closure %"_lx_"(123)...\n", (INT)f);

    result = (*f)(123);

    printf("doCall_closure: back; result is %"_lx_"...\n", (INT)result);

}

#endif /* HAVE_FFI */

%}

! !

!ExternalFunctionCallback class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2007 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

"

    an ExternalFunctionCallback wraps a block into a C-callable function;

    i.e. it creates a closure, which as seen from C-code looks like an ordinary

    function pointer, but when invoked evaluates a smalltalk block.

    A callback is created with:

       cb := ExternalFunctionCallback new.

    the arguments (as passed from the C-caller into ST)

    and the returnValue (from ST to the C-caller) are specified with:

       cb returnType:#bool argumentTypes:#(uint).

    Then, the code is generated with:

       cb generateClosure.

    After that, the callBack-functions address can be acquired with:

       cb address.  'can be passed to C'.

    and handed out to C. (you can also hand out the callBack directly - as it is a subclass of

    ExternalBytes.

    The actual action of the callback can be changed (at any time later) with:

        cb action:[:args | Transcript showCR:args. true].

    Eventually, the callback MUST be released:

        cb release.

    [supported returnTypes:]

        int

        uint

        uint8

        uint16

        uint32

        uint64

        sint

        sint8

        sint16

        sint32

        sint64

        long    system dependent sint32 or sint64

        ulong   system dependent uint32 or uint64

        bool

        float

        double

        void

        pointer, 

        handle, 

        charPointer, 

        bytePointer, 

        floatPointer

        doublePointer

        intPointer

        shortPointer

        wcharPointer

        <name of subclass of ExternalAddress>

    [supported argumentTypes:]

        handle

        pointer

        voidPointer

        long, ulong - system dependent

        int, 

        uint8, sint8, uint16, sint16,

        uint32, sint32,

        float, double

        void

        charPointer, floatPointer, doublePointer,

        <name of subclass of ExternalAddress>

    [author:]

        Claus Gittinger

"

!

examples

"

    |cb|

    cb := ExternalFunctionCallback new.

    cb returnType:#bool argumentTypes:#(uint).

    cb beCallTypeWINAPI.

    cb generateClosure.

    cb action:[:args | Transcript showCR:args. true].

    cb code.  'address can be passed to C'.

    Transcript showCR:cb code.

    ExternalFunctionCallback testCall:cb withArgument:123.

    cb action:[:args | Transcript show:'hello '; showCR:args. true].

    ExternalFunctionCallback testCall:cb withArgument:123.

    cb release

"

! !

!ExternalFunctionCallback class methodsFor:'instance creation'!

callbackFor:aBlock returnType:returnType argumentTypes:argumentTypes

    "generate a callback for the ErrorCallbackProc signature:

	ErrorCallbackProc(HWND hWnd, int nErrID, LPTSTR lpErrorText)

     which, can be given to an external API call and which invokes the

     three arg block when clled.

     Do not forget to eventually release the callback to avoid a memory leak."

    |cb|

    self assert:(aBlock numArgs == argumentTypes size).

    cb := ExternalFunctionCallback new.

    cb returnType:returnType argumentTypes:argumentTypes.

    cb beCallTypeWINAPI.

    cb generateClosure.

    cb action:aBlock.

    "/ ^ cb code.  'can be passed to C'.

    ^ cb

    "

     |cb|

     cb := self errorCallbackProcFor:[:a1 :a2 :a3 | Transcript showCR:('%1 %2 %3' bindWith:a1 with:a2 with:a3)].

     ExternalFunctionCallback testCall:cb withArguments:#(#[1 2 3] 456 'hello').

     cb release

    "

!

errorCallbackProcFor:aThreeArgBlock

    "generate a callback for the ErrorCallbackProc signature:

	ErrorCallbackProc(HWND hWnd, int nErrID, LPTSTR lpErrorText)

     which, can be given to an external API call and which invokes the

     three arg block when clled.

     Do not forget to eventually release the callback to avoid a memory leak."

    ^ self

	callbackFor:aThreeArgBlock

	returnType:#long

	argumentTypes:#(handle int charPointer)

    "

     |cb|

     cb := self errorCallbackProcFor:[:a1 :a2 :a3 | Transcript showCR:('%1 %2 %3' bindWith:a1 with:a2 with:a3)].

     ExternalFunctionCallback testCall:cb withArguments:#(#[1 2 3] 456 'hello').

     cb release

    "

! !

!ExternalFunctionCallback class methodsFor:'constants'!

callTypeAPI

    ^ ExternalLibraryFunction callTypeAPI

!

callTypeC

    ^ ExternalLibraryFunction callTypeC

!

callTypeCDecl

    ^ ExternalLibraryFunction callTypeCDecl

!

callTypeMASK

    ^ ExternalLibraryFunction callTypeMASK

!

callTypeOLE

    ^ ExternalLibraryFunction callTypeOLE

!

callTypeUNIX64

    ^ ExternalLibraryFunction callTypeUNIX64

! !

!ExternalFunctionCallback class methodsFor:'helpers'!

closureIndexFor:aCallBack

    CallBackRegistry isNil ifTrue:[

	CallBackRegistry := WeakArray with:aCallBack.

    ] ifFalse:[

	CallBackRegistry := CallBackRegistry copyWith:aCallBack.

    ].

    ^ CallBackRegistry size.

!

testCall:aCallback withArgument:arg

    "a simple test, if I can be called"