more possible argument types
authorClaus Gittinger <cg@exept.de>
Fri, 12 Jul 1996 23:44:14 +0200
changeset 1545 01e11b46ca65
parent 1544 ed34e792e12d
child 1546 0e91715409d0
more possible argument types
ExtFunc.st
ExternalFunction.st
--- a/ExtFunc.st	Fri Jul 12 21:55:31 1996 +0200
+++ b/ExtFunc.st	Fri Jul 12 23:44:14 1996 +0200
@@ -30,24 +30,76 @@
 convertST_to_C(stObj) 
     OBJ stObj;
 {
+	int flags, nInst;
+	OBJ *oP;
+
 	if (__isString(stObj) || __isSymbol(stObj)) {
 	    return (int)(__stringVal(stObj));
 	}
+	if (__isByteArray(stObj)) {
+	    return (int)(__ByteArrayInstPtr(stObj)->ba_element);
+	}
+	if (__isExternalBytes(stObj)) {
+	    return (int)(__externalBytesAddress(stObj));
+	}
+	if (__isExternalAddress(stObj)) {
+	    return (int)(__externalAddressVal(stObj));
+	}
+	if (__isExternalFunction(stObj)) {
+	    return (int)(__externalFunctionVal(stObj));
+	}
 	if (__isSmallInteger(stObj)) {
 	    return (int)(__intVal(stObj));
 	}
+	if (__isLargeInteger(stObj)) {
+	    return (int)(__signedLongIntVal(stObj));
+	}
 	if (__isCharacter(stObj)) {
 	    return (int)(__intVal(__characterVal(stObj)));
 	}
+	if (stObj == nil) {
+	    return 0;
+	}
+
+	if (__qClass(stObj) == @global(ShortFloat)) {
+	    return (int)(__shortFloatVal(stObj));
+	}
+
+        flags = __intVal(__ClassInstPtr(__qClass(stObj))->c_flags) & ARRAYMASK;
+	nInst = __intVal(__ClassInstPtr(__qClass(stObj))->c_ninstvars);
+	oP = (OBJ *)__InstPtr(stObj)->i_instvars[nInst];
+
+	if (flags & FLOATARRAY) {
+	    return (int)(oP);
+	}
+	if (flags & DOUBLEARRAY) {
+	    return (int)(oP);
+	}
+	if (flags & DOUBLEARRAY) {
+	    return (int)(oP);
+	}
+	if (flags & BYTEARRAY) {
+	    return (int)(oP);
+	}
+	if (flags & WORDARRAY) {
+	    return (int)(oP);
+	}
+	if (flags & LONGARRAY) {
+	    return (int)(oP);
+	}
+	if (flags & SWORDARRAY) {
+	    return (int)(oP);
+	}
+	if (flags & SLONGARRAY) {
+	    return (int)(oP);
+	}
+
 	if (stObj == true) {
 	    return 1;
 	}
 	if (stObj == false) {
 	    return 0;
 	}
-	if (stObj == nil) {
-	    return 0;
-	}
 	return 0;
 }
 
@@ -88,10 +140,41 @@
      in the classes source/object file - while custom functions are 
      external to the classLibraries).
 
-    In the furture, non custom externalFunctions will be created when
-    a non-ST shared library is loaded, and the contained C Functions will
-    be callable via those handles.
-    - however, this is still in construction and NOT yet published for 
+    Non custom externalFunctions are created, when a non-ST shared library is loaded, 
+    and returned by the ObjectFileHandles>>getFunction: method.
+
+    The C functions contained in that lib are callable (instances of myself)
+    with the call / callWith: methods.
+
+    ST-arguments are converted to C as follows:
+	ST class	    C argument
+	------------------------------
+	SmallInteger	    int
+	LargeInteger	    int	(must be 4-byte unsigned largeInteger)
+	String		    char *
+	Symbol		    char *
+	Character	    int
+	ExternalBytes	    char *
+	ExternalAddress	    char *
+	ExternalFunction    char *
+	FloatArray	    float *
+	DoubleArray	    double *
+	ByteArray	    char *
+	ShortFloat	    float
+	true		    1
+	false		    0
+
+    The returned value is converted to an unsigned integer (smallInteger or largeInteger).
+
+    Notice, that no doubles can be passed; the reason is that the calling
+    conventions (on stack, in registers, in FPU registers etc.) are so different among
+    machines (and even compilers), that a general solution is not possible (difficult) 
+    to program here. To pass doubles, either use shortFloats, or pack them into a DoubleArray.
+    For functions with up to 2 double arguments, specialized call methods are provided.
+    Sorry for that inconvenience.
+    
+
+    - This is still in construction and NOT yet published for 
       general use. For now, either use inline C-code, or use the customFunction call
       mechanism.
 
@@ -102,6 +185,24 @@
         ExternalAddress ExternalBytes
         ( how to write primitive code :html: programming/primitive.html )
 "
+!
+
+examples
+"
+    see a sample demo c file in doc/coding/cModules;
+    compile and link (shared) it to an object module.
+    Load it into the system:
+
+	handle := ObjectFileLoader loadDynamicObject:'demo1.o'.
+
+    get a C-function (an instance of ExternalFunction):
+
+	f := handle getFunction:'function1'.
+
+    call it:
+	
+	f callWith:999
+"
 ! !
 
 !ExternalFunction class methodsFor:'initialization'!
@@ -333,9 +434,12 @@
     int retVal;
 
     func = (INTFUNC) __INST(code_);
-    retVal = (*func)();
-    RETURN (__MKINT(retVal));
-%}
+    if (func) {
+        retVal = (*func)();
+        RETURN (__MKINT(retVal));
+    }
+%}.
+    self primitiveFailed
 !
 
 callWith:arg
@@ -354,9 +458,12 @@
     int retVal;
 
     func = (INTFUNC) __INST(code_);
-    retVal = (*func)(convertST_to_C(arg));
-    RETURN (__MKINT(retVal));
-%}
+    if (func) {
+        retVal = (*func)(convertST_to_C(arg));
+        RETURN (__MKINT(retVal));
+    }
+%}.
+    self primitiveFailed
 !
 
 callWithArguments:argArray
@@ -377,7 +484,8 @@
     int retVal;
     OBJ *ap;
 
-    if (__isArray(argArray)) {
+    func = (INTFUNC) __INST(code_);
+    if (func && __isArray(argArray)) {
 	int n = __arraySize(argArray);
 	int i;
 
@@ -387,7 +495,6 @@
 		args[i] = convertST_to_C(*ap++);
 	    }
 	}
-	func = (INTFUNC) __INST(code_);
 	switch (n) {
 	    case 0:
 		retVal = (*func)();
@@ -438,11 +545,84 @@
   err: ;
 %}.
     self primitiveFailed
+!
+
+callWithDouble:aFloatArg returnsDouble:doubleFlag
+    "call the underlying C function, passing a single double argument.
+     The returnsDouble flag specifies if the returnValue is a double; if false,
+     an integer returnValue is assumed."
+%{
+    typedef double  (*DOUBLEFUNC)();
+    INTFUNC func;
+    DOUBLEFUNC dfunc;
+    double arg, dretVal;
+    int retVal;
+
+    func = (INTFUNC) __INST(code_);
+    if (func) {
+        if (__isFloat(aFloatArg)) {
+	    arg = __floatVal(aFloatArg);
+	} else if (__isShortFloat(aFloatArg)) {
+	    arg = (double)(__shortFloatVal(aFloatArg));
+	} else {
+	    arg = (double)(__signedLongIntVal(aFloatArg));
+	}
+	if (doubleFlag == true) {
+	    dfunc = (DOUBLEFUNC)func;
+	    dretVal = (*dfunc)(arg);
+	    RETURN (__MKFLOAT(dretVal));
+	} else {
+	    retVal = (*func)(arg);
+	    RETURN (__MKINT(retVal));
+	}
+    }
+%}.
+    self primitiveFailed
+!
+
+callWithDouble:aFloatArg1 withDouble:aFloatArg2 returnsDouble:doubleFlag
+    "call the underlying C function, passing two double arguments.
+     The returnsDouble flag specifies if the returnValue is a double; if false,
+     an integer returnValue is assumed."
+%{
+    typedef double  (*DOUBLEFUNC)();
+    INTFUNC func;
+    DOUBLEFUNC dfunc;
+    double arg1, arg2, dretVal;
+    int retVal;
+
+    func = (INTFUNC) __INST(code_);
+    if (func) {
+        if (__isFloat(aFloatArg1)) {
+            arg1 = __floatVal(aFloatArg1);
+        } else if (__isShortFloat(aFloatArg1)) {
+            arg1 = (double)(__shortFloatVal(aFloatArg1));
+        } else {
+            arg1 = (double)(__signedLongIntVal(aFloatArg1));
+        }
+        if (__isFloat(aFloatArg2)) {
+            arg2 = __floatVal(aFloatArg2);
+        } else if (__isShortFloat(aFloatArg2)) {
+            arg2 = (double)(__shortFloatVal(aFloatArg2));
+        } else {
+            arg2 = (double)(__signedLongIntVal(aFloatArg2));
+        }
+        if (doubleFlag == true) {
+            dfunc = (DOUBLEFUNC)func;
+            dretVal = (*dfunc)(arg1, arg2);
+            RETURN (__MKFLOAT(dretVal));
+        } else {
+            retVal = (*func)(arg1, arg2);
+            RETURN (__MKINT(retVal));
+        }
+    }
+%}.
+    self primitiveFailed
 ! !
 
 !ExternalFunction class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Attic/ExtFunc.st,v 1.11 1996-07-12 13:51:45 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Attic/ExtFunc.st,v 1.12 1996-07-12 21:44:14 cg Exp $'
 ! !
 ExternalFunction initialize!
--- a/ExternalFunction.st	Fri Jul 12 21:55:31 1996 +0200
+++ b/ExternalFunction.st	Fri Jul 12 23:44:14 1996 +0200
@@ -30,24 +30,76 @@
 convertST_to_C(stObj) 
     OBJ stObj;
 {
+	int flags, nInst;
+	OBJ *oP;
+
 	if (__isString(stObj) || __isSymbol(stObj)) {
 	    return (int)(__stringVal(stObj));
 	}
+	if (__isByteArray(stObj)) {
+	    return (int)(__ByteArrayInstPtr(stObj)->ba_element);
+	}
+	if (__isExternalBytes(stObj)) {
+	    return (int)(__externalBytesAddress(stObj));
+	}
+	if (__isExternalAddress(stObj)) {
+	    return (int)(__externalAddressVal(stObj));
+	}
+	if (__isExternalFunction(stObj)) {
+	    return (int)(__externalFunctionVal(stObj));
+	}
 	if (__isSmallInteger(stObj)) {
 	    return (int)(__intVal(stObj));
 	}
+	if (__isLargeInteger(stObj)) {
+	    return (int)(__signedLongIntVal(stObj));
+	}
 	if (__isCharacter(stObj)) {
 	    return (int)(__intVal(__characterVal(stObj)));
 	}
+	if (stObj == nil) {
+	    return 0;
+	}
+
+	if (__qClass(stObj) == @global(ShortFloat)) {
+	    return (int)(__shortFloatVal(stObj));
+	}
+
+        flags = __intVal(__ClassInstPtr(__qClass(stObj))->c_flags) & ARRAYMASK;
+	nInst = __intVal(__ClassInstPtr(__qClass(stObj))->c_ninstvars);
+	oP = (OBJ *)__InstPtr(stObj)->i_instvars[nInst];
+
+	if (flags & FLOATARRAY) {
+	    return (int)(oP);
+	}
+	if (flags & DOUBLEARRAY) {
+	    return (int)(oP);
+	}
+	if (flags & DOUBLEARRAY) {
+	    return (int)(oP);
+	}
+	if (flags & BYTEARRAY) {
+	    return (int)(oP);
+	}
+	if (flags & WORDARRAY) {
+	    return (int)(oP);
+	}
+	if (flags & LONGARRAY) {
+	    return (int)(oP);
+	}
+	if (flags & SWORDARRAY) {
+	    return (int)(oP);
+	}
+	if (flags & SLONGARRAY) {
+	    return (int)(oP);
+	}
+
 	if (stObj == true) {
 	    return 1;
 	}
 	if (stObj == false) {
 	    return 0;
 	}
-	if (stObj == nil) {
-	    return 0;
-	}
 	return 0;
 }
 
@@ -88,10 +140,41 @@
      in the classes source/object file - while custom functions are 
      external to the classLibraries).
 
-    In the furture, non custom externalFunctions will be created when
-    a non-ST shared library is loaded, and the contained C Functions will
-    be callable via those handles.
-    - however, this is still in construction and NOT yet published for 
+    Non custom externalFunctions are created, when a non-ST shared library is loaded, 
+    and returned by the ObjectFileHandles>>getFunction: method.
+
+    The C functions contained in that lib are callable (instances of myself)
+    with the call / callWith: methods.
+
+    ST-arguments are converted to C as follows:
+	ST class	    C argument
+	------------------------------
+	SmallInteger	    int
+	LargeInteger	    int	(must be 4-byte unsigned largeInteger)
+	String		    char *
+	Symbol		    char *
+	Character	    int
+	ExternalBytes	    char *
+	ExternalAddress	    char *
+	ExternalFunction    char *
+	FloatArray	    float *
+	DoubleArray	    double *
+	ByteArray	    char *
+	ShortFloat	    float
+	true		    1
+	false		    0
+
+    The returned value is converted to an unsigned integer (smallInteger or largeInteger).
+
+    Notice, that no doubles can be passed; the reason is that the calling
+    conventions (on stack, in registers, in FPU registers etc.) are so different among
+    machines (and even compilers), that a general solution is not possible (difficult) 
+    to program here. To pass doubles, either use shortFloats, or pack them into a DoubleArray.
+    For functions with up to 2 double arguments, specialized call methods are provided.
+    Sorry for that inconvenience.
+    
+
+    - This is still in construction and NOT yet published for 
       general use. For now, either use inline C-code, or use the customFunction call
       mechanism.
 
@@ -102,6 +185,24 @@
         ExternalAddress ExternalBytes
         ( how to write primitive code :html: programming/primitive.html )
 "
+!
+
+examples
+"
+    see a sample demo c file in doc/coding/cModules;
+    compile and link (shared) it to an object module.
+    Load it into the system:
+
+	handle := ObjectFileLoader loadDynamicObject:'demo1.o'.
+
+    get a C-function (an instance of ExternalFunction):
+
+	f := handle getFunction:'function1'.
+
+    call it:
+	
+	f callWith:999
+"
 ! !
 
 !ExternalFunction class methodsFor:'initialization'!
@@ -333,9 +434,12 @@
     int retVal;
 
     func = (INTFUNC) __INST(code_);
-    retVal = (*func)();
-    RETURN (__MKINT(retVal));
-%}
+    if (func) {
+        retVal = (*func)();
+        RETURN (__MKINT(retVal));
+    }
+%}.
+    self primitiveFailed
 !
 
 callWith:arg
@@ -354,9 +458,12 @@
     int retVal;
 
     func = (INTFUNC) __INST(code_);
-    retVal = (*func)(convertST_to_C(arg));
-    RETURN (__MKINT(retVal));
-%}
+    if (func) {
+        retVal = (*func)(convertST_to_C(arg));
+        RETURN (__MKINT(retVal));
+    }
+%}.
+    self primitiveFailed
 !
 
 callWithArguments:argArray
@@ -377,7 +484,8 @@
     int retVal;
     OBJ *ap;
 
-    if (__isArray(argArray)) {
+    func = (INTFUNC) __INST(code_);
+    if (func && __isArray(argArray)) {
 	int n = __arraySize(argArray);
 	int i;
 
@@ -387,7 +495,6 @@
 		args[i] = convertST_to_C(*ap++);
 	    }
 	}
-	func = (INTFUNC) __INST(code_);
 	switch (n) {
 	    case 0:
 		retVal = (*func)();
@@ -438,11 +545,84 @@
   err: ;
 %}.
     self primitiveFailed
+!
+
+callWithDouble:aFloatArg returnsDouble:doubleFlag
+    "call the underlying C function, passing a single double argument.
+     The returnsDouble flag specifies if the returnValue is a double; if false,
+     an integer returnValue is assumed."
+%{
+    typedef double  (*DOUBLEFUNC)();
+    INTFUNC func;
+    DOUBLEFUNC dfunc;
+    double arg, dretVal;
+    int retVal;
+
+    func = (INTFUNC) __INST(code_);
+    if (func) {
+        if (__isFloat(aFloatArg)) {
+	    arg = __floatVal(aFloatArg);
+	} else if (__isShortFloat(aFloatArg)) {
+	    arg = (double)(__shortFloatVal(aFloatArg));
+	} else {
+	    arg = (double)(__signedLongIntVal(aFloatArg));
+	}
+	if (doubleFlag == true) {
+	    dfunc = (DOUBLEFUNC)func;
+	    dretVal = (*dfunc)(arg);
+	    RETURN (__MKFLOAT(dretVal));
+	} else {
+	    retVal = (*func)(arg);
+	    RETURN (__MKINT(retVal));
+	}
+    }
+%}.
+    self primitiveFailed
+!
+
+callWithDouble:aFloatArg1 withDouble:aFloatArg2 returnsDouble:doubleFlag
+    "call the underlying C function, passing two double arguments.
+     The returnsDouble flag specifies if the returnValue is a double; if false,
+     an integer returnValue is assumed."
+%{
+    typedef double  (*DOUBLEFUNC)();
+    INTFUNC func;
+    DOUBLEFUNC dfunc;
+    double arg1, arg2, dretVal;
+    int retVal;
+
+    func = (INTFUNC) __INST(code_);
+    if (func) {
+        if (__isFloat(aFloatArg1)) {
+            arg1 = __floatVal(aFloatArg1);
+        } else if (__isShortFloat(aFloatArg1)) {
+            arg1 = (double)(__shortFloatVal(aFloatArg1));
+        } else {
+            arg1 = (double)(__signedLongIntVal(aFloatArg1));
+        }
+        if (__isFloat(aFloatArg2)) {
+            arg2 = __floatVal(aFloatArg2);
+        } else if (__isShortFloat(aFloatArg2)) {
+            arg2 = (double)(__shortFloatVal(aFloatArg2));
+        } else {
+            arg2 = (double)(__signedLongIntVal(aFloatArg2));
+        }
+        if (doubleFlag == true) {
+            dfunc = (DOUBLEFUNC)func;
+            dretVal = (*dfunc)(arg1, arg2);
+            RETURN (__MKFLOAT(dretVal));
+        } else {
+            retVal = (*func)(arg1, arg2);
+            RETURN (__MKINT(retVal));
+        }
+    }
+%}.
+    self primitiveFailed
 ! !
 
 !ExternalFunction class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/ExternalFunction.st,v 1.11 1996-07-12 13:51:45 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/ExternalFunction.st,v 1.12 1996-07-12 21:44:14 cg Exp $'
 ! !
 ExternalFunction initialize!