More fixes for 'volatile' and setjmp/longjmp.
[bpt/emacs.git] / src / eval.c
index a0a05eb..3c0c65e 100644 (file)
@@ -69,7 +69,7 @@ Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp;
 Lisp_Object Qinhibit_quit;
 Lisp_Object Qand_rest;
 static Lisp_Object Qand_optional;
-static Lisp_Object Qdebug_on_error;
+static Lisp_Object Qinhibit_debugger;
 static Lisp_Object Qdeclare;
 Lisp_Object Qinternal_interpreter_environment, Qclosure;
 
@@ -131,9 +131,23 @@ int handling_signal;
 Lisp_Object inhibit_lisp_code;
 
 static Lisp_Object funcall_lambda (Lisp_Object, ptrdiff_t, Lisp_Object *);
-static int interactive_p (int);
+static bool interactive_p (void);
 static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args);
-\f
+
+/* Functions to set Lisp_Object slots of struct specbinding.  */
+
+static inline void
+set_specpdl_symbol (Lisp_Object symbol)
+{
+  specpdl_ptr->symbol = symbol;
+}
+
+static inline void
+set_specpdl_old_value (Lisp_Object oldval)
+{
+  specpdl_ptr->old_value = oldval;
+}
+
 void
 init_eval_once (void)
 {
@@ -177,10 +191,10 @@ restore_stack_limits (Lisp_Object data)
 
 /* Call the Lisp debugger, giving it argument ARG.  */
 
-static Lisp_Object
+Lisp_Object
 call_debugger (Lisp_Object arg)
 {
-  int debug_while_redisplaying;
+  bool debug_while_redisplaying;
   ptrdiff_t count = SPECPDL_INDEX ();
   Lisp_Object val;
   EMACS_INT old_max = max_specpdl_size;
@@ -215,7 +229,7 @@ call_debugger (Lisp_Object arg)
   specbind (intern ("debugger-may-continue"),
            debug_while_redisplaying ? Qnil : Qt);
   specbind (Qinhibit_redisplay, Qnil);
-  specbind (Qdebug_on_error, Qnil);
+  specbind (Qinhibit_debugger, Qt);
 
 #if 0 /* Binding this prevents execution of Lisp code during
         redisplay, which necessarily leads to display problems.  */
@@ -511,7 +525,7 @@ spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
 use `called-interactively-p'.  */)
   (void)
 {
-  return interactive_p (1) ? Qt : Qnil;
+  return interactive_p () ? Qt : Qnil;
 }
 
 
@@ -530,26 +544,23 @@ thinking of using it for any other purpose, it is quite likely that
 you're making a mistake.  Think: what do you want to do when the
 command is called from a keyboard macro?
 
-This function is meant for implementing advice and other
-function-modifying features.  Instead of using this, it is sometimes
-cleaner to give your function an extra optional argument whose
-`interactive' spec specifies non-nil unconditionally (\"p\" is a good
-way to do this), or via (not (or executing-kbd-macro noninteractive)).  */)
+Instead of using this function, it is sometimes cleaner to give your
+function an extra optional argument whose `interactive' spec specifies
+non-nil unconditionally (\"p\" is a good way to do this), or via
+\(not (or executing-kbd-macro noninteractive)).  */)
   (Lisp_Object kind)
 {
-  return ((INTERACTIVE || !EQ (kind, intern ("interactive")))
-         && interactive_p (1)) ? Qt : Qnil;
+  return (((INTERACTIVE || !EQ (kind, intern ("interactive")))
+          && interactive_p ())
+         ? Qt : Qnil);
 }
 
 
-/*  Return 1 if function in which this appears was called using
-    call-interactively.
-
-    EXCLUDE_SUBRS_P non-zero means always return 0 if the function
-    called is a built-in.  */
+/* Return true if function in which this appears was called using
+   call-interactively and is not a built-in.  */
 
-static int
-interactive_p (int exclude_subrs_p)
+static bool
+interactive_p (void)
 {
   struct backtrace *btp;
   Lisp_Object fun;
@@ -578,9 +589,9 @@ interactive_p (int exclude_subrs_p)
   /* `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.  */
+     (such as load or eval-region) return false.  */
   fun = Findirect_function (*btp->function, Qnil);
-  if (exclude_subrs_p && SUBRP (fun))
+  if (SUBRP (fun))
     return 0;
 
   /* `btp' points to the frame of a Lisp function that called interactive-p.
@@ -696,7 +707,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
       else
        { /* Check if there is really a global binding rather than just a let
             binding that shadows the global unboundness of the var.  */
-         volatile struct specbinding *pdl = specpdl_ptr;
+         struct specbinding *pdl = specpdl_ptr;
          while (pdl > specpdl)
            {
              if (EQ ((--pdl)->symbol, sym) && !pdl->func
@@ -1088,7 +1099,7 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object
 static _Noreturn void
 unwind_to_catch (struct catchtag *catch, Lisp_Object value)
 {
-  int last_time;
+  bool last_time;
 
   /* Save the value in the tag.  */
   catch->val = value;
@@ -1193,12 +1204,9 @@ See also the function `signal' for more info.
 usage: (condition-case VAR BODYFORM &rest HANDLERS)  */)
   (Lisp_Object args)
 {
-  register Lisp_Object bodyform, handlers;
-  volatile Lisp_Object var;
-
-  var      = Fcar (args);
-  bodyform = Fcar (Fcdr (args));
-  handlers = Fcdr (Fcdr (args));
+  Lisp_Object var = Fcar (args);
+  Lisp_Object bodyform = Fcar (Fcdr (args));
+  Lisp_Object handlers = Fcdr (Fcdr (args));
 
   return internal_lisp_condition_case (var, bodyform, handlers);
 }
@@ -1399,7 +1407,9 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
                           ptrdiff_t nargs,
                           Lisp_Object *args,
                           Lisp_Object handlers,
-                          Lisp_Object (*hfun) (Lisp_Object))
+                          Lisp_Object (*hfun) (Lisp_Object err,
+                                               ptrdiff_t nargs,
+                                               Lisp_Object *args))
 {
   Lisp_Object val;
   struct catchtag c;
@@ -1417,7 +1427,7 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
   c.byte_stack = byte_stack_list;
   if (_setjmp (c.jmp))
     {
-      return (*hfun) (c.val);
+      return (*hfun) (c.val, nargs, args);
     }
   c.next = catchlist;
   catchlist = &c;
@@ -1435,8 +1445,8 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *),
 
 \f
 static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object);
-static int maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
-                               Lisp_Object data);
+static bool maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig,
+                                Lisp_Object data);
 
 void
 process_quit_flag (void)
@@ -1480,7 +1490,7 @@ See also the function `condition-case'.  */)
   immediate_quit = handling_signal = 0;
   abort_on_gc = 0;
   if (gc_in_progress || waiting_for_input)
-    abort ();
+    emacs_abort ();
 
 #if 0 /* rms: I don't know why this was here,
         but it is surely wrong for an error that is handled.  */
@@ -1541,7 +1551,7 @@ See also the function `condition-case'.  */)
             if requested".  */
          || EQ (h->handler, Qerror)))
     {
-      int debugger_called
+      bool debugger_called
        = maybe_call_debugger (conditions, error_symbol, data);
       /* We can't return values to code which signaled an error, but we
         can continue code which has signaled a quit.  */
@@ -1577,7 +1587,7 @@ void
 xsignal (Lisp_Object error_symbol, Lisp_Object data)
 {
   Fsignal (error_symbol, data);
-  abort ();
+  emacs_abort ();
 }
 
 /* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list.  */
@@ -1635,10 +1645,10 @@ signal_error (const char *s, Lisp_Object arg)
 }
 
 
-/* Return nonzero if LIST is a non-nil atom or
+/* Return true if LIST is a non-nil atom or
    a list containing one of CONDITIONS.  */
 
-static int
+static bool
 wants_debugger (Lisp_Object list, Lisp_Object conditions)
 {
   if (NILP (list))
@@ -1658,15 +1668,15 @@ wants_debugger (Lisp_Object list, Lisp_Object conditions)
   return 0;
 }
 
-/* Return 1 if an error with condition-symbols CONDITIONS,
+/* Return true if an error with condition-symbols CONDITIONS,
    and described by SIGNAL-DATA, should skip the debugger
    according to debugger-ignored-errors.  */
 
-static int
+static bool
 skip_debugger (Lisp_Object conditions, Lisp_Object data)
 {
   Lisp_Object tail;
-  int first_string = 1;
+  bool first_string = 1;
   Lisp_Object error_message;
 
   error_message = Qnil;
@@ -1701,7 +1711,7 @@ skip_debugger (Lisp_Object conditions, Lisp_Object data)
     = SIG is the error symbol, and DATA is the rest of the data.
     = SIG is nil, and DATA is (SYMBOL . REST-OF-DATA).
       This is for memory-full errors only.  */
-static int
+static bool
 maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
 {
   Lisp_Object combined_data;
@@ -1712,6 +1722,7 @@ maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
       /* Don't try to run the debugger with interrupts blocked.
         The editing loop would return anyway.  */
       ! INPUT_BLOCKED_P
+      && NILP (Vinhibit_debugger)
       /* Does user want to enter debugger for this kind of error?  */
       && (EQ (sig, Qquit)
          ? debug_on_quit
@@ -2030,7 +2041,7 @@ eval_sub (Lisp_Object form)
   struct gcpro gcpro1, gcpro2, gcpro3;
 
   if (handling_signal)
-    abort ();
+    emacs_abort ();
 
   if (SYMBOLP (form))
     {
@@ -2094,7 +2105,7 @@ eval_sub (Lisp_Object form)
       args_left = original_args;
       numargs = Flength (args_left);
 
-      CHECK_CONS_LIST ();
+      check_cons_list ();
 
       if (XINT (numargs) < XSUBR (fun)->min_args
          || (XSUBR (fun)->max_args >= 0
@@ -2194,7 +2205,7 @@ eval_sub (Lisp_Object form)
                 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 ();
+             emacs_abort ();
            }
        }
     }
@@ -2215,14 +2226,25 @@ eval_sub (Lisp_Object form)
          goto retry;
        }
       if (EQ (funcar, Qmacro))
-       val = eval_sub (apply1 (Fcdr (fun), original_args));
+       {
+         ptrdiff_t count = SPECPDL_INDEX ();
+         Lisp_Object exp;
+         /* Bind lexical-binding during expansion of the macro, so the
+            macro can know reliably if the code it outputs will be
+            interpreted using lexical-binding or not.  */
+         specbind (Qlexical_binding,
+                   NILP (Vinternal_interpreter_environment) ? Qnil : Qt);
+         exp = apply1 (Fcdr (fun), original_args);
+         unbind_to (count, Qnil);
+         val = eval_sub (exp);
+       }
       else if (EQ (funcar, Qlambda)
               || EQ (funcar, Qclosure))
        val = apply_lambda (fun, original_args);
       else
        xsignal1 (Qinvalid_function, original_fun);
     }
-  CHECK_CONS_LIST ();
+  check_cons_list ();
 
   lisp_eval_depth--;
   if (backtrace.debug_on_exit)
@@ -2301,7 +2323,7 @@ usage: (apply FUNCTION &rest ARGUMENTS)  */)
       gcpro1.nvars = 1 + numargs;
     }
 
-  memcpy (funcall_args, args, nargs * sizeof (Lisp_Object));
+  memcpy (funcall_args, args, nargs * word_size);
   /* 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;
@@ -2694,33 +2716,9 @@ DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0,
        doc: /* Non-nil if OBJECT is a function.  */)
      (Lisp_Object object)
 {
-  if (SYMBOLP (object) && !NILP (Ffboundp (object)))
-    {
-      object = Findirect_function (object, Qt);
-
-      if (CONSP (object) && EQ (XCAR (object), Qautoload))
-       {
-         /* Autoloaded symbols are functions, except if they load
-            macros or keymaps.  */
-         int i;
-         for (i = 0; i < 4 && CONSP (object); i++)
-           object = XCDR (object);
-
-         return (CONSP (object) && !NILP (XCAR (object))) ? Qnil : Qt;
-       }
-    }
-
-  if (SUBRP (object))
-    return (XSUBR (object)->max_args != UNEVALLED) ? Qt : Qnil;
-  else if (COMPILEDP (object))
+  if (FUNCTIONP (object))
     return Qt;
-  else if (CONSP (object))
-    {
-      Lisp_Object car = XCAR (object);
-      return (EQ (car, Qlambda) || EQ (car, Qclosure)) ? Qt : Qnil;
-    }
-  else
-    return Qnil;
+  return Qnil;
 }
 
 DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
@@ -2762,7 +2760,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
   if (debug_on_next_call)
     do_debug_on_call (Qlambda);
 
-  CHECK_CONS_LIST ();
+  check_cons_list ();
 
   original_fun = args[0];
 
@@ -2794,7 +2792,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
            {
              internal_args = alloca (XSUBR (fun)->max_args
                                      * sizeof *internal_args);
-             memcpy (internal_args, args + 1, numargs * sizeof (Lisp_Object));
+             memcpy (internal_args, args + 1, numargs * word_size);
              for (i = numargs; i < XSUBR (fun)->max_args; i++)
                internal_args[i] = Qnil;
            }
@@ -2850,7 +2848,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
              /* If a subr takes more than 8 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 ();
+             emacs_abort ();
            }
        }
     }
@@ -2871,13 +2869,13 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
       else if (EQ (funcar, Qautoload))
        {
          Fautoload_do_load (fun, original_fun, Qnil);
-         CHECK_CONS_LIST ();
+         check_cons_list ();
          goto retry;
        }
       else
        xsignal1 (Qinvalid_function, original_fun);
     }
-  CHECK_CONS_LIST ();
+  check_cons_list ();
   lisp_eval_depth--;
   if (backtrace.debug_on_exit)
     val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
@@ -2937,7 +2935,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
   Lisp_Object val, syms_left, next, lexenv;
   ptrdiff_t count = SPECPDL_INDEX ();
   ptrdiff_t i;
-  int optional, rest;
+  bool optional, rest;
 
   if (CONSP (fun))
     {
@@ -2981,7 +2979,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs,
       lexenv = Qnil;
     }
   else
-    abort ();
+    emacs_abort ();
 
   i = optional = rest = 0;
   for (; CONSP (syms_left); syms_left = XCDR (syms_left))
@@ -3122,8 +3120,8 @@ specbind (Lisp_Object symbol, Lisp_Object value)
     case SYMBOL_PLAINVAL:
       /* The most common case is that of a non-constant symbol with a
         trivial value.  Make that as fast as we can.  */
-      specpdl_ptr->symbol = symbol;
-      specpdl_ptr->old_value = SYMBOL_VAL (sym);
+      set_specpdl_symbol (symbol);
+      set_specpdl_old_value (SYMBOL_VAL (sym));
       specpdl_ptr->func = NULL;
       ++specpdl_ptr;
       if (!sym->constant)
@@ -3138,7 +3136,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
       {
        Lisp_Object ovalue = find_symbol_value (symbol);
        specpdl_ptr->func = 0;
-       specpdl_ptr->old_value = ovalue;
+       set_specpdl_old_value (ovalue);
 
        eassert (sym->redirect != SYMBOL_LOCALIZED
                 || (EQ (SYMBOL_BLV (sym)->where,
@@ -3155,12 +3153,12 @@ specbind (Lisp_Object symbol, Lisp_Object value)
            if (!NILP (Flocal_variable_p (symbol, Qnil)))
              {
                eassert (sym->redirect != SYMBOL_LOCALIZED
-                        || (BLV_FOUND (SYMBOL_BLV (sym))
+                        || (blv_found (SYMBOL_BLV (sym))
                             && EQ (cur_buf, SYMBOL_BLV (sym)->where)));
                where = cur_buf;
              }
            else if (sym->redirect == SYMBOL_LOCALIZED
-                    && BLV_FOUND (SYMBOL_BLV (sym)))
+                    && blv_found (SYMBOL_BLV (sym)))
              where = SYMBOL_BLV (sym)->where;
            else
              where = Qnil;
@@ -3172,7 +3170,7 @@ specbind (Lisp_Object symbol, Lisp_Object value)
               let_shadows_buffer_binding_p which is itself only used
               in set_internal for local_if_set.  */
            eassert (NILP (where) || EQ (where, cur_buf));
-           specpdl_ptr->symbol = Fcons (symbol, Fcons (where, cur_buf));
+           set_specpdl_symbol (Fcons (symbol, Fcons (where, cur_buf)));
 
            /* If SYMBOL is a per-buffer variable which doesn't have a
               buffer-local value here, make the `let' change the global
@@ -3189,13 +3187,13 @@ specbind (Lisp_Object symbol, Lisp_Object value)
              }
          }
        else
-         specpdl_ptr->symbol = symbol;
+         set_specpdl_symbol (symbol);
 
        specpdl_ptr++;
        set_internal (symbol, value, Qnil, 1);
        break;
       }
-    default: abort ();
+    default: emacs_abort ();
     }
 }
 
@@ -3207,8 +3205,8 @@ record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
   if (specpdl_ptr == specpdl + specpdl_size)
     grow_specpdl ();
   specpdl_ptr->func = function;
-  specpdl_ptr->symbol = Qnil;
-  specpdl_ptr->old_value = arg;
+  set_specpdl_symbol (Qnil);
+  set_specpdl_old_value (arg);
   specpdl_ptr++;
 }
 
@@ -3340,13 +3338,13 @@ Output stream used is value of `standard-output'.  */)
          write_string ("(", -1);
          if (backlist->nargs == MANY)
            {                   /* FIXME: Can this happen?  */
-             int i;
-             for (tail = *backlist->args, i = 0;
-                  !NILP (tail);
-                  tail = Fcdr (tail), i = 1)
+             bool later_arg = 0;
+             for (tail = *backlist->args; !NILP (tail); tail = Fcdr (tail))
                {
-                 if (i) write_string (" ", -1);
+                 if (later_arg)
+                   write_string (" ", -1);
                  Fprin1 (Fcar (tail), Qnil);
+                 later_arg = 1;
                }
            }
          else
@@ -3467,7 +3465,7 @@ before making `inhibit-quit' nil.  */);
 
   DEFSYM (Qinhibit_quit, "inhibit-quit");
   DEFSYM (Qautoload, "autoload");
-  DEFSYM (Qdebug_on_error, "debug-on-error");
+  DEFSYM (Qinhibit_debugger, "inhibit-debugger");
   DEFSYM (Qmacro, "macro");
   DEFSYM (Qdeclare, "declare");
 
@@ -3482,6 +3480,12 @@ before making `inhibit-quit' nil.  */);
   DEFSYM (Qclosure, "closure");
   DEFSYM (Qdebug, "debug");
 
+  DEFVAR_LISP ("inhibit-debugger", Vinhibit_debugger,
+              doc: /* Non-nil means never enter the debugger.
+Normally set while the debugger is already active, to avoid recursive
+invocations.  */);
+  Vinhibit_debugger = Qnil;
+
   DEFVAR_LISP ("debug-on-error", Vdebug_on_error,
               doc: /* Non-nil means enter debugger if an error is signaled.
 Does not apply to errors handled by `condition-case' or those
@@ -3491,7 +3495,7 @@ if one of its condition symbols appears in the list.
 When you evaluate an expression interactively, this variable
 is temporarily non-nil if `eval-expression-debug-on-error' is non-nil.
 The command `toggle-debug-on-error' toggles this.
-See also the variable `debug-on-quit'.  */);
+See also the variable `debug-on-quit' and `inhibit-debugger'.  */);
   Vdebug_on_error = Qnil;
 
   DEFVAR_LISP ("debug-ignored-errors", Vdebug_ignored_errors,