merge changes in emacs-23 branch

[gnu-emacs] / src / eval.c

diff --git a/src/eval.c b/src/eval.c
index 1a7eb4a123ebb7bf0e391b48a54150bba8e134a0..89d353cf7cb8e7017c571079731d87dd72b4bb69 100644 (file)
--- a/src/eval.c
+++ b/src/eval.c
@@ -63,7 +63,6 @@ Lisp_Object Qand_rest, Qand_optional;
 Lisp_Object Qdebug_on_error;
 Lisp_Object Qdeclare;
 Lisp_Object Qdebug;
-extern Lisp_Object Qinteractive_form;
 
 /* This holds either the symbol `run-hooks' or nil.
    It is nil at an early stage of startup, and when Emacs
@@ -166,10 +165,6 @@ int handling_signal;
 
 Lisp_Object Vmacro_declaration_function;
 
-extern Lisp_Object Qrisky_local_variable;
-
-extern Lisp_Object Qfunction;
-
 static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object*);
 static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN;
 \f
@@ -695,8 +690,8 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...)  */)
       tail = XCDR (tail);
     }
 
-  while (CONSP (Fcar (tail))
-        && EQ (Fcar (Fcar (tail)), Qdeclare))
+  if (CONSP (Fcar (tail))
+      && EQ (Fcar (Fcar (tail)), Qdeclare))
     {
       if (!NILP (Vmacro_declaration_function))
        {
@@ -1016,12 +1011,13 @@ usage: (let VARLIST BODY...)  */)
   int count = SPECPDL_INDEX ();
   register int argnum;
   struct gcpro gcpro1, gcpro2;
+  USE_SAFE_ALLOCA;
 
   varlist = Fcar (args);
 
   /* Make space to hold the values to give the bound variables */
   elt = Flength (varlist);
-  temps = (Lisp_Object *) alloca (XFASTINT (elt) * sizeof (Lisp_Object));
+  SAFE_ALLOCA_LISP (temps, XFASTINT (elt));
 
   /* Compute the values and store them in `temps' */
 
@@ -1054,6 +1050,7 @@ usage: (let VARLIST BODY...)  */)
     }
 
   elt = Fprogn (Fcdr (args));
+  SAFE_FREE ();
   return unbind_to (count, elt);
 }
 
@@ -1634,8 +1631,6 @@ See also the function `condition-case'.  */)
      That is a special case--don't do this in other situations.  */
   register struct handler *allhandlers = handlerlist;
   Lisp_Object conditions;
-  extern int gc_in_progress;
-  extern int waiting_for_input;
   Lisp_Object string;
   Lisp_Object real_error_symbol;
   struct backtrace *bp;
@@ -1991,11 +1986,10 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions,
   return Qnil;
 }
 
-/* dump an error message; called like printf */
 
-/* VARARGS 1 */
+/* dump an error message; called like vprintf */
 void
-error (const char *m, ...)
+verror (const char *m, va_list ap)
 {
   char buf[200];
   int size = 200;
@@ -2009,14 +2003,8 @@ error (const char *m, ...)
 
   while (1)
     {
-      va_list ap;
       int used;
-
-      /* A va_list can't be reused if we have to go around the loop
-        again; we need to "reinitialize" it each time.  */
-      va_start(ap, m);
       used = doprnt (buffer, size, m, m + mlen, ap);
-      va_end(ap);
       if (used < size)
        break;
       size *= 2;
@@ -2035,6 +2023,19 @@ error (const char *m, ...)
 
   xsignal1 (Qerror, string);
 }
+
+
+/* dump an error message; called like printf */
+
+/* VARARGS 1 */
+void
+error (const char *m, ...)
+{
+  va_list ap;
+  va_start (ap, m);
+  verror (m, ap);
+  va_end (ap);
+}
 \f
 DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0,
        doc: /* Non-nil if FUNCTION makes provisions for interactive calling.
@@ -2293,7 +2294,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
       if (XSUBR (fun)->max_args == UNEVALLED)
        {
          backtrace.evalargs = 0;
-         val = (XSUBR (fun)->function.a1) (args_left);
+         val = (XSUBR (fun)->function.aUNEVALLED) (args_left);
          goto done;
        }
 
@@ -2302,8 +2303,9 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
          /* Pass a vector of evaluated arguments */
          Lisp_Object *vals;
          register int argnum = 0;
+         USE_SAFE_ALLOCA;
 
-         vals = (Lisp_Object *) alloca (XINT (numargs) * sizeof (Lisp_Object));
+         SAFE_ALLOCA_LISP (vals, XINT (numargs));
 
          GCPRO3 (args_left, fun, fun);
          gcpro3.var = vals;
@@ -2319,8 +2321,9 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
          backtrace.args = vals;
          backtrace.nargs = XINT (numargs);
 
-         val = (XSUBR (fun)->function.am) (XINT (numargs), vals);
+         val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals);
          UNGCPRO;
+         SAFE_FREE ();
          goto done;
        }
 
@@ -2431,8 +2434,9 @@ usage: (apply FUNCTION &rest ARGUMENTS)  */)
   register int i, numargs;
   register Lisp_Object spread_arg;
   register Lisp_Object *funcall_args;
-  Lisp_Object fun;
+  Lisp_Object fun, retval;
   struct gcpro gcpro1;
+  USE_SAFE_ALLOCA;
 
   fun = args [0];
   funcall_args = 0;
@@ -2471,8 +2475,7 @@ usage: (apply FUNCTION &rest ARGUMENTS)  */)
        {
          /* Avoid making funcall cons up a yet another new vector of arguments
             by explicitly supplying nil's for optional values */
-         funcall_args = (Lisp_Object *) alloca ((1 + XSUBR (fun)->max_args)
-                                                * sizeof (Lisp_Object));
+         SAFE_ALLOCA_LISP (funcall_args, 1 + XSUBR (fun)->max_args);
          for (i = numargs; i < XSUBR (fun)->max_args;)
            funcall_args[++i] = Qnil;
          GCPRO1 (*funcall_args);
@@ -2484,8 +2487,7 @@ usage: (apply FUNCTION &rest ARGUMENTS)  */)
      function itself as well as its arguments.  */
   if (!funcall_args)
     {
-      funcall_args = (Lisp_Object *) alloca ((1 + numargs)
-                                            * sizeof (Lisp_Object));
+      SAFE_ALLOCA_LISP (funcall_args, 1 + numargs);
       GCPRO1 (*funcall_args);
       gcpro1.nvars = 1 + numargs;
     }
@@ -2501,7 +2503,11 @@ usage: (apply FUNCTION &rest ARGUMENTS)  */)
     }
 
   /* By convention, the caller needs to gcpro Ffuncall's args.  */
-  RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args));
+  retval = Ffuncall (gcpro1.nvars, funcall_args);
+  UNGCPRO;
+  SAFE_FREE ();
+
+  return retval;
 }
 \f
 /* Run hook variables in various ways.  */
@@ -2962,7 +2968,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
 
       if (XSUBR (fun)->max_args == MANY)
        {
-         val = (XSUBR (fun)->function.am) (numargs, args + 1);
+         val = (XSUBR (fun)->function.aMANY) (numargs, args + 1);
          goto done;
        }
 
@@ -3066,9 +3072,10 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag)
   struct gcpro gcpro1, gcpro2, gcpro3;
   register int i;
   register Lisp_Object tem;
+  USE_SAFE_ALLOCA;
 
   numargs = Flength (args);
-  arg_vector = (Lisp_Object *) alloca (XINT (numargs) * sizeof (Lisp_Object));
+  SAFE_ALLOCA_LISP (arg_vector, XINT (numargs));
   args_left = args;
 
   GCPRO3 (*arg_vector, args_left, fun);
@@ -3097,6 +3104,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag)
     tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil)));
   /* Don't do it again when we return to eval.  */
   backtrace_list->debug_on_exit = 0;
+  SAFE_FREE ();
   return tem;
 }
 
@@ -3432,7 +3440,6 @@ Output stream used is value of `standard-output'.  */)
   register int i;
   Lisp_Object tail;
   Lisp_Object tem;
-  extern Lisp_Object Vprint_level;
   struct gcpro gcpro1;
 
   XSETFASTINT (Vprint_level, 3);