]> code.delx.au - gnu-emacs/blobdiff - src/eval.c
(find_field): Fix comment.
[gnu-emacs] / src / eval.c
index 56fe670f1b17c20dc3a0c4faccdaffdbf6f3356c..20f29b5f06bfd1eb78f3e5ba46b37e32a7a252ce 100644 (file)
@@ -1,6 +1,6 @@
 /* Evaluator for GNU Emacs Lisp interpreter.
    Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1999, 2000, 2001,
-     2002, 2004, 2005 Free Software Foundation, Inc.
+                 2002, 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -103,7 +103,7 @@ Lisp_Object Vrun_hooks;
 /* Non-nil means record all fset's and provide's, to be undone
    if the file being autoloaded is not fully loaded.
    They are recorded by being consed onto the front of Vautoload_queue:
-   (FUN . ODEF) for a defun, (OFEATURES . nil) for a provide.  */
+   (FUN . ODEF) for a defun, (0 . OFEATURES) for a provide.  */
 
 Lisp_Object Vautoload_queue;
 
@@ -117,7 +117,7 @@ struct specbinding *specpdl;
 
 /* Pointer to first unused element in specpdl.  */
 
-volatile struct specbinding *specpdl_ptr;
+struct specbinding *specpdl_ptr;
 
 /* Maximum size allowed for specpdl allocation */
 
@@ -204,6 +204,7 @@ init_eval_once ()
   specpdl_size = 50;
   specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
   specpdl_ptr = specpdl;
+  /* Don't forget to update docs (lispref node "Local Variables").  */
   max_specpdl_size = 1000;
   max_lisp_eval_depth = 300;
 
@@ -618,7 +619,7 @@ interactive_p (exclude_subrs_p)
 
   /* If this isn't a byte-compiled function, there may be a frame at
      the top for Finteractive_p.  If so, skip it.  */
-  fun = Findirect_function (*btp->function);
+  fun = Findirect_function (*btp->function, Qnil);
   if (SUBRP (fun) && (XSUBR (fun) == &Sinteractive_p
                      || XSUBR (fun) == &Scalled_interactively_p))
     btp = btp->next;
@@ -639,7 +640,7 @@ interactive_p (exclude_subrs_p)
      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);
+  fun = Findirect_function (*btp->function, Qnil);
   if (exclude_subrs_p && SUBRP (fun))
     return 0;
 
@@ -1259,6 +1260,12 @@ unwind_to_catch (catch, value)
     }
   while (! last_time);
 
+#if HAVE_X_WINDOWS
+  /* If x_catch_errors was done, turn it off now.
+     (First we give unbind_to a chance to do that.)  */
+  x_fully_uncatch_errors ();
+#endif
+
   byte_stack_list = catch->byte_stack;
   gcprolist = catch->gcpro;
 #ifdef DEBUG_GCPRO
@@ -1343,15 +1350,28 @@ usage: (condition-case VAR BODYFORM &rest HANDLERS)  */)
      (args)
      Lisp_Object args;
 {
-  Lisp_Object val;
-  struct catchtag c;
-  struct handler h;
   register Lisp_Object bodyform, handlers;
   volatile Lisp_Object var;
 
   var      = Fcar (args);
   bodyform = Fcar (Fcdr (args));
   handlers = Fcdr (Fcdr (args));
+
+  return internal_lisp_condition_case (var, bodyform, handlers);
+}
+
+/* Like Fcondition_case, but the args are separate
+   rather than passed in a list.  Used by Fbyte_code.  */
+
+Lisp_Object
+internal_lisp_condition_case (var, bodyform, handlers)
+     volatile Lisp_Object var;
+     Lisp_Object bodyform, handlers;
+{
+  Lisp_Object val;
+  struct catchtag c;
+  struct handler h;
+
   CHECK_SYMBOL (var);
 
   for (val = handlers; CONSP (val); val = XCDR (val))
@@ -1422,8 +1442,10 @@ internal_condition_case (bfun, handlers, hfun)
   struct catchtag c;
   struct handler h;
 
-#if 0 /* We now handle interrupt_input_blocked properly.
-        What we still do not handle is exiting a signal handler.  */
+  /* Since Fsignal will close off all calls to x_catch_errors,
+     we will get the wrong results if some are not closed now.  */
+#if HAVE_X_WINDOWS
+  if (x_catching_errors ())
     abort ();
 #endif
 
@@ -1468,6 +1490,13 @@ internal_condition_case_1 (bfun, arg, handlers, hfun)
   struct catchtag c;
   struct handler h;
 
+  /* Since Fsignal will close off all calls to x_catch_errors,
+     we will get the wrong results if some are not closed now.  */
+#if HAVE_X_WINDOWS
+  if (x_catching_errors ())
+    abort ();
+#endif
+
   c.tag = Qnil;
   c.val = Qnil;
   c.backlist = backtrace_list;
@@ -1512,6 +1541,13 @@ internal_condition_case_2 (bfun, nargs, args, handlers, hfun)
   struct catchtag c;
   struct handler h;
 
+  /* Since Fsignal will close off all calls to x_catch_errors,
+     we will get the wrong results if some are not closed now.  */
+#if HAVE_X_WINDOWS
+  if (x_catching_errors ())
+    abort ();
+#endif
+
   c.tag = Qnil;
   c.val = Qnil;
   c.backlist = backtrace_list;
@@ -2009,8 +2045,8 @@ un_autoload (oldqueue)
       first = XCAR (queue);
       second = Fcdr (first);
       first = Fcar (first);
-      if (EQ (second, Qnil))
-       Vfeatures = first;
+      if (EQ (first, make_number (0)))
+       Vfeatures = second;
       else
        Ffset (first, second);
       queue = XCDR (queue);
@@ -2056,7 +2092,7 @@ do_autoload (fundef, funname)
       second = Fcdr (first);
       first = Fcar (first);
 
-      if (CONSP (second) && EQ (XCAR (second), Qautoload))
+      if (SYMBOLP (first) && CONSP (second) && EQ (XCAR (second), Qautoload))
        Fput (first, Qautoload, (XCDR (second)));
 
       queue = XCDR (queue);
@@ -2066,7 +2102,7 @@ do_autoload (fundef, funname)
   Vautoload_queue = Qt;
   unbind_to (count, Qnil);
 
-  fun = Findirect_function (fun);
+  fun = Findirect_function (fun, Qnil);
 
   if (!NILP (Fequal (fun, fundef)))
     error ("Autoloading failed to define function %s",
@@ -2094,8 +2130,10 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
     return form;
 
   QUIT;
-  if (consing_since_gc > gc_cons_threshold
-      && consing_since_gc > gc_relative_threshold)
+  if ((consing_since_gc > gc_cons_threshold
+       && consing_since_gc > gc_relative_threshold)
+      ||
+      (!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold))
     {
       GCPRO1 (form);
       Fgarbage_collect ();
@@ -2127,7 +2165,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 = Findirect_function (original_fun);
+  fun = Findirect_function (original_fun, Qnil);
 
   if (SUBRP (fun))
     {
@@ -2795,8 +2833,10 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
   register int i;
 
   QUIT;
-  if (consing_since_gc > gc_cons_threshold
-      && consing_since_gc > gc_relative_threshold)
+  if ((consing_since_gc > gc_cons_threshold
+       && consing_since_gc > gc_relative_threshold)
+      ||
+      (!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold))
     Fgarbage_collect ();
 
   if (++lisp_eval_depth > max_lisp_eval_depth)
@@ -2824,7 +2864,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
 
   fun = args[0];
 
-  fun = Findirect_function (fun);
+  fun = Findirect_function (fun, Qnil);
 
   if (SUBRP (fun))
     {
@@ -3182,6 +3222,8 @@ record_unwind_protect (function, arg)
      Lisp_Object (*function) P_ ((Lisp_Object));
      Lisp_Object arg;
 {
+  eassert (!handling_signal);
+
   if (specpdl_ptr == specpdl + specpdl_size)
     grow_specpdl ();
   specpdl_ptr->func = function;