ExternalFunction.st
branchjv
changeset 19496 7613c0fb5f3c
parent 18011 deb0c3355881
parent 19480 dedfb6c4bc16
child 20579 9add81aadb7a
--- a/ExternalFunction.st	Sat Mar 26 07:56:10 2016 +0000
+++ b/ExternalFunction.st	Tue Mar 29 08:38:24 2016 +0100
@@ -239,7 +239,8 @@
 !ExternalFunction class methodsFor:'calling custom functions'!
 
 callCustomFunction:nr
-    "call the custom function #nr without arguments"
+    "call the custom function #nr without arguments.
+     See main.c for examples."
 
     ^ self callCustomFunction:nr withArguments:#()
 
@@ -252,7 +253,8 @@
 !
 
 callCustomFunction:nr with:arg
-    "call the custom function #nr with a single argument"
+    "call the custom function #nr with a single argument.
+     See main.c for examples."
 
     ^ self callCustomFunction:nr withArguments:(Array with:arg)
 
@@ -264,7 +266,8 @@
 !
 
 callCustomFunction:nr with:arg1 with:arg2
-    "call the custom function #nr with two arguments"
+    "call the custom function #nr with two arguments.
+     See main.c for examples."
 
     ^ self callCustomFunction:nr withArguments:(Array with:arg1 with:arg2)
 
@@ -276,7 +279,8 @@
 !
 
 callCustomFunction:nr with:arg1 with:arg2 with:arg3
-    "call the custom function #nr with three arguments"
+    "call the custom function #nr with three arguments.
+     See main.c for examples."
 
     ^ self callCustomFunction:nr
 		withArguments:(Array with:arg1 with:arg2 with:arg3)
@@ -285,9 +289,10 @@
 !
 
 callCustomFunction:nr withArguments:argArray
-    "call the custom function #nr with arguments from argArray"
+    "call the custom function #nr with arguments from argArray.
+     See main.c for examples."
 
-    |retVal called|
+    |retVal called errCode|
 
 %{
 #ifndef __stxNCustomFunctions__
@@ -312,9 +317,10 @@
 
 		retVal = self;
 		ok = (*func)(nargs, &retVal, __ArrayInstPtr(argArray)->a_element);
-		if (ok) {
+		if (ok == 0) {
 		    RETURN (retVal);
 		}
+		errCode = __mkSmallInteger(ok);
 		called = true;
 	    }
 	}
@@ -322,8 +328,18 @@
 %}.
     called ifTrue:[
 	"
-	 the customFunction returned 0 (failure)
+	 the customFunction returned non-0 (failure)
+	    PRIM_OK         0
+	    PRIM_FAIL       -1
+	    PRIM_ARGCOUNT   -2
+	    PRIM_ARGTYPE    -3
 	"
+	errCode == -2 ifTrue:[
+	    ^ self primitiveFailed:'argument count'
+	].
+	errCode == -3 ifTrue:[
+	    ^ self primitiveFailed:'argument type'
+	].
 	^ self primitiveFailed
     ].
 
@@ -332,7 +348,6 @@
     "
     InvalidCustomFunctionSignal raise
 
-
     "
      ExternalFunction callCustomFunction:2 withArguments:#(1.0 1.0)
      ExternalFunction callCustomFunction:999 withArguments:#(1.0 1.0)
@@ -371,15 +386,15 @@
 #endif
 
     if (__isStringLike(functionName)) {
-        char *nm;
-        int i;
+	char *nm;
+	int i;
 
-        nm = (char *)__stringVal(functionName);
-        for (i=0; i < __stxNCustomFunctions__; i++) {
-           if (strcmp(__stxCustomFunctions__[i].name, nm) == 0) {
-                RETURN (__mkSmallInteger(i));
-           }
-        }
+	nm = (char *)__stringVal(functionName);
+	for (i=0; i < __stxNCustomFunctions__; i++) {
+	   if (strcmp(__stxCustomFunctions__[i].name, nm) == 0) {
+		RETURN (__mkSmallInteger(i));
+	   }
+	}
     }
 %}.
     ^ nil
@@ -972,11 +987,11 @@
 !ExternalFunction class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/ExternalFunction.st,v 1.27 2009-11-05 16:26:28 stefan Exp $'
+    ^ '$Header$'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic/ExternalFunction.st,v 1.27 2009-11-05 16:26:28 stefan Exp $'
+    ^ '$Header$'
 ! !
 
 ExternalFunction initialize!