# HG changeset patch # User Claus Gittinger # Date 1145868556 -7200 # Node ID 734c7c432461b7af4cacc7cc1bf7f6515b3b4e2b # Parent 3915cefea35219a2392a07d93cf42c4f17b2f4a9 not yet finished diff -r 3915cefea352 -r 734c7c432461 ExternalLibraryFunction.st --- a/ExternalLibraryFunction.st Fri Apr 21 17:35:09 2006 +0200 +++ b/ExternalLibraryFunction.st Mon Apr 24 10:49:16 2006 +0200 @@ -44,36 +44,184 @@ 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 - - moduleHandle isNil ifTrue:[ - self linkToModule. - self setupFFI. + self hasCode ifFalse:[ + self prepareInvoke. ]. - - ^ self invokeFFI + ^ self invokeFFIWithArguments:#() ! invokeWith:arg + self hasCode ifFalse:[ + self prepareInvoke. + ]. + ^ self invokeFFIWithArguments:(Array with:arg) +! - moduleHandle isNil ifTrue:[ - self linkToModule. - self setupFFI. +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) +! - ^ self invokeFFI +invokeWith:arg1 with:arg2 with:arg3 with:arg4 + self hasCode ifFalse:[ + self prepareInvoke. + ]. + ^ self invokeFFIWithArguments:(Array with:arg1 with:arg2 with:arg3 with:arg4) +! - " - self new test:'abc' - " +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'! -invokeFFI - "invoke foreign function interface" +invokeFFIWithArguments:arguments + |ffiArgTypes failureCode| + + argumentTypes notNil ifTrue:[ + ffiArgTypes := argumentTypes collect:[:argType | self ffiArgTypeForType:argType]. + ]. +%{ +#if defined(i386) +# ifndef STX_FFI_TYPE_VOID +# define STX_FFI_TYPE_VOID 0 +# define STX_FFI_TYPE_INT 1 +# define STX_FFI_TYPE_FLOAT 2 +# define STX_FFI_TYPE_DOUBLE 3 +# define STX_FFI_TYPE_LONGDOUBLE 4 +# define STX_FFI_TYPE_UINT8 5 +# define STX_FFI_TYPE_SINT8 6 +# define STX_FFI_TYPE_UINT16 7 +# define STX_FFI_TYPE_SINT16 8 +# define STX_FFI_TYPE_UINT32 9 +# define STX_FFI_TYPE_SINT32 10 +# define STX_FFI_TYPE_UINT64 11 +# define STX_FFI_TYPE_SINT64 12 +# define STX_FFI_TYPE_STRUCT 13 +# define STX_FFI_TYPE_POINTER 14 + +# define MAX_NUMARGS 128 +typedef void * ffi_type; +# endif + + void *argValues[MAX_NUMARGS]; + ffi_type *argtypes[MAX_NUMARGS]; + int numArgs; + int i; + + if (arguments == nil) { + numArgs = 0; + if (ffiArgTypes != nil) { + if (! __isArray(ffiArgTypes)) goto error; + if (__arraySize(ffiArgTypes) != numArgs) goto error; + } + } else { + if (! __isArray(arguments)) goto error; + numArgs = __arraySize(arguments); + if (! __isArray(ffiArgTypes)) goto error; + if (__arraySize(ffiArgTypes) != numArgs) goto error; + } + if (numArgs > MAX_NUMARGS) { + failureCode = @symbol(TooManyArguments); + goto error; + } + for (i=0; ia_element[i]) ) { + case STX_FFI_TYPE_VOID: + case STX_FFI_TYPE_INT: + case STX_FFI_TYPE_FLOAT: + case STX_FFI_TYPE_DOUBLE: + case STX_FFI_TYPE_LONGDOUBLE: + case STX_FFI_TYPE_UINT8: + case STX_FFI_TYPE_SINT8: + case STX_FFI_TYPE_UINT16: + case STX_FFI_TYPE_SINT16: + case STX_FFI_TYPE_UINT32: + case STX_FFI_TYPE_SINT32: + case STX_FFI_TYPE_UINT64: + case STX_FFI_TYPE_SINT64: + case STX_FFI_TYPE_STRUCT: + case STX_FFI_TYPE_POINTER: + default: + failureCode = @symbol(UnknownArgumentType); + goto error; + } + } + +#else + 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: ; +%} ! linkToModule @@ -82,25 +230,40 @@ |handle code| - handle := ObjectFileLoader moduleNamed:moduleName. + moduleName isNil ifTrue:[ + self error:'Missing moduleName'. + ]. + + handle := ObjectFileLoader loadDynamicObject:moduleName. handle isNil ifTrue:[ - self error:'cannot load: ', moduleName. + self error:'Cannot load module: ', moduleName. ]. moduleHandle := handle. code := moduleHandle getFunctionAddress:name into:self. code isNil ifTrue:[ - self error:'cannot load function: ', name, ' in module: ', moduleName. + self error:'Missing function: ', name, ' in module: ', moduleName. + ]. +! + +prepareInvoke + self hasCode ifFalse:[ + moduleHandle isNil ifTrue:[ + self linkToModule. + self setupFFI. + ]. ]. ! setupFFI "setup foreign function interface" -" -ffi_prep_cif(&cif, FFI_DEFAULT_ABI, 1, - &ffi_type_uint, args) == FFI_OK - -" +"/ %{ +"/ #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)) != FFI_OK) +"/ #endif +"/ %} ! ! !ExternalLibraryFunction methodsFor:'private-accessing'! @@ -116,5 +279,5 @@ !ExternalLibraryFunction class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libbasic/ExternalLibraryFunction.st,v 1.4 2005-06-21 13:17:59 stefan Exp $' + ^ '$Header: /cvs/stx/stx/libbasic/ExternalLibraryFunction.st,v 1.5 2006-04-24 08:49:16 cg Exp $' ! !