not yet finished
authorClaus Gittinger <cg@exept.de>
Mon, 24 Apr 2006 10:49:16 +0200
changeset 9321 734c7c432461
parent 9320 3915cefea352
child 9322 41c391bfbf03
not yet finished
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; i<numArgs; i++) {
+        switch (__intVal( __ArrayInstPtr(ffiArgTypes)->a_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 $'
 ! !