More fixes for 'volatile' and setjmp/longjmp.
[bpt/emacs.git] / src / eval.c
index b531f79..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);
 }
@@ -1437,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)
@@ -1482,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.  */
@@ -1543,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.  */
@@ -1579,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.  */
@@ -1637,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))
@@ -1660,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;
@@ -1703,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;
@@ -1714,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
@@ -2032,7 +2041,7 @@ eval_sub (Lisp_Object form)
   struct gcpro gcpro1, gcpro2, gcpro3;
 
   if (handling_signal)
-    abort ();
+    emacs_abort ();
 
   if (SYMBOLP (form))
     {
@@ -2196,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 ();
            }
        }
     }
@@ -2217,7 +2226,18 @@ 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);
@@ -2696,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,
@@ -2852,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 ();
            }
        }
     }
@@ -2939,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))
     {
@@ -2983,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))
@@ -3124,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)
@@ -3140,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,
@@ -3157,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;
@@ -3174,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
@@ -3191,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 ();
     }
 }
 
@@ -3209,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++;
 }
 
@@ -3342,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
@@ -3469,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");
 
@@ -3484,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
@@ -3493,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,