ExternalFunctionCallback.st
author Claus Gittinger <cg@exept.de>
Wed, 13 Jun 2007 23:15:15 +0200
changeset 10610 44dcb48a04c7
parent 10609 fa629d528330
child 10611 0ca921c0a7a1
permissions -rw-r--r--
*** empty log message ***

"
 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' }"

ExternalBytes subclass:#ExternalFunctionCallback
	instanceVariableNames:'returnType argumentTypes action'
	classVariableNames:'CallBackRegistry Verbose'
	poolDictionaries:''
	category:'System-Support'
!

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

%}
! !

!ExternalFunctionCallback primitiveFunctions!
%{

#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=%d resp*=%x\n", actionIndex, 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_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 %d - arg %d\n", argType, i);
	    }
	}

	__UNPROTECT__(st_argVector);

	if (@global(ExternalFunctionCallback:Verbose) == true) {
	    fprintf(stderr, "ExternalFunctionCallback(wrapper): st-arg for %x is %x\n", *(unsigned int *)(args[i]), 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;
    }

    {
	static struct inlineCache value_snd = _DUMMYILC1;

	if (@global(ExternalFunctionCallback:Verbose) == true) {
	    fprintf(stderr, "ExternalFunctionCallback(wrapper): sending value: to %x..\n", st_callBack);
	}
	st_result = _SEND1(st_callBack, @symbol(value:), nil, &value_snd, st_argVector);
	if (@global(ExternalFunctionCallback:Verbose) == true) {
	    fprintf(stderr, "ExternalFunctionCallback(wrapper): result is %x\n", 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 %d\n", retType, i);
	}
	*(void **)resp = 0;
    }
}

void
ExternalFunctionCallback__test_call_closure(INTFUNC f)
{
    int result = 0;

    printf("doCall_closure: calling closure %x(123)...\n", f);
    result = (*f)(123);
    printf("doCall_closure: back; result is %x...\n", result);
}

%}
! !

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

    [author:]
	Claus Gittinger
"
!

examples
"
    |cb|

    cb := ExternalFunctionCallback new.
    cb returnType:#bool argumentTypes:#(uint).
    cb action:[:args | Transcript showCR:args. true].
    cb generateClosure.

    cb address.  'can be passed to C'.

    ExternalFunctionCallback testCall:cb withArgument:123.
    cb release
"
! !

!ExternalFunctionCallback class methodsFor:'helpers'!

closureIndexFor:aCallBack
    CallBackRegistry isNil ifTrue:[
	CallBackRegistry := WeakArray with:aCallBack.
    ] ifFalse:[
	CallBackRegistry := CallBackRegistry copyWith:aCallBack.
    ].
    ^ CallBackRegistry size.
!

testCall:aCallback withArgument:arg
%{
    INTFUNC f = __externalAddressVal(aCallback);
    INT result;

    fprintf(stderr, "ExternalFunctionCallback: calling callBack %x(%d)\n", f, __intVal(arg));
    result = (*f)(__intVal(arg));
    fprintf(stderr, "ExternalFunctionCallback: result from callBack is %x\n", result);
%}
! !

!ExternalFunctionCallback methodsFor:'accessing'!

action:aOneArgBlock
    action := aOneArgBlock.
! !

!ExternalFunctionCallback methodsFor:'callback'!

value:argList
    "because this is evaluated from C, we probably should not block or abort or do
     any other things which confuse C
     (its probably a good idea to write something into a queue here)"

self halt.
    action notNil ifTrue:[
	^ action valueWithArguments:argList
    ].
    ^ nil
! !

!ExternalFunctionCallback methodsFor:'generation'!

address
    self isValid ifFalse:[
	self generate
    ].
    ^ super address

    "Created: / 11-06-2007 / 15:53:00 / cg"
!

generate
    |code|

    code := nil

    "Created: / 11-06-2007 / 14:50:57 / cg"
!

generate0
    |code|

    code := #[
		"/ mov ecx, closureIndex
		16rB9
		    16r00  16r00  16r00  16r01
		"/ mov eax, doClosureC
		16rB8
		    16r00  16r00  16r00  16r02
		"/ call *eax
		16rFF  16rD0
		"/ ret
		16rC3
	    ].

    self allocateBytes:(code size).

    "Created: / 11-06-2007 / 15:29:33 / cg"
! !

!ExternalFunctionCallback methodsFor:'private-accessing'!

returnType:aReturnType argumentTypes:argTypes
    returnType := aReturnType.
    argumentTypes := argTypes.

    "Created: / 11-06-2007 / 15:52:01 / cg"
! !

!ExternalFunctionCallback methodsFor:'private-debugging'!

debugCall:args
    self halt.
    ^ nil
! !

!ExternalFunctionCallback methodsFor:'private-generation'!

generateClosure
    |argTypeSymbols returnTypeSymbol failureCode failureInfo
     callTypeNumber returnValueClass argValueClass callBackIndex|

    argTypeSymbols := argumentTypes.
    returnTypeSymbol := returnType.
    callBackIndex := self class closureIndexFor:self.
%{
#ifdef HAVE_FFI
    ffi_cif *pcif;
    ffi_type *__returnType = NULL;
    static int null = 0;
    int i;
    ffi_abi __callType = FFI_DEFAULT_ABI;
    int __numArgsWanted;
    struct closurePlusCIF {
	ffi_closure closure;
	ffi_cif cif;
	ffi_type *argTypes[MAX_ARGS];
    } *closurePlusCIFp;
    ffi_closure *pcl;
    ffi_cif *cif;
    ffi_type **argTypePtrs;

    closurePlusCIFp = (struct closurePlusCIF *) malloc(sizeof(struct closurePlusCIF));
    cif = &(closurePlusCIFp->cif);
    argTypePtrs = closurePlusCIFp->argTypes;
    pcl = &(closurePlusCIFp->closure);

#define __FAIL__(fcode) \
    { \
	failureCode = fcode; free(closurePlusCIFp); goto getOutOfHere; \
    }

    if (argTypeSymbols == nil) {
	__numArgsWanted = 0;
    } else if (__isArray(argTypeSymbols)) {
	__numArgsWanted = __arraySize(argTypeSymbols);
    } else {
	__FAIL__(@symbol(BadArgumentTypeVector))
    }

    if (__numArgsWanted > MAX_ARGS) {
	__FAIL__(@symbol(TooManyArguments))
    }

    /*
     * validate the return type
     */
    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 {
	    __FAIL__(@symbol(UnknownReturnType))
	}

    } 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 {
	    __FAIL__(@symbol(UnknownReturnType))
	}

    } 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();
    } else if ((returnTypeSymbol == @symbol(pointer))
	       || (returnTypeSymbol == @symbol(handle))
	       || (returnTypeSymbol == @symbol(charPointer))
	       || (returnTypeSymbol == @symbol(bytePointer))
	       || (returnTypeSymbol == @symbol(floatPointer))
	       || (returnTypeSymbol == @symbol(doublePointer))
	       || (returnTypeSymbol == @symbol(intPointer))
	       || (returnTypeSymbol == @symbol(shortPointer))
	       || (returnTypeSymbol == @symbol(wcharPointer))) {
	__returnType = __get_ffi_type_pointer();
    } else {
	if (__isSymbol(returnTypeSymbol)
	 && ((returnValueClass = __GLOBAL_GET(returnTypeSymbol)) != nil)) {
	    if (! __isBehaviorLike(returnValueClass)) {
		__FAIL__(@symbol(NonBehaviorReturnType))
	    }
	    if (! __qIsSubclassOfExternalAddress(returnValueClass)) {
		__FAIL__(@symbol(NonExternalAddressReturnType))
	    }
	    __returnType = __get_ffi_type_pointer();
	    returnTypeSymbol = @symbol(pointer);
	} else {
	    __FAIL__(@symbol(UnknownReturnType))
	}
    }

    /*
     * setup arg-buffers
     */
    for (i=0; i<__numArgsWanted; i++) {
	ffi_type *thisType;
	void *argValuePtr;
	OBJ typeSymbol;

	failureInfo = __mkSmallInteger(i+1);   /* in case there is one */

	typeSymbol = __ArrayInstPtr(argTypeSymbols)->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();
	} else if (typeSymbol == @symbol(uint)) {
	    thisType = __get_ffi_type_uint();
	} else if (typeSymbol == @symbol(uint8)) {
	    thisType = __get_ffi_type_uint8();
	} else if (typeSymbol == @symbol(sint8)) {
	    thisType = __get_ffi_type_sint8();
	} else if (typeSymbol == @symbol(uint16)) {
	    thisType = __get_ffi_type_uint16();
	} else if (typeSymbol == @symbol(sint16)) {
	    thisType = __get_ffi_type_sint16();
	} else if ((typeSymbol == @symbol(uint32)) || (typeSymbol == @symbol(sint32))) {
	    thisType = __get_ffi_type_uint32();
	} else if (typeSymbol == @symbol(float)) {
	    thisType = __get_ffi_type_float();
	} else if (typeSymbol == @symbol(double)) {
	    thisType = __get_ffi_type_double();
	} else if (typeSymbol == @symbol(void)) {
	    thisType = __get_ffi_type_void();
	} else if (typeSymbol == @symbol(charPointer)) {
	    thisType = __get_ffi_type_pointer();
	} else if (typeSymbol == @symbol(floatPointer)) {
	    thisType = __get_ffi_type_pointer();
	} else if (typeSymbol == @symbol(doublePointer)) {
	    thisType = __get_ffi_type_pointer();
	} else if (typeSymbol == @symbol(pointer)) {
commonPointerTypeArg: ;
	    thisType = __get_ffi_type_pointer();
	} else if (typeSymbol == @symbol(bool)) {
	    thisType = __get_ffi_type_uint();
	} else if (__isSymbol(typeSymbol)
	     && ((argValueClass = __GLOBAL_GET(typeSymbol)) != nil)) {
	    if (! __isBehaviorLike(argValueClass)) {
		__FAIL__(@symbol(NonBehaviorArgumentType))
	    }
	    if (! __qIsSubclassOfExternalAddress(argValueClass)) {
		__FAIL__(@symbol(NonExternalAddressArgumentType))
	    }
	    goto commonPointerTypeArg; /* sorry */
	} else {
	    __FAIL__(@symbol(UnknownArgumentType))
	}

	closurePlusCIFp->argTypes[i] = thisType;
    }
    failureInfo = nil;

    __callType = FFI_DEFAULT_ABI;

    if (callTypeNumber != nil) {
#ifdef CALLTYPE_FFI_STDCALL
	if (callTypeNumber == @global(ExternalLibraryFunction:CALLTYPE_API)) {
	    __callType = CALLTYPE_FFI_STDCALL;
	}
#endif
#ifdef CALLTYPE_FFI_V8
	if (callTypeNumber == @global(ExternalLibraryFunction:CALLTYPE_V8)) {
	    __callType = CALLTYPE_FFI_V8;
	}
#endif
#ifdef CALLTYPE_FFI_V9
	if (callTypeNumber == @global(ExternalLibraryFunction:CALLTYPE_V9)) {
	    __callType = CALLTYPE_FFI_V9;
	}
#endif
#ifdef CALLTYPE_FFI_UNIX64
	if (callTypeNumber == @global(ExternalLibraryFunction:CALLTYPE_UNIX64)) {
	    __callType = CALLTYPE_FFI_UNIX64;
	}
#endif
    }

    if (@global(ExternalFunctionCallback:Verbose) == true) {
	printf("prep_cif cif-ptr=%x\n", cif);
    }

    if (ffi_prep_cif(cif, __callType, __numArgsWanted, __returnType, argTypePtrs) != FFI_OK) {
	__FAIL__(@symbol(FFIPrepareFailed))
    }

    if (@global(ExternalFunctionCallback:Verbose) == true) {
	printf("closure is 0x%x (%d bytes)\n", pcl, sizeof(ffi_closure));
	printf("index is %d\n", __intVal(callBackIndex));
    }
    if (ffi_prep_closure(pcl, cif, ExternalFunctionCallback__closure_wrapper_fn, (void *)(__intVal(callBackIndex)) /* userdata */) != FFI_OK) {
	__FAIL__(@symbol(FFIPrepareClosureFailed))
    }
    if (@global(ExternalFunctionCallback:Verbose) == true) {
	printf("pcl->cif is 0x%x\n", pcl->cif);
	printf("pcl->fun is 0x%x\n", pcl->fun);
	printf("pcl code at %x is:\n", pcl);
	printf("  %02x %02x %02x %02x\n", ((unsigned char *)pcl)[0],((unsigned char *)pcl)[1],((unsigned char *)pcl)[2],((unsigned char *)pcl)[3]);
	printf("  %02x %02x %02x %02x\n", ((unsigned char *)pcl)[4],((unsigned char *)pcl)[5],((unsigned char *)pcl)[6],((unsigned char *)pcl)[7]);
	printf("  %02x %02x %02x %02x\n", ((unsigned char *)pcl)[8],((unsigned char *)pcl)[9],((unsigned char *)pcl)[10],((unsigned char *)pcl)[11]);
	printf("  %02x %02x %02x %02x\n", ((unsigned char *)pcl)[12],((unsigned char *)pcl)[13],((unsigned char *)pcl)[14],((unsigned char *)pcl)[15]);
    }
    __INST(address_) = pcl;

#if 0
    ExternalFunctionCallback__test_call_closure((INTFUNC)pcl);
#endif

#else /* no FFI support */
    __FAIL__(@symbol(FFINotSupported));
#endif /* HAVE_FFI */
getOutOfHere: ;
%}.
    failureCode notNil ifTrue:[
	self primitiveFailed:(failureCode->failureInfo).   "see failureCode and failureInfo for details"
	^ nil
    ].

    "Created: / 11-06-2007 / 21:53:02 / cg"
! !

!ExternalFunctionCallback methodsFor:'private-releasing'!

release
    |idx|

    idx := CallBackRegistry identityIndexOf:self.
    CallBackRegistry at:idx put:nil.
%{
    ffi_closure *pcl = (ffi_closure *)__INST(address_);

    __INST(address_) = 0;
    if (pcl) {
	free(pcl);
    }
%}.
    self invalidateReference.

! !

!ExternalFunctionCallback class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libbasic/ExternalFunctionCallback.st,v 1.3 2007-06-13 21:15:15 cg Exp $'
! !