diff src/eval.c @ 74:54cc21c15cbb r20-0b32

Import from CVS: tag r20-0b32
author cvs
date Mon, 13 Aug 2007 09:04:33 +0200
parents 131b0175ea99
children 1040fe1366ac
line wrap: on
line diff
--- a/src/eval.c	Mon Aug 13 09:03:47 2007 +0200
+++ b/src/eval.c	Mon Aug 13 09:04:33 2007 +0200
@@ -218,7 +218,7 @@
 /* Used for error catching purposes by throw_or_bomb_out */
 static int throw_level;
 
-static Lisp_Object primitive_funcall (Lisp_Object (*fn) (), int nargs,
+static Lisp_Object primitive_funcall (lisp_fn_t fn, int nargs,
 				      Lisp_Object args[]);
 
 
@@ -2054,9 +2054,8 @@
 call_with_suspended_errors_1 (Lisp_Object opaque_arg)
 {
   Lisp_Object *kludgy_args = (Lisp_Object *) get_opaque_ptr (opaque_arg);
-  return (primitive_funcall
-	  ((Lisp_Object (*)()) get_opaque_ptr (kludgy_args[0]),
-	   XINT (kludgy_args[1]), kludgy_args + 2));
+  return (primitive_funcall ((lisp_fn_t) get_opaque_ptr (kludgy_args[0]),
+			     XINT (kludgy_args[1]), kludgy_args + 2));
 }
 
 static Lisp_Object
@@ -2089,7 +2088,7 @@
 */
 
 Lisp_Object
-call_with_suspended_errors (Lisp_Object (*fun)(), Lisp_Object retval,
+call_with_suspended_errors (lisp_fn_t fun, Lisp_Object retval,
 			    Lisp_Object class, Error_behavior errb,
 			    int nargs, ...)
 {
@@ -2981,7 +2980,8 @@
 	  backtrace.args = vals;
 	  backtrace.nargs = nargs;
 
-	  val = ((subr_function (subr)) (nargs, vals));
+	  val = ((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr)))
+	    (nargs, vals);
 
           /* Have to duplicate this code because if the
            *  debugger is called it must be in a scope in
@@ -3154,7 +3154,8 @@
 
       if (max_args == MANY)
 	{
-	  val = ((subr_function (subr)) (nargs, args + 1));
+	  val = ((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr)))
+	    (nargs, args + 1);
 	}
 
       else if (max_args > nargs)
@@ -3431,50 +3432,47 @@
 }
 
 
+/* Define proper types and argument lists simultaneously */
+#define PRIMITIVE_FUNCALL(n) ((Lisp_Object (*) (PRIMITIVE_FUNCALL_##n)
+#define PRIMITIVE_FUNCALL_0  void)) (fn)) (
+#define PRIMITIVE_FUNCALL_1  Lisp_Object)) (fn)) (args[0]
+#define PRIMITIVE_FUNCALL_2  Lisp_Object, PRIMITIVE_FUNCALL_1,  args[1]
+#define PRIMITIVE_FUNCALL_3  Lisp_Object, PRIMITIVE_FUNCALL_2,  args[2]
+#define PRIMITIVE_FUNCALL_4  Lisp_Object, PRIMITIVE_FUNCALL_3,  args[3]
+#define PRIMITIVE_FUNCALL_5  Lisp_Object, PRIMITIVE_FUNCALL_4,  args[4]
+#define PRIMITIVE_FUNCALL_6  Lisp_Object, PRIMITIVE_FUNCALL_5,  args[5]
+#define PRIMITIVE_FUNCALL_7  Lisp_Object, PRIMITIVE_FUNCALL_6,  args[6]
+#define PRIMITIVE_FUNCALL_8  Lisp_Object, PRIMITIVE_FUNCALL_7,  args[7]
+#define PRIMITIVE_FUNCALL_9  Lisp_Object, PRIMITIVE_FUNCALL_8,  args[8]
+#define PRIMITIVE_FUNCALL_10 Lisp_Object, PRIMITIVE_FUNCALL_9,  args[9]
+#define PRIMITIVE_FUNCALL_11 Lisp_Object, PRIMITIVE_FUNCALL_10, args[10]
+#define PRIMITIVE_FUNCALL_12 Lisp_Object, PRIMITIVE_FUNCALL_11, args[11]
+
 static Lisp_Object
-primitive_funcall (Lisp_Object (*fn) (), int nargs, Lisp_Object args[])
+primitive_funcall (lisp_fn_t fn, int nargs, Lisp_Object args[])
 {
   switch (nargs)
     {
-    case 0:
-      return ((*fn) ());
-    case 1:
-      return ((*fn) (args[0]));
-    case 2:
-      return ((*fn) (args[0], args[1]));
-    case 3:
-      return ((*fn) (args[0], args[1], args[2]));
-    case 4:
-      return ((*fn) (args[0], args[1], args[2], args[3]));
-    case 5:
-      return ((*fn) (args[0], args[1], args[2], args[3], args[4]));
-    case 6:
-      return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5]));
-    case 7:
-      return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
-		     args[6]));
-    case 8:
-      return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
-		     args[6], args[7]));
-    case 9:
-      return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
-		     args[6], args[7], args[8]));
-    case 10:
-      return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
-		     args[6], args[7], args[8], args[9]));
-    case 11:
-      return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
-		     args[6], args[7], args[8], args[9], args[10]));
-    case 12:
-      return ((*fn) (args[0], args[1], args[2], args[3], args[4], args[5],
-		     args[6], args[7], args[8], args[9], args[10], args[11]));
-    default:
-      /* Someone has created a subr that takes more arguments than
-	 is supported by this code.  We need to either rewrite the
-	 subr to use a different argument protocol, or add more
-	 cases to this switch.  */
-      abort ();
+    case 0:  return PRIMITIVE_FUNCALL(0);
+    case 1:  return PRIMITIVE_FUNCALL(1);
+    case 2:  return PRIMITIVE_FUNCALL(2);
+    case 3:  return PRIMITIVE_FUNCALL(3);
+    case 4:  return PRIMITIVE_FUNCALL(4);
+    case 5:  return PRIMITIVE_FUNCALL(5);
+    case 6:  return PRIMITIVE_FUNCALL(6);
+    case 7:  return PRIMITIVE_FUNCALL(7);
+    case 8:  return PRIMITIVE_FUNCALL(8);
+    case 9:  return PRIMITIVE_FUNCALL(9);
+    case 10: return PRIMITIVE_FUNCALL(10);
+    case 11: return PRIMITIVE_FUNCALL(11);
+    case 12: return PRIMITIVE_FUNCALL(12);
     }
+
+  /* Someone has created a subr that takes more arguments than is
+     supported by this code.  We need to either rewrite the subr to
+     use a different argument protocol, or add more cases to this
+     switch.  */
+  abort ();
   return Qnil;	/* suppress compiler warning */
 }