Include <config.h> instead of "config.h".
[bpt/emacs.git] / src / eval.c
index 445ff08..1b05bf0 100644 (file)
@@ -1,5 +1,5 @@
 /* Evaluator for GNU Emacs Lisp interpreter.
-   Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1987, 1993 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -18,7 +18,7 @@ along with GNU Emacs; see the file COPYING.  If not, write to
 the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.  */
 
 
-#include "config.h"
+#include <config.h>
 #include "lisp.h"
 #include "blockinput.h"
 
@@ -746,7 +746,8 @@ until TEST returns nil.")
 
   test = Fcar (args);
   body = Fcdr (args);
-  while (tem = Feval (test), !NILP (tem))
+  while (tem = Feval (test),
+        (!EQ (Vmocklisp_arguments, Qt) ? XINT (tem) : !NILP (tem)))
     {
       QUIT;
       Fprogn (body);
@@ -912,10 +913,7 @@ unwind_to_catch (catch, value)
   catch->val = value;
 
   /* Restore the polling-suppression count.  */
-  if (catch->poll_suppress_count > poll_suppress_count)
-    abort ();
-  while (catch->poll_suppress_count < poll_suppress_count)
-    start_polling ();
+  set_poll_suppress_count (catch->poll_suppress_count);
 
   do
     {
@@ -1145,7 +1143,7 @@ See also the function `condition-case'.")
          if (EQ (sig, Qquit))
            return Qnil;
          else
-       error ("Returning a value from an error is no longer supported");
+           error ("Cannot return from the debugger in an error");
        }
 #endif
 
@@ -1391,7 +1389,6 @@ do_autoload (fundef, funname)
   Vautoload_queue = Qt;
   Fload (Fcar (Fcdr (fundef)), Qnil, noninteractive ? Qt : Qnil, Qnil);
 
-#ifdef UNLOAD
   /* Save the old autoloads, in case we ever do an unload. */
   queue = Vautoload_queue;
   while (CONSP (queue))
@@ -1399,11 +1396,15 @@ do_autoload (fundef, funname)
       first = Fcar (queue);
       second = Fcdr (first);
       first = Fcar (first);
-      if (!EQ (second, Qnil))
+
+      /* Note: This test is subtle.  The cdr of an autoload-queue entry
+        may be an atom if the autoload entry was generated by a defalias
+        or fset. */
+      if (CONSP (second))
          Fput(first, Qautoload, (Fcdr (second)));
+
       queue = Fcdr (queue);
     }
-#endif /* UNLOAD */
 
   /* Once loading finishes, don't undo it.  */
   Vautoload_queue = Qt;
@@ -1411,8 +1412,7 @@ do_autoload (fundef, funname)
 
   fun = Findirect_function (fun);
 
-  if (XTYPE (fun) == Lisp_Cons
-      && EQ (XCONS (fun)->car, Qautoload))
+  if (!NILP (Fequal (fun, fundef)))
     error ("Autoloading failed to define function %s",
           XSYMBOL (funname)->name->data);
 }
@@ -1733,18 +1733,18 @@ call0 (fn)
   RETURN_UNGCPRO (Ffuncall (1, &fn));
 }
 
-/* Call function fn with argument arg */
+/* Call function fn with 1 argument arg1 */
 /* ARGSUSED */
 Lisp_Object
-call1 (fn, arg)
-     Lisp_Object fn, arg;
+call1 (fn, arg1)
+     Lisp_Object fn, arg1;
 {
   struct gcpro gcpro1;
 #ifdef NO_ARG_ARRAY
   Lisp_Object args[2];  
 
   args[0] = fn;
-  args[1] = arg;
+  args[1] = arg1;
   GCPRO1 (args[0]);
   gcpro1.nvars = 2;
   RETURN_UNGCPRO (Ffuncall (2, args));
@@ -1755,18 +1755,18 @@ call1 (fn, arg)
 #endif /* not NO_ARG_ARRAY */
 }
 
-/* Call function fn with arguments arg, arg1 */
+/* Call function fn with 2 arguments arg1, arg2 */
 /* ARGSUSED */
 Lisp_Object
-call2 (fn, arg, arg1)
-     Lisp_Object fn, arg, arg1;
+call2 (fn, arg1, arg2)
+     Lisp_Object fn, arg1, arg2;
 {
   struct gcpro gcpro1;
 #ifdef NO_ARG_ARRAY
   Lisp_Object args[3];
   args[0] = fn;
-  args[1] = arg;
-  args[2] = arg1;
+  args[1] = arg1;
+  args[2] = arg2;
   GCPRO1 (args[0]);
   gcpro1.nvars = 3;
   RETURN_UNGCPRO (Ffuncall (3, args));
@@ -1777,19 +1777,19 @@ call2 (fn, arg, arg1)
 #endif /* not NO_ARG_ARRAY */
 }
 
-/* Call function fn with arguments arg, arg1, arg2 */
+/* Call function fn with 3 arguments arg1, arg2, arg3 */
 /* ARGSUSED */
 Lisp_Object
-call3 (fn, arg, arg1, arg2)
-     Lisp_Object fn, arg, arg1, arg2;
+call3 (fn, arg1, arg2, arg3)
+     Lisp_Object fn, arg1, arg2, arg3;
 {
   struct gcpro gcpro1;
 #ifdef NO_ARG_ARRAY
   Lisp_Object args[4];
   args[0] = fn;
-  args[1] = arg;
-  args[2] = arg1;
-  args[3] = arg2;
+  args[1] = arg1;
+  args[2] = arg2;
+  args[3] = arg3;
   GCPRO1 (args[0]);
   gcpro1.nvars = 4;
   RETURN_UNGCPRO (Ffuncall (4, args));
@@ -1800,6 +1800,81 @@ call3 (fn, arg, arg1, arg2)
 #endif /* not NO_ARG_ARRAY */
 }
 
+/* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
+/* ARGSUSED */
+Lisp_Object
+call4 (fn, arg1, arg2, arg3, arg4)
+     Lisp_Object fn, arg1, arg2, arg3, arg4;
+{
+  struct gcpro gcpro1;
+#ifdef NO_ARG_ARRAY
+  Lisp_Object args[5];
+  args[0] = fn;
+  args[1] = arg1;
+  args[2] = arg2;
+  args[3] = arg3;
+  args[4] = arg4;
+  GCPRO1 (args[0]);
+  gcpro1.nvars = 5;
+  RETURN_UNGCPRO (Ffuncall (5, args));
+#else /* not NO_ARG_ARRAY */
+  GCPRO1 (fn);
+  gcpro1.nvars = 5;
+  RETURN_UNGCPRO (Ffuncall (5, &fn));
+#endif /* not NO_ARG_ARRAY */
+}
+
+/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
+/* ARGSUSED */
+Lisp_Object
+call5 (fn, arg1, arg2, arg3, arg4, arg5)
+     Lisp_Object fn, arg1, arg2, arg3, arg4, arg5;
+{
+  struct gcpro gcpro1;
+#ifdef NO_ARG_ARRAY
+  Lisp_Object args[6];
+  args[0] = fn;
+  args[1] = arg1;
+  args[2] = arg2;
+  args[3] = arg3;
+  args[4] = arg4;
+  args[5] = arg5;
+  GCPRO1 (args[0]);
+  gcpro1.nvars = 6;
+  RETURN_UNGCPRO (Ffuncall (6, args));
+#else /* not NO_ARG_ARRAY */
+  GCPRO1 (fn);
+  gcpro1.nvars = 6;
+  RETURN_UNGCPRO (Ffuncall (6, &fn));
+#endif /* not NO_ARG_ARRAY */
+}
+
+/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
+/* ARGSUSED */
+Lisp_Object
+call6 (fn, arg1, arg2, arg3, arg4, arg5, arg6)
+     Lisp_Object fn, arg1, arg2, arg3, arg4, arg5, arg6;
+{
+  struct gcpro gcpro1;
+#ifdef NO_ARG_ARRAY
+  Lisp_Object args[7];
+  args[0] = fn;
+  args[1] = arg1;
+  args[2] = arg2;
+  args[3] = arg3;
+  args[4] = arg4;
+  args[5] = arg5;
+  args[6] = arg6;
+  GCPRO1 (args[0]);
+  gcpro1.nvars = 7;
+  RETURN_UNGCPRO (Ffuncall (7, args));
+#else /* not NO_ARG_ARRAY */
+  GCPRO1 (fn);
+  gcpro1.nvars = 7;
+  RETURN_UNGCPRO (Ffuncall (7, &fn));
+#endif /* not NO_ARG_ARRAY */
+}
+
 DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
   "Call first argument as a function, passing remaining arguments to it.\n\
 Thus, (funcall 'cons 'x 'y) returns (x . y).")