(construct_menu_click, construct_mouse_click):
[bpt/emacs.git] / src / eval.c
index c0aafa8..ea608d3 100644 (file)
@@ -1,5 +1,5 @@
 /* Evaluator for GNU Emacs Lisp interpreter.
-   Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
+   Copyright (C) 1985, 1986, 1987, 1993 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -18,14 +18,13 @@ 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"
-#ifdef HAVE_X_WINDOWS
-#include "xterm.h"
-#endif
+#include "blockinput.h"
 
 #ifndef standalone
 #include "commands.h"
+#include "keyboard.h"
 #else
 #define INTERACTIVE 1
 #endif
@@ -40,8 +39,9 @@ struct backtrace
     struct backtrace *next;
     Lisp_Object *function;
     Lisp_Object *args; /* Points to vector of args. */
-    int nargs;         /* length of vector */
-              /* if nargs is UNEVALLED, args points to slot holding list of unevalled args */
+    int nargs;         /* Length of vector.
+                          If nargs is UNEVALLED, args points to slot holding
+                          list of unevalled args */
     char evalargs;
     /* Nonzero means call value of debugger when done with this operation. */
     char debug_on_exit;
@@ -49,6 +49,24 @@ struct backtrace
 
 struct backtrace *backtrace_list;
 
+/* This structure helps implement the `catch' and `throw' control
+   structure.  A struct catchtag contains all the information needed
+   to restore the state of the interpreter after a non-local jump.
+
+   Handlers for error conditions (represented by `struct handler'
+   structures) just point to a catch tag to do the cleanup required
+   for their jumps.
+
+   catchtag structures are chained together in the C calling stack;
+   the `next' member points to the next outer catchtag.
+
+   A call like (throw TAG VAL) searches for a catchtag whose `tag'
+   member is TAG, and then unbinds to it.  The `val' member is used to
+   hold VAL while the stack is unwound; `val' is returned as the value
+   of the catch form.
+
+   All the other members are concerned with restoring the interpreter
+   state.  */
 struct catchtag
   {
     Lisp_Object tag;
@@ -66,7 +84,7 @@ struct catchtag
 struct catchtag *catchlist;
 
 Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
-Lisp_Object Vquit_flag, Vinhibit_quit;
+Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag;
 Lisp_Object Qmocklisp_arguments, Vmocklisp_arguments, Qmocklisp;
 Lisp_Object Qand_rest, Qand_optional;
 Lisp_Object Qdebug_on_error;
@@ -101,21 +119,25 @@ int max_lisp_eval_depth;
 /* Nonzero means enter debugger before next function call */
 int debug_on_next_call;
 
-/* Nonzero means display a backtrace if an error
is handled by the command loop's error handler. */
-int stack_trace_on_error;
+/* List of conditions (non-nil atom means all) which cause a backtrace
  if an error is handled by the command loop's error handler.  */
+Lisp_Object Vstack_trace_on_error;
 
-/* Nonzero means enter debugger if an error
is handled by the command loop's error handler. */
-int debug_on_error;
+/* List of conditions (non-nil atom means all) which enter the debugger
  if an error is handled by the command loop's error handler.  */
+Lisp_Object Vdebug_on_error;
 
 /* Nonzero means enter debugger if a quit signal
- is handled by the command loop's error handler. */
  is handled by the command loop's error handler. */
 int debug_on_quit;
 
-/* Nonzero means we are trying to enter the debugger.
-   This is to prevent recursive attempts.  */
-int entering_debugger;
+/* The value of num_nonmacro_input_chars as of the last time we
+   started to enter the debugger.  If we decide to enter the debugger
+   again when this is still equal to num_nonmacro_input_chars, then we
+   know that the debugger itself has an error, and we should just
+   signal the error instead of entering an infinite loop of debugger
+   invocations.  */
+int when_entered_debugger;
 
 Lisp_Object Vdebugger;
 
@@ -141,7 +163,7 @@ init_eval ()
   Vquit_flag = Qnil;
   debug_on_next_call = 0;
   lisp_eval_depth = 0;
-  entering_debugger = 0;
+  when_entered_debugger = 0;
 }
 
 Lisp_Object
@@ -153,7 +175,7 @@ call_debugger (arg)
   if (specpdl_size + 40 > max_specpdl_size)
     max_specpdl_size = specpdl_size + 40;
   debug_on_next_call = 0;
-  entering_debugger = 1;
+  when_entered_debugger = num_nonmacro_input_chars;
   return apply1 (Vdebugger, arg);
 }
 
@@ -180,7 +202,7 @@ If all args return nil, return nil.")
   Lisp_Object args_left;
   struct gcpro gcpro1;
 
-  if (NULL(args))
+  if (NILP(args))
     return Qnil;
 
   args_left = args;
@@ -189,11 +211,11 @@ If all args return nil, return nil.")
   do
     {
       val = Feval (Fcar (args_left));
-      if (!NULL (val))
+      if (!NILP (val))
        break;
       args_left = Fcdr (args_left);
     }
-  while (!NULL(args_left));
+  while (!NILP(args_left));
 
   UNGCPRO;
   return val;
@@ -210,7 +232,7 @@ If no arg yields nil, return the last arg's value.")
   Lisp_Object args_left;
   struct gcpro gcpro1;
 
-  if (NULL(args))
+  if (NILP(args))
     return Qt;
 
   args_left = args;
@@ -219,11 +241,11 @@ If no arg yields nil, return the last arg's value.")
   do
     {
       val = Feval (Fcar (args_left));
-      if (NULL (val))
+      if (NILP (val))
        break;
       args_left = Fcdr (args_left);
     }
-  while (!NULL(args_left));
+  while (!NILP(args_left));
 
   UNGCPRO;
   return val;
@@ -244,7 +266,7 @@ If COND yields nil, and there are no ELSE's, the value is nil.")
   cond = Feval (Fcar (args));
   UNGCPRO;
 
-  if (!NULL (cond))
+  if (!NILP (cond))
     return Feval (Fcar (Fcdr (args)));
   return Fprogn (Fcdr (Fcdr (args)));
 }
@@ -266,11 +288,11 @@ CONDITION's value if non-nil is returned from the cond-form.")
 
   val = Qnil;
   GCPRO1 (args);
-  while (!NULL (args))
+  while (!NILP (args))
     {
       clause = Fcar (args);
       val = Feval (Fcar (clause));
-      if (!NULL (val))
+      if (!NILP (val))
        {
          if (!EQ (XCONS (clause)->cdr, Qnil))
            val = Fprogn (XCONS (clause)->cdr);
@@ -297,14 +319,14 @@ DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
   if (!EQ (Vmocklisp_arguments, Qt))
     {
       val = make_number (0);
-      while (!NULL (args) && (tem = Fcar (args), XTYPE (tem) == Lisp_Symbol))
+      while (!NILP (args) && (tem = Fcar (args), XTYPE (tem) == Lisp_Symbol))
        {
          QUIT;
          specbind (tem, val), args = Fcdr (args);
        }
     }
 
-  if (NULL(args))
+  if (NILP(args))
     return Qnil;
 
   args_left = args;
@@ -315,7 +337,7 @@ DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
       val = Feval (Fcar (args_left));
       args_left = Fcdr (args_left);
     }
-  while (!NULL(args_left));
+  while (!NILP(args_left));
 
   UNGCPRO;
   return val;
@@ -333,7 +355,7 @@ whose values are discarded.")
   struct gcpro gcpro1, gcpro2;
   register int argnum = 0;
 
-  if (NULL(args))
+  if (NILP(args))
     return Qnil;
 
   args_left = args;
@@ -348,7 +370,7 @@ whose values are discarded.")
        Feval (Fcar (args_left));
       args_left = Fcdr (args_left);
     }
-  while (!NULL(args_left));
+  while (!NILP(args_left));
 
   UNGCPRO;
   return val;
@@ -368,7 +390,7 @@ whose values are discarded.")
 
   val = Qnil;
 
-  if (NULL(args))
+  if (NILP(args))
     return Qnil;
 
   args_left = args;
@@ -383,7 +405,7 @@ whose values are discarded.")
        Feval (Fcar (args_left));
       args_left = Fcdr (args_left);
     }
-  while (!NULL(args_left));
+  while (!NILP(args_left));
 
   UNGCPRO;
   return val;
@@ -400,7 +422,7 @@ Each SYM is set before the next VAL is computed.")
   register Lisp_Object val, sym;
   struct gcpro gcpro1;
 
-  if (NULL(args))
+  if (NILP(args))
     return Qnil;
 
   args_left = args;
@@ -413,7 +435,7 @@ Each SYM is set before the next VAL is computed.")
       Fset (sym, val);
       args_left = Fcdr (Fcdr (args_left));
     }
-  while (!NULL(args_left));
+  while (!NILP(args_left));
 
   UNGCPRO;
   return val;
@@ -450,27 +472,34 @@ and input is currently coming from the keyboard (not in keyboard macro).")
   if (!INTERACTIVE)
     return Qnil;
 
-  /*  Unless the object was compiled, skip the frame of interactive-p itself
-      (if interpreted) or the frame of byte-code (if called from
-      compiled function).  */
   btp = backtrace_list;
-  if (! XTYPE (*btp->function) == Lisp_Compiled)
+
+  /* If this isn't a byte-compiled function, there may be a frame at
+     the top for Finteractive_p itself.  If so, skip it.  */
+  fun = Findirect_function (*btp->function);
+  if (XTYPE (fun) == Lisp_Subr
+      && (struct Lisp_Subr *) XPNTR (fun) == &Sinteractive_p)
     btp = btp->next;
-  for (;
-       btp && (btp->nargs == UNEVALLED
-              || EQ (*btp->function, Qbytecode));
-       btp = btp->next)
-    {}
-  /* btp now points at the frame of the innermost function
-     that DOES eval its args.
-     If it is a built-in function (such as load or eval-region)
-     return nil.  */
-  fun = *btp->function;
-  while (XTYPE (fun) == Lisp_Symbol)
-    {
-      QUIT;
-      fun = Fsymbol_function (fun);
-    }
+
+  /* If we're running an Emacs 18-style byte-compiled function, there
+     may be a frame for Fbytecode.  Now, given the strictest
+     definition, this function isn't really being called
+     interactively, but because that's the way Emacs 18 always builds
+     byte-compiled functions, we'll accept it for now.  */
+  if (EQ (*btp->function, Qbytecode))
+    btp = btp->next;
+
+  /* If this isn't a byte-compiled function, then we may now be
+     looking at several frames for special forms.  Skip past them.  */
+  while (btp && 
+        btp->nargs == UNEVALLED)
+    btp = btp->next;
+
+  /* btp now points at the frame of the innermost function that isn't
+     a special form, ignoring frames for Finteractive_p and/or
+     Fbytecode at the top.  If this frame is for a built-in function
+     (such as load or eval-region) return nil.  */
+  fun = Findirect_function (*btp->function);
   if (XTYPE (fun) == Lisp_Subr)
     return Qnil;
   /* btp points to the frame of a Lisp function that called interactive-p.
@@ -492,9 +521,10 @@ See also the function `interactive'.")
 
   fn_name = Fcar (args);
   defn = Fcons (Qlambda, Fcdr (args));
-  if (!NULL (Vpurify_flag))
+  if (!NILP (Vpurify_flag))
     defn = Fpurecopy (defn);
   Ffset (fn_name, defn);
+  LOADHIST_ATTACH (fn_name);
   return fn_name;
 }
 
@@ -513,9 +543,10 @@ and the result should be a form to be evaluated instead of the original.")
 
   fn_name = Fcar (args);
   defn = Fcons (Qmacro, Fcons (Qlambda, Fcdr (args)));
-  if (!NULL (Vpurify_flag))
+  if (!NILP (Vpurify_flag))
     defn = Fpurecopy (defn);
   Ffset (fn_name, defn);
+  LOADHIST_ATTACH (fn_name);
   return fn_name;
 }
 
@@ -525,7 +556,8 @@ You are not required to define a variable in order to use it,\n\
 but the definition can supply documentation and an initial value\n\
 in a way that tags can recognize.\n\n\
 INITVALUE is evaluated, and used to set SYMBOL, only if SYMBOL's value is void.\n\
-If SYMBOL is buffer-local, its default value is initialized in this way.\n\
+If SYMBOL is buffer-local, its default value is what is set;\n\
+ buffer-local values are not affected.\n\
 INITVALUE and DOCSTRING are optional.\n\
 If DOCSTRING starts with *, this variable is identified as a user option.\n\
  This means that M-x set-variable and M-x edit-options recognize it.\n\
@@ -537,19 +569,20 @@ If INITVALUE is missing, SYMBOL's value is not set.")
 
   sym = Fcar (args);
   tem = Fcdr (args);
-  if (!NULL (tem))
+  if (!NILP (tem))
     {
       tem = Fdefault_boundp (sym);
-      if (NULL (tem))
+      if (NILP (tem))
        Fset_default (sym, Feval (Fcar (Fcdr (args))));
     }
   tem = Fcar (Fcdr (Fcdr (args)));
-  if (!NULL (tem))
+  if (!NILP (tem))
     {
-      if (!NULL (Vpurify_flag))
+      if (!NILP (Vpurify_flag))
        tem = Fpurecopy (tem);
       Fput (sym, Qvariable_documentation, tem);
     }
+  LOADHIST_ATTACH (sym);
   return sym;
 }
 
@@ -557,7 +590,8 @@ DEFUN ("defconst", Fdefconst, Sdefconst, 2, UNEVALLED, 0,
   "(defconst SYMBOL INITVALUE DOCSTRING): define SYMBOL as a constant variable.\n\
 The intent is that programs do not change this value, but users may.\n\
 Always sets the value of SYMBOL to the result of evalling INITVALUE.\n\
-If SYMBOL is buffer-local, its default value is initialized in this way.\n\
+If SYMBOL is buffer-local, its default value is what is set;\n\
+ buffer-local values are not affected.\n\
 DOCSTRING is optional.\n\
 If DOCSTRING starts with *, this variable is identified as a user option.\n\
  This means that M-x set-variable and M-x edit-options recognize it.\n\n\
@@ -574,12 +608,13 @@ it would override the user's choice.")
   sym = Fcar (args);
   Fset_default (sym, Feval (Fcar (Fcdr (args))));
   tem = Fcar (Fcdr (Fcdr (args)));
-  if (!NULL (tem))
+  if (!NILP (tem))
     {
-      if (!NULL (Vpurify_flag))
+      if (!NILP (Vpurify_flag))
        tem = Fpurecopy (tem);
       Fput (sym, Qvariable_documentation, tem);
     }
+  LOADHIST_ATTACH (sym);
   return sym;
 }
 
@@ -618,12 +653,16 @@ Each VALUEFORM can refer to the symbols already bound by this VARLIST.")
   GCPRO3 (args, elt, varlist);
 
   varlist = Fcar (args);
-  while (!NULL (varlist))
+  while (!NILP (varlist))
     {
       QUIT;
       elt = Fcar (varlist);
       if (XTYPE (elt) == Lisp_Symbol)
        specbind (elt, Qnil);
+      else if (! NILP (Fcdr (Fcdr (elt))))
+       Fsignal (Qerror,
+                Fcons (build_string ("`let' bindings can have only one value-form"),
+                       elt));
       else
        {
          val = Feval (Fcar (Fcdr (elt)));
@@ -662,12 +701,16 @@ All the VALUEFORMs are evalled before any symbols are bound.")
   GCPRO2 (args, *temps);
   gcpro2.nvars = 0;
 
-  for (argnum = 0; !NULL (varlist); varlist = Fcdr (varlist))
+  for (argnum = 0; !NILP (varlist); varlist = Fcdr (varlist))
     {
       QUIT;
       elt = Fcar (varlist);
       if (XTYPE (elt) == Lisp_Symbol)
        temps [argnum++] = Qnil;
+      else if (! NILP (Fcdr (Fcdr (elt))))
+       Fsignal (Qerror,
+                Fcons (build_string ("`let' bindings can have only one value-form"),
+                       elt));
       else
        temps [argnum++] = Feval (Fcar (Fcdr (elt)));
       gcpro2.nvars = argnum;
@@ -675,7 +718,7 @@ All the VALUEFORMs are evalled before any symbols are bound.")
   UNGCPRO;
 
   varlist = Fcar (args);
-  for (argnum = 0; !NULL (varlist); varlist = Fcdr (varlist))
+  for (argnum = 0; !NILP (varlist); varlist = Fcdr (varlist))
     {
       elt = Fcar (varlist);
       tem = temps[argnum++];
@@ -703,7 +746,8 @@ until TEST returns nil.")
 
   test = Fcar (args);
   body = Fcdr (args);
-  while (tem = Feval (test), !NULL (tem))
+  while (tem = Feval (test),
+        (!EQ (Vmocklisp_arguments, Qt) ? XINT (tem) : !NILP (tem)))
     {
       QUIT;
       Fprogn (body);
@@ -724,6 +768,7 @@ definitions to shadow the loaded ones for use in file byte-compilation.")
      register Lisp_Object form;
      Lisp_Object env;
 {
+  /* With cleanups from Hallvard Furuseth.  */
   register Lisp_Object expander, sym, def, tem;
 
   while (1)
@@ -732,46 +777,27 @@ definitions to shadow the loaded ones for use in file byte-compilation.")
         in case it expands into another macro call.  */
       if (XTYPE (form) != Lisp_Cons)
        break;
-      sym = XCONS (form)->car;
-      /* Detect  ((macro lambda ...) ...)  */
-      if (XTYPE (sym) == Lisp_Cons
-         && EQ (XCONS (sym)->car, Qmacro))
-       {
-         expander = XCONS (sym)->cdr;
-         goto explicit;
-       }
-      if (XTYPE (sym) != Lisp_Symbol)
-       break;
+      /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
+      def = sym = XCONS (form)->car;
+      tem = Qnil;
       /* Trace symbols aliases to other symbols
         until we get a symbol that is not an alias.  */
-      while (1)
+      while (XTYPE (def) == Lisp_Symbol)
        {
          QUIT;
+         sym = def;
          tem = Fassq (sym, env);
-         if (NULL (tem))
+         if (NILP (tem))
            {
              def = XSYMBOL (sym)->function;
-             if (XTYPE (def) == Lisp_Symbol && !EQ (def, Qunbound))
-               sym = def;
-             else
-               break;
-           }
-         else
-           {
-#if 0  /* This is turned off because it caused an element (foo . bar)
-         to have the effect of defining foo as an alias for the macro bar.
-         That is inconsistent; bar should be a function to expand foo.  */
-             if (XTYPE (tem) == Lisp_Cons
-                 && XTYPE (XCONS (tem)->cdr) == Lisp_Symbol)
-               sym = XCONS (tem)->cdr;
-             else
-#endif
-               break;
+             if (!EQ (def, Qunbound))
+               continue;
            }
+         break;
        }
       /* Right now TEM is the result from SYM in ENV,
         and if TEM is nil then DEF is SYM's function definition.  */
-      if (NULL (tem))
+      if (NILP (tem))
        {
          /* SYM is not mentioned in ENV.
             Look at its function definition.  */
@@ -782,12 +808,15 @@ definitions to shadow the loaded ones for use in file byte-compilation.")
          if (EQ (XCONS (def)->car, Qautoload))
            {
              /* Autoloading function: will it be a macro when loaded?  */
-             tem = Fcar (Fnthcdr (make_number (4), def));
-             if (NULL (tem))
+             tem = Fnth (make_number (4), def);
+             if (EQ (tem, Qt) || EQ (tem, Qmacro))
+               /* Yes, load it and try again.  */
+               {
+                 do_autoload (def, sym);
+                 continue;
+               }
+             else
                break;
-             /* Yes, load it and try again.  */
-             do_autoload (def, sym);
-             continue;
            }
          else if (!EQ (XCONS (def)->car, Qmacro))
            break;
@@ -796,10 +825,9 @@ definitions to shadow the loaded ones for use in file byte-compilation.")
       else
        {
          expander = XCONS (tem)->cdr;
-         if (NULL (expander))
+         if (NILP (expander))
            break;
        }
-    explicit:
       form = apply1 (expander, XCONS (form)->cdr);
     }
   return form;
@@ -857,26 +885,41 @@ internal_catch (tag, func, arg)
   return c.val;
 }
 
-/* Discard from the catchlist all catch tags back through CATCH.
-   Before each catch is discarded, unbind all special bindings
-   made within that catch.  Also, when discarding a catch that
-   corresponds to a condition handler, discard that handler.
+/* Unwind the specbind, catch, and handler stacks back to CATCH, and
+   jump to that CATCH, returning VALUE as the value of that catch.
 
-   At the end, restore some static info saved in CATCH.
+   This is the guts Fthrow and Fsignal; they differ only in the way
+   they choose the catch tag to throw to.  A catch tag for a
+   condition-case form has a TAG of Qnil.
 
-   This is used for correct unwinding in Fthrow and Fsignal,
-   before doing the longjmp that actually destroys the stack frames
-   in which these handlers and catches reside.  */
+   Before each catch is discarded, unbind all special bindings and
+   execute all unwind-protect clauses made above that catch.  Unwind
+   the handler stack as we go, so that the proper handlers are in
+   effect for each unwind-protect clause we run.  At the end, restore
+   some static info saved in CATCH, and longjmp to the location
+   specified in the
+
+   This is used for correct unwinding in Fthrow and Fsignal.  */
 
 static void
-unbind_catch (catch)
+unwind_to_catch (catch, value)
      struct catchtag *catch;
+     Lisp_Object value;
 {
   register int last_time;
 
+  /* Save the value in the tag.  */
+  catch->val = value;
+
+  /* Restore the polling-suppression count.  */
+  set_poll_suppress_count (catch->poll_suppress_count);
+
   do
     {
       last_time = catchlist == catch;
+
+      /* Unwind the specpdl stack, and then restore the proper set of
+         handlers.  */
       unbind_to (catchlist->pdlcount, Qnil);
       handlerlist = catchlist->handlerlist;
       catchlist = catchlist->next;
@@ -886,6 +929,8 @@ unbind_catch (catch)
   gcprolist = catch->gcpro;
   backtrace_list = catch->backlist;
   lisp_eval_depth = catch->lisp_eval_depth;
+  
+  _longjmp (catch->jmp, 1);
 }
 
 DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
@@ -898,20 +943,11 @@ Both TAG and VALUE are evalled.")
 
   while (1)
     {
-      if (!NULL (tag))
+      if (!NILP (tag))
        for (c = catchlist; c; c = c->next)
          {
            if (EQ (c->tag, tag))
-             {
-               /* Restore the polling-suppression count.  */
-               if (c->poll_suppress_count > poll_suppress_count)
-                 abort ();
-               while (c->poll_suppress_count < poll_suppress_count)
-                 start_polling ();
-               c->val = val;
-               unbind_catch (c);
-               _longjmp (c->jmp, 1);
-             }
+             unwind_to_catch (c, val);
          }
       tag = Fsignal (Qno_catch, Fcons (tag, Fcons (val, Qnil)));
     }
@@ -953,6 +989,9 @@ A handler is applicable to an error\n\
 if CONDITION-NAME is one of the error's condition names.\n\
 If an error happens, the first applicable handler is run.\n\
 \n\
+The car of a handler may be a list of condition names\n\
+instead of a single condition name.\n\
+\n\
 When a handler handles an error,\n\
 control returns to the condition-case and the handler BODY... is executed\n\
 with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA).\n\
@@ -966,10 +1005,23 @@ See also the function `signal' for more info.")
   Lisp_Object val;
   struct catchtag c;
   struct handler h;
-  register Lisp_Object tem;
+  register Lisp_Object var, bodyform, handlers;
 
-  tem = Fcar (args);
-  CHECK_SYMBOL (tem, 0);
+  var      = Fcar (args);
+  bodyform = Fcar (Fcdr (args));
+  handlers = Fcdr (Fcdr (args));
+  CHECK_SYMBOL (var, 0);
+
+  for (val = handlers; ! NILP (val); val = Fcdr (val))
+    {
+      Lisp_Object tem;
+      tem = Fcar (val);
+      if (! (NILP (tem)
+            || (CONSP (tem)
+                && (SYMBOLP (XCONS (tem)->car)
+                    || CONSP (XCONS (tem)->car)))))
+       error ("Invalid condition handler", tem);
+    }
 
   c.tag = Qnil;
   c.val = Qnil;
@@ -981,31 +1033,26 @@ See also the function `signal' for more info.")
   c.gcpro = gcprolist;
   if (_setjmp (c.jmp))
     {
-      if (!NULL (h.var))
-        specbind (h.var, Fcdr (c.val));
-      val = Fprogn (Fcdr (Fcar (c.val)));
+      if (!NILP (h.var))
+        specbind (h.var, c.val);
+      val = Fprogn (Fcdr (h.chosen_clause));
+
+      /* Note that this just undoes the binding of h.var; whoever
+        longjumped to us unwound the stack to c.pdlcount before
+        throwing. */
       unbind_to (c.pdlcount, Qnil);
       return val;
     }
   c.next = catchlist;
   catchlist = &c;
-  h.var = Fcar (args);
-  h.handler = Fcdr (Fcdr (args));
-  
-  for (val = h.handler; ! NULL (val); val = Fcdr (val))
-    {
-      tem = Fcar (val);
-      if ((!NULL (tem)) &&
-         (!CONSP (tem) || (XTYPE (XCONS (tem)->car) != Lisp_Symbol)))
-       error ("Invalid condition handler", tem);
-    }
   
+  h.var = var;
+  h.handler = handlers;
   h.next = handlerlist;
-  h.poll_suppress_count = poll_suppress_count;
   h.tag = &c;
   handlerlist = &h;
 
-  val = Feval (Fcar (Fcdr (args)));
+  val = Feval (bodyform);
   catchlist = c.next;
   handlerlist = h.next;
   return val;
@@ -1031,13 +1078,12 @@ internal_condition_case (bfun, handlers, hfun)
   c.gcpro = gcprolist;
   if (_setjmp (c.jmp))
     {
-      return (*hfun) (Fcdr (c.val));
+      return (*hfun) (c.val);
     }
   c.next = catchlist;
   catchlist = &c;
   h.handler = handlers;
   h.var = Qnil;
-  h.poll_suppress_count = poll_suppress_count;
   h.next = handlerlist;
   h.tag = &c;
   handlerlist = &h;
@@ -1048,12 +1094,49 @@ internal_condition_case (bfun, handlers, hfun)
   return val;
 }
 
+Lisp_Object
+internal_condition_case_1 (bfun, arg, handlers, hfun)
+     Lisp_Object (*bfun) ();
+     Lisp_Object arg;
+     Lisp_Object handlers;
+     Lisp_Object (*hfun) ();
+{
+  Lisp_Object val;
+  struct catchtag c;
+  struct handler h;
+
+  c.tag = Qnil;
+  c.val = Qnil;
+  c.backlist = backtrace_list;
+  c.handlerlist = handlerlist;
+  c.lisp_eval_depth = lisp_eval_depth;
+  c.pdlcount = specpdl_ptr - specpdl;
+  c.poll_suppress_count = poll_suppress_count;
+  c.gcpro = gcprolist;
+  if (_setjmp (c.jmp))
+    {
+      return (*hfun) (c.val);
+    }
+  c.next = catchlist;
+  catchlist = &c;
+  h.handler = handlers;
+  h.var = Qnil;
+  h.next = handlerlist;
+  h.tag = &c;
+  handlerlist = &h;
+
+  val = (*bfun) (arg);
+  catchlist = c.next;
+  handlerlist = h.next;
+  return val;
+}
+\f
 static Lisp_Object find_handler_clause ();
 
 DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
-  "Signal an error.  Args are SIGNAL-NAME, and associated DATA.\n\
+  "Signal an error.  Args are ERROR-SYMBOL and associated DATA.\n\
 This function does not return.\n\n\
-A signal name is a symbol with an `error-conditions' property\n\
+An error symbol is a symbol with an `error-conditions' property\n\
 that is a list of condition names.\n\
 A handler for any of those names will get to handle this signal.\n\
 The symbol `error' should normally be one of them.\n\
@@ -1061,8 +1144,8 @@ The symbol `error' should normally be one of them.\n\
 DATA should be a list.  Its elements are printed as part of the error message.\n\
 If the signal is handled, DATA is made available to the handler.\n\
 See also the function `condition-case'.")
-  (sig, data)
-     Lisp_Object sig, data;
+  (error_symbol, data)
+     Lisp_Object error_symbol, data;
 {
   register struct handler *allhandlers = handlerlist;
   Lisp_Object conditions;
@@ -1075,15 +1158,17 @@ See also the function `condition-case'.")
   if (gc_in_progress || waiting_for_input)
     abort ();
 
+#ifdef HAVE_X_WINDOWS
   TOTALLY_UNBLOCK_INPUT;
+#endif
 
-  conditions = Fget (sig, Qerror_conditions);
+  conditions = Fget (error_symbol, Qerror_conditions);
 
   for (; handlerlist; handlerlist = handlerlist->next)
     {
       register Lisp_Object clause;
       clause = find_handler_clause (handlerlist->handler, conditions,
-                                   sig, data, &debugger_value);
+                                   error_symbol, data, &debugger_value);
 
 #if 0 /* Most callers are not prepared to handle gc if this returns.
         So, since this feature is not very useful, take it out.  */
@@ -1093,34 +1178,64 @@ See also the function `condition-case'.")
        return debugger_value;
 #else
       if (EQ (clause, Qlambda))
-       error ("Returning a value from an error is no longer supported");
+       {
+         /* We can't return values to code which signalled an error, but we
+            can continue code which has signalled a quit.  */
+         if (EQ (error_symbol, Qquit))
+           return Qnil;
+         else
+           error ("Cannot return from the debugger in an error");
+       }
 #endif
 
-      if (!NULL (clause))
+      if (!NILP (clause))
        {
+         Lisp_Object unwind_data;
          struct handler *h = handlerlist;
-         /* Restore the polling-suppression count.  */
-         if (h->poll_suppress_count > poll_suppress_count)
-           abort ();
-         while (h->poll_suppress_count < poll_suppress_count)
-           start_polling ();
+
          handlerlist = allhandlers;
-         unbind_catch (h->tag);
-         h->tag->val = Fcons (clause, Fcons (sig, data));
-         _longjmp (h->tag->jmp, 1);
+         if (data == memory_signal_data)
+           unwind_data = memory_signal_data;
+         else
+           unwind_data = Fcons (error_symbol, data);
+         h->chosen_clause = clause;
+         unwind_to_catch (h->tag, unwind_data);
        }
     }
 
   handlerlist = allhandlers;
   /* If no handler is present now, try to run the debugger,
      and if that fails, throw to top level.  */
-  find_handler_clause (Qerror, conditions, sig, data, &debugger_value);
+  find_handler_clause (Qerror, conditions, error_symbol, data, &debugger_value);
   Fthrow (Qtop_level, Qt);
 }
 
-/* Value of Qlambda means we have called debugger and
-   user has continued.  Store value returned fromdebugger
-   into *debugger_value_ptr */
+/* Return nonzero iff LIST is a non-nil atom or
+   a list containing one of CONDITIONS.  */
+
+static int
+wants_debugger (list, conditions)
+     Lisp_Object list, conditions;
+{
+  if (NILP (list))
+    return 0;
+  if (! CONSP (list))
+    return 1;
+
+  while (CONSP (conditions))
+    {
+      Lisp_Object this, tail;
+      this = XCONS (conditions)->car;
+      for (tail = list; CONSP (tail); tail = XCONS (tail)->cdr)
+       if (EQ (XCONS (tail)->car, this))
+         return 1;
+      conditions = XCONS (conditions)->cdr;
+    }
+  return 0;
+}
+
+/* Value of Qlambda means we have called debugger and user has continued.
+   Store value returned from debugger into *DEBUGGER_VALUE_PTR.  */
 
 static Lisp_Object
 find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr)
@@ -1129,16 +1244,17 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr)
 {
   register Lisp_Object h;
   register Lisp_Object tem;
-  register Lisp_Object tem1;
 
   if (EQ (handlers, Qt))  /* t is used by handlers for all conditions, set up by C code.  */
     return Qt;
   if (EQ (handlers, Qerror))  /* error is used similarly, but means display a backtrace too */
     {
-      if (stack_trace_on_error)
+      if (wants_debugger (Vstack_trace_on_error, conditions))
        internal_with_output_to_temp_buffer ("*Backtrace*", Fbacktrace, Qnil);
-      if (!entering_debugger
-         && EQ (sig, Qquit) ? debug_on_quit : debug_on_error)
+      if ((EQ (sig, Qquit)
+          ? debug_on_quit
+          : wants_debugger (Vdebug_on_error, conditions))
+         && when_entered_debugger < num_nonmacro_input_chars)
        {
          int count = specpdl_ptr - specpdl;
          specbind (Qdebug_on_error, Qnil);
@@ -1152,12 +1268,30 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr)
     }
   for (h = handlers; CONSP (h); h = Fcdr (h))
     {
-      tem1 = Fcar (h);
-      if (!CONSP (tem1))
+      Lisp_Object handler, condit;
+
+      handler = Fcar (h);
+      if (!CONSP (handler))
        continue;
-      tem = Fmemq (Fcar (tem1), conditions);
-      if (!NULL (tem))
-        return tem1;
+      condit = Fcar (handler);
+      /* Handle a single condition name in handler HANDLER.  */
+      if (SYMBOLP (condit))
+       {
+         tem = Fmemq (Fcar (handler), conditions);
+         if (!NILP (tem))
+           return handler;
+       }
+      /* Handle a list of condition names in handler HANDLER.  */
+      else if (CONSP (condit))
+       {
+         while (CONSP (condit))
+           {
+             tem = Fmemq (Fcar (condit), conditions);
+             if (!NILP (tem))
+               return handler;
+             condit = XCONS (condit)->cdr;
+           }
+       }
     }
   return Qnil;
 }
@@ -1168,12 +1302,38 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr)
 void
 error (m, a1, a2, a3)
      char *m;
+     char *a1, *a2, *a3;
 {
   char buf[200];
-  sprintf (buf, m, a1, a2, a3);
+  int size = 200;
+  int mlen;
+  char *buffer = buf;
+  char *args[3];
+  int allocated = 0;
+  Lisp_Object string;
+
+  args[0] = a1;
+  args[1] = a2;
+  args[2] = a3;
+
+  mlen = strlen (m);
 
   while (1)
-    Fsignal (Qerror, Fcons (build_string (buf), Qnil));
+    {
+      int used = doprnt (buf, size, m, m + mlen, 3, args);
+      if (used < size)
+       break;
+      size *= 2;
+      if (allocated)
+       buffer = (char *) xrealloc (buffer, size);
+      buffer = (char *) xmalloc (size);
+    }
+
+  string = build_string (buf);
+  if (allocated)
+    free (buffer);
+
+  Fsignal (Qerror, Fcons (string, Qnil));
 }
 \f
 DEFUN ("commandp", Fcommandp, Scommandp, 1, 1, 0,
@@ -1198,14 +1358,9 @@ Also, a symbol satisfies `commandp' if its function definition does so.")
 
   fun = function;
 
-  /* Dereference symbols, but avoid infinte loops.  Eech.  */
-  while (XTYPE (fun) == Lisp_Symbol)
-    {
-      if (++i > 10) return Qnil;
-      tem = Ffboundp (fun);
-      if (NULL (tem)) return Qnil;
-      fun = Fsymbol_function (fun);
-    }
+  fun = indirect_function (fun);
+  if (EQ (fun, Qunbound))
+    return Qnil;
 
   /* Emacs primitives are interactive if their DEFUN specifies an
      interactive spec.  */
@@ -1251,13 +1406,16 @@ DEFUN ("autoload", Fautoload, Sautoload, 2, 5, 0,
 FUNCTION is a symbol; FILE is a file name string to pass to `load'.\n\
 Third arg DOCSTRING is documentation for the function.\n\
 Fourth arg INTERACTIVE if non-nil says function can be called interactively.\n\
-Fifth arg MACRO if non-nil says the function is really a macro.\n\
+Fifth arg TYPE indicates the type of the object:\n\
+   nil or omitted says FUNCTION is a function,\n\
+   `keymap' says FUNCTION is really a keymap, and\n\
+   `macro' or t says FUNCTION is really a macro.\n\
 Third through fifth args give info about the real definition.\n\
 They default to nil.\n\
 If FUNCTION is already defined other than as an autoload,\n\
 this does nothing and returns nil.")
-  (function, file, docstring, interactive, macro)
-     Lisp_Object function, file, docstring, interactive, macro;
+  (function, file, docstring, interactive, type)
+     Lisp_Object function, file, docstring, interactive, type;
 {
 #ifdef NO_ARG_ARRAY
   Lisp_Object args[4];
@@ -1276,7 +1434,7 @@ this does nothing and returns nil.")
   args[0] = file;
   args[1] = docstring;
   args[2] = interactive;
-  args[3] = macro;
+  args[3] = type;
 
   return Ffset (function, Fcons (Qautoload, Flist (4, &args[0])));
 #else /* NO_ARG_ARRAY */
@@ -1312,7 +1470,7 @@ do_autoload (fundef, funname)
      Lisp_Object fundef, funname;
 {
   int count = specpdl_ptr - specpdl;
-  Lisp_Object fun, val;
+  Lisp_Object fun, val, queue, first, second;
 
   fun = funname;
   CHECK_SYMBOL (funname, 0);
@@ -1321,20 +1479,31 @@ do_autoload (fundef, funname)
   record_unwind_protect (un_autoload, Vautoload_queue);
   Vautoload_queue = Qt;
   Fload (Fcar (Fcdr (fundef)), Qnil, noninteractive ? Qt : Qnil, Qnil);
+
+  /* Save the old autoloads, in case we ever do an unload. */
+  queue = Vautoload_queue;
+  while (CONSP (queue))
+    {
+      first = Fcar (queue);
+      second = Fcdr (first);
+      first = Fcar (first);
+
+      /* 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);
+    }
+
   /* Once loading finishes, don't undo it.  */
   Vautoload_queue = Qt;
   unbind_to (count, Qnil);
 
-  while (XTYPE (fun) == Lisp_Symbol)
-    {
-      QUIT;
-      val = XSYMBOL (fun)->function;
-      if (EQ (val, Qunbound))
-       Fsymbol_function (fun); /* Get the right kind of error! */
-      fun = val;
-    }
-  if (XTYPE (fun) == Lisp_Cons
-      && EQ (XCONS (fun)->car, Qautoload))
+  fun = Findirect_function (fun);
+
+  if (!NILP (Fequal (fun, fundef)))
     error ("Autoloading failed to define function %s",
           XSYMBOL (funname)->name->data);
 }
@@ -1354,7 +1523,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
       if (EQ (Vmocklisp_arguments, Qt))
         return Fsymbol_value (form);
       val = Fsymbol_value (form);
-      if (NULL (val))
+      if (NILP (val))
        XFASTINT (val) = 0;
       else if (EQ (val, Qt))
        XFASTINT (val) = 1;
@@ -1396,15 +1565,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
   /* At this point, only original_fun and original_args
      have values that will be used below */
  retry:
-  fun = original_fun;
-  while (XTYPE (fun) == Lisp_Symbol)
-    {
-      QUIT;
-      val = XSYMBOL (fun)->function;
-      if (EQ (val, Qunbound))
-       Fsymbol_function (fun); /* Get the right kind of error! */
-      fun = val;
-    }
+  fun = Findirect_function (original_fun);
 
   if (XTYPE (fun) == Lisp_Subr)
     {
@@ -1439,18 +1600,18 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
          gcpro3.var = vals;
          gcpro3.nvars = 0;
 
-         while (!NULL (args_left))
+         while (!NILP (args_left))
            {
              vals[argnum++] = Feval (Fcar (args_left));
              args_left = Fcdr (args_left);
              gcpro3.nvars = argnum;
            }
-         UNGCPRO;
 
          backtrace.args = vals;
          backtrace.nargs = XINT (numargs);
 
          val = (*XSUBR (fun)->function) (XINT (numargs), vals);
+         UNGCPRO;
          goto done;
        }
 
@@ -1497,10 +1658,18 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
          val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
                                          argvals[3], argvals[4], argvals[5]);
          goto done;
+       case 7:
+         val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
+                                         argvals[3], argvals[4], argvals[5],
+                                         argvals[6]);
+         goto done;
 
        default:
-         error ("Ffuncall doesn't handle that number of arguments.");
-         goto done;
+         /* 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 ();
        }
     }
   if (XTYPE (fun) == Lisp_Compiled)
@@ -1529,7 +1698,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
  done:
   if (!EQ (Vmocklisp_arguments, Qt))
     {
-      if (NULL (val))
+      if (NILP (val))
        XFASTINT (val) = 0;
       else if (EQ (val, Qt))
        XFASTINT (val) = 1;
@@ -1552,6 +1721,7 @@ Thus, (apply '+ 1 2 '(3 4)) returns 10.")
   register Lisp_Object spread_arg;
   register Lisp_Object *funcall_args;
   Lisp_Object fun;
+  struct gcpro gcpro1;
 
   fun = args [0];
   funcall_args = 0;
@@ -1568,18 +1738,14 @@ Thus, (apply '+ 1 2 '(3 4)) returns 10.")
       return Ffuncall (nargs, args);
     }
 
-  numargs = nargs - 2 + numargs;
+  numargs += nargs - 2;
 
-  while (XTYPE (fun) == Lisp_Symbol)
+  fun = indirect_function (fun);
+  if (EQ (fun, Qunbound))
     {
-      QUIT;
-      fun = XSYMBOL (fun)->function;
-      if (EQ (fun, Qunbound))
-       {
-         /* Let funcall get the error */
-         fun = args[0];
-         goto funcall;
-       }
+      /* Let funcall get the error */
+      fun = args[0];
+      goto funcall;
     }
 
   if (XTYPE (fun) == Lisp_Subr)
@@ -1595,25 +1761,32 @@ Thus, (apply '+ 1 2 '(3 4)) returns 10.")
                                                 * sizeof (Lisp_Object));
          for (i = numargs; i < XSUBR (fun)->max_args;)
            funcall_args[++i] = Qnil;
+         GCPRO1 (*funcall_args);
+         gcpro1.nvars = 1 + XSUBR (fun)->max_args;
        }
     }
  funcall:
   /* We add 1 to numargs because funcall_args includes the
      function itself as well as its arguments.  */
   if (!funcall_args)
-    funcall_args = (Lisp_Object *) alloca ((1 + numargs)
-                                          * sizeof (Lisp_Object));
+    {
+      funcall_args = (Lisp_Object *) alloca ((1 + numargs)
+                                            * sizeof (Lisp_Object));
+      GCPRO1 (*funcall_args);
+      gcpro1.nvars = 1 + numargs;
+    }
+
   bcopy (args, funcall_args, nargs * sizeof (Lisp_Object));
   /* Spread the last arg we got.  Its first element goes in
      the slot that it used to occupy, hence this value of I.  */
   i = nargs - 1;
-  while (!NULL (spread_arg))
+  while (!NILP (spread_arg))
     {
       funcall_args [i++] = XCONS (spread_arg)->car;
       spread_arg = XCONS (spread_arg)->cdr;
     }
-  
-  return Ffuncall (numargs + 1, funcall_args);
+
+  RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args));
 }
 \f
 /* Apply fn to arg */
@@ -1621,17 +1794,22 @@ Lisp_Object
 apply1 (fn, arg)
      Lisp_Object fn, arg;
 {
-  if (NULL (arg))
-    return Ffuncall (1, &fn);
+  struct gcpro gcpro1;
+
+  GCPRO1 (fn);
+  if (NILP (arg))
+    RETURN_UNGCPRO (Ffuncall (1, &fn));
+  gcpro1.nvars = 2;
 #ifdef NO_ARG_ARRAY
   {
     Lisp_Object args[2];
     args[0] = fn;
     args[1] = arg;
-    return Fapply (2, args);
+    gcpro1.var = args;
+    RETURN_UNGCPRO (Fapply (2, args));
   }
 #else /* not NO_ARG_ARRAY */
-  return Fapply (2, &fn);
+  RETURN_UNGCPRO (Fapply (2, &fn));
 #endif /* not NO_ARG_ARRAY */
 }
 
@@ -1640,57 +1818,151 @@ Lisp_Object
 call0 (fn)
      Lisp_Object fn;
 {
-  return Ffuncall (1, &fn);
+  struct gcpro gcpro1;
+
+  GCPRO1 (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];
+  Lisp_Object args[2];  
+
   args[0] = fn;
-  args[1] = arg;
-  return Ffuncall (2, args);
+  args[1] = arg1;
+  GCPRO1 (args[0]);
+  gcpro1.nvars = 2;
+  RETURN_UNGCPRO (Ffuncall (2, args));
 #else /* not NO_ARG_ARRAY */
-  return Ffuncall (2, &fn);
+  GCPRO1 (fn);
+  gcpro1.nvars = 2;
+  RETURN_UNGCPRO (Ffuncall (2, &fn));
 #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;
-  return Ffuncall (3, args);
+  args[1] = arg1;
+  args[2] = arg2;
+  GCPRO1 (args[0]);
+  gcpro1.nvars = 3;
+  RETURN_UNGCPRO (Ffuncall (3, args));
 #else /* not NO_ARG_ARRAY */
-  return Ffuncall (3, &fn);
+  GCPRO1 (fn);
+  gcpro1.nvars = 3;
+  RETURN_UNGCPRO (Ffuncall (3, &fn));
 #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;
-  return Ffuncall (4, args);
+  args[1] = arg1;
+  args[2] = arg2;
+  args[3] = arg3;
+  GCPRO1 (args[0]);
+  gcpro1.nvars = 4;
+  RETURN_UNGCPRO (Ffuncall (4, args));
+#else /* not NO_ARG_ARRAY */
+  GCPRO1 (fn);
+  gcpro1.nvars = 4;
+  RETURN_UNGCPRO (Ffuncall (4, &fn));
+#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 */
-  return Ffuncall (4, &fn);
+  GCPRO1 (fn);
+  gcpro1.nvars = 7;
+  RETURN_UNGCPRO (Ffuncall (7, &fn));
 #endif /* not NO_ARG_ARRAY */
 }
 
@@ -1712,15 +1984,7 @@ Thus, (funcall 'cons 'x 'y) returns (x . y).")
 
   QUIT;
   if (consing_since_gc > gc_cons_threshold)
-    {
-      struct gcpro gcpro1;
-      
-      /* The backtrace protects the arguments for the rest of the function.  */
-      GCPRO1 (*args);
-      gcpro1.nvars = nargs;
-      Fgarbage_collect ();
-      UNGCPRO;
-    }
+    Fgarbage_collect ();
 
   if (++lisp_eval_depth > max_lisp_eval_depth)
     {
@@ -1744,14 +2008,8 @@ Thus, (funcall 'cons 'x 'y) returns (x . y).")
  retry:
 
   fun = args[0];
-  while (XTYPE (fun) == Lisp_Symbol)
-    {
-      QUIT;
-      val = XSYMBOL (fun)->function;
-      if (EQ (val, Qunbound))
-       Fsymbol_function (fun); /* Get the right kind of error! */
-      fun = val;
-    }
+
+  fun = Findirect_function (fun);
 
   if (XTYPE (fun) == Lisp_Subr)
     {
@@ -1811,9 +2069,19 @@ Thus, (funcall 'cons 'x 'y) returns (x . y).")
                                          internal_args[2], internal_args[3],
                                          internal_args[4], internal_args[5]);
          goto done;
+       case 7:
+         val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
+                                         internal_args[2], internal_args[3],
+                                         internal_args[4], internal_args[5],
+                                         internal_args[6]);
+         goto done;
 
        default:
-         error ("funcall: this number of args not handled.");
+
+         /* If a subr takes more than 6 arguments without using MANY
+            or UNEVALLED, we need to extend this function to support it. 
+            Until this is done, there is no way to call the function.  */
+         abort ();
        }
     }
   if (XTYPE (fun) == Lisp_Compiled)
@@ -1919,17 +2187,19 @@ funcall_lambda (fun, nargs, arg_vector)
   else abort ();
 
   i = 0;
-  for (; !NULL (syms_left); syms_left = Fcdr (syms_left))
+  for (; !NILP (syms_left); syms_left = Fcdr (syms_left))
     {
       QUIT;
       next = Fcar (syms_left);
+      while (XTYPE (next) != Lisp_Symbol)
+       next = Fsignal (Qinvalid_function, Fcons (fun, Qnil));
       if (EQ (next, Qand_rest))
        rest = 1;
       else if (EQ (next, Qand_optional))
        optional = 1;
       else if (rest)
        {
-         specbind (Fcar (syms_left), Flist (nargs - i, &arg_vector[i]));
+         specbind (next, Flist (nargs - i, &arg_vector[i]));
          i = nargs;
        }
       else if (i < nargs)
@@ -1965,9 +2235,11 @@ grow_specpdl ()
        max_specpdl_size = 400;
       if (specpdl_size >= max_specpdl_size)
        {
+         if (!NILP (Vdebug_on_error))
+           /* Leave room for some specpdl in the debugger.  */
+           max_specpdl_size = specpdl_size + 100;
          Fsignal (Qerror,
                   Fcons (build_string ("Variable binding depth exceeds max-specpdl-size"), Qnil));
-         max_specpdl_size *= 2;
        }
     }
   specpdl_size *= 2;
@@ -1984,6 +2256,8 @@ specbind (symbol, value)
   extern void store_symval_forwarding (); /* in eval.c */
   Lisp_Object ovalue;
 
+  CHECK_SYMBOL (symbol, 0);
+
   if (specpdl_ptr == specpdl + specpdl_size)
     grow_specpdl ();
   specpdl_ptr->symbol = symbol;
@@ -2015,7 +2289,7 @@ unbind_to (count, value)
      int count;
      Lisp_Object value;
 {
-  int quitf = !NULL (Vquit_flag);
+  int quitf = !NILP (Vquit_flag);
   struct gcpro gcpro1;
 
   GCPRO1 (value);
@@ -2029,12 +2303,12 @@ unbind_to (count, value)
        (*specpdl_ptr->func) (specpdl_ptr->old_value);
       /* Note that a "binding" of nil is really an unwind protect,
        so in that case the "old value" is a list of forms to evaluate.  */
-      else if (NULL (specpdl_ptr->symbol))
+      else if (NILP (specpdl_ptr->symbol))
        Fprogn (specpdl_ptr->old_value);
       else
         Fset (specpdl_ptr->symbol, specpdl_ptr->old_value);
     }
-  if (NULL (Vquit_flag) && quitf) Vquit_flag = Qt;
+  if (NILP (Vquit_flag) && quitf) Vquit_flag = Qt;
 
   UNGCPRO;
 
@@ -2098,7 +2372,7 @@ The debugger is entered when that frame exits, if the flag is non-nil.")
     }
 
   if (backlist)
-    backlist->debug_on_exit = !NULL (flag);
+    backlist->debug_on_exit = !NILP (flag);
 
   return flag;
 }
@@ -2115,8 +2389,6 @@ Output stream used is value of `standard-output'.")
   extern Lisp_Object Vprint_level;
   struct gcpro gcpro1;
 
-  entering_debugger = 0;
-
   XFASTINT (Vprint_level) = 3;
 
   tail = Qnil;
@@ -2137,7 +2409,7 @@ Output stream used is value of `standard-output'.")
          if (backlist->nargs == MANY)
            {
              for (tail = *backlist->args, i = 0;
-                  !NULL (tail);
+                  !NILP (tail);
                   tail = Fcdr (tail), i++)
                {
                  if (i) write_string (" ", -1);
@@ -2225,6 +2497,9 @@ To prevent this happening, set `quit-flag' to nil\n\
 before making `inhibit-quit' nil.");
   Vinhibit_quit = Qnil;
 
+  Qinhibit_quit = intern ("inhibit-quit");
+  staticpro (&Qinhibit_quit);
+
   Qautoload = intern ("autoload");
   staticpro (&Qautoload);
 
@@ -2254,16 +2529,20 @@ before making `inhibit-quit' nil.");
   Qand_optional = intern ("&optional");
   staticpro (&Qand_optional);
 
-  DEFVAR_BOOL ("stack-trace-on-error", &stack_trace_on_error,
+  DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error,
     "*Non-nil means automatically display a backtrace buffer\n\
-after any error that is handled by the editor command loop.");
-  stack_trace_on_error = 0;
+after any error that is handled by the editor command loop.\n\
+If the value is a list, an error only means to display a backtrace\n\
+if one of its condition symbols appears in the list.");
+  Vstack_trace_on_error = Qnil;
 
-  DEFVAR_BOOL ("debug-on-error", &debug_on_error,
+  DEFVAR_LISP ("debug-on-error", &Vdebug_on_error,
     "*Non-nil means enter debugger if an error is signaled.\n\
 Does not apply to errors handled by `condition-case'.\n\
+If the value is a list, an error only means to enter the debugger\n\
+if one of its condition symbols appears in the list.\n\
 See also variable `debug-on-quit'.");
-  debug_on_error = 0;
+  Vdebug_on_error = Qnil;
 
   DEFVAR_BOOL ("debug-on-quit", &debug_on_quit,
     "*Non-nil means enter debugger if quit is signaled (C-G, for example).\n\