]> code.delx.au - gnu-emacs/blobdiff - src/eval.c
[DEBUG_GCPRO] (gcpro_level): New variable.
[gnu-emacs] / src / eval.c
index b7e29f068c9262c9572df877cd771bfba142cf83..4245f72c0ed0685681ac9055ddb00d1e3ca0dc46 100644 (file)
@@ -1,5 +1,5 @@
 /* Evaluator for GNU Emacs Lisp interpreter.
-   Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995 Free Software Foundation, Inc.
+   Copyright (C) 1985, 86, 87, 93, 94, 95, 1999 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -21,10 +21,6 @@ Boston, MA 02111-1307, USA.  */
 
 #include <config.h>
 
-#ifdef STDC_HEADERS
-#include <stdlib.h>
-#endif
-
 #include "lisp.h"
 #include "blockinput.h"
 
@@ -89,6 +85,11 @@ struct catchtag
 
 struct catchtag *catchlist;
 
+#ifdef DEBUG_GCPRO
+/* Count levels of GCPRO to detect failure to UNGCPRO.  */
+int gcpro_level;
+#endif
+
 Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
 Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag;
 Lisp_Object Qmocklisp_arguments, Vmocklisp_arguments, Qmocklisp;
@@ -189,6 +190,7 @@ init_eval ()
   Vquit_flag = Qnil;
   debug_on_next_call = 0;
   lisp_eval_depth = 0;
+  gcpro_level = 0;
   /* This is less than the initial value of num_nonmacro_input_events.  */
   when_entered_debugger = -1;
 }
@@ -322,11 +324,11 @@ CONDITION's value if non-nil is returned from the cond-form.")
       val = Feval (Fcar (clause));
       if (!NILP (val))
        {
-         if (!EQ (XCONS (clause)->cdr, Qnil))
-           val = Fprogn (XCONS (clause)->cdr);
+         if (!EQ (XCDR (clause), Qnil))
+           val = Fprogn (XCDR (clause));
          break;
        }
-      args = XCONS (args)->cdr;
+      args = XCDR (args);
     }
   UNGCPRO;
 
@@ -670,9 +672,9 @@ for the variable is `*'.")
     return Qt;
   /* If it is (STRING . INTEGER), a negative integer means a user variable.  */
   if (CONSP (documentation)
-      && STRINGP (XCONS (documentation)->car)
-      && INTEGERP (XCONS (documentation)->cdr)
-      && XINT (XCONS (documentation)->cdr) < 0)
+      && STRINGP (XCAR (documentation))
+      && INTEGERP (XCDR (documentation))
+      && XINT (XCDR (documentation)) < 0)
     return Qt;
   return Qnil;
 }  
@@ -818,7 +820,7 @@ definitions to shadow the loaded ones for use in file byte-compilation.")
       if (!CONSP (form))
        break;
       /* Set SYM, give DEF and TEM right values in case SYM is not a symbol. */
-      def = sym = XCONS (form)->car;
+      def = sym = XCAR (form);
       tem = Qnil;
       /* Trace symbols aliases to other symbols
         until we get a symbol that is not an alias.  */
@@ -844,7 +846,7 @@ definitions to shadow the loaded ones for use in file byte-compilation.")
          if (EQ (def, Qunbound) || !CONSP (def))
            /* Not defined or definition not suitable */
            break;
-         if (EQ (XCONS (def)->car, Qautoload))
+         if (EQ (XCAR (def), Qautoload))
            {
              /* Autoloading function: will it be a macro when loaded?  */
              tem = Fnth (make_number (4), def);
@@ -860,17 +862,17 @@ definitions to shadow the loaded ones for use in file byte-compilation.")
              else
                break;
            }
-         else if (!EQ (XCONS (def)->car, Qmacro))
+         else if (!EQ (XCAR (def), Qmacro))
            break;
-         else expander = XCONS (def)->cdr;
+         else expander = XCDR (def);
        }
       else
        {
-         expander = XCONS (tem)->cdr;
+         expander = XCDR (tem);
          if (NILP (expander))
            break;
        }
-      form = apply1 (expander, XCONS (form)->cdr);
+      form = apply1 (expander, XCDR (form));
     }
   return form;
 }
@@ -971,6 +973,12 @@ unwind_to_catch (catch, value)
   while (! last_time);
 
   gcprolist = catch->gcpro;
+#ifdef DEBUG_GCPRO
+  if (gcprolist != 0)
+    gcpro_level = gcprolist->level + 1;
+  else
+    gcpro_level = 0;
+#endif
   backtrace_list = catch->backlist;
   lisp_eval_depth = catch->lisp_eval_depth;
   
@@ -1062,8 +1070,8 @@ See also the function `signal' for more info.")
       tem = Fcar (val);
       if (! (NILP (tem)
             || (CONSP (tem)
-                && (SYMBOLP (XCONS (tem)->car)
-                    || CONSP (XCONS (tem)->car)))))
+                && (SYMBOLP (XCAR (tem))
+                    || CONSP (XCAR (tem))))))
        error ("Invalid condition handler", tem);
     }
 
@@ -1217,7 +1225,6 @@ See also the function `condition-case'.")
   Lisp_Object debugger_value;
   Lisp_Object string;
   Lisp_Object real_error_symbol;
-  Lisp_Object combined_data;
   extern int display_busy_cursor_p;
 
   immediate_quit = 0;
@@ -1311,11 +1318,11 @@ wants_debugger (list, conditions)
   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))
+      this = XCAR (conditions);
+      for (tail = list; CONSP (tail); tail = XCDR (tail))
+       if (EQ (XCAR (tail), this))
          return 1;
-      conditions = XCONS (conditions)->cdr;
+      conditions = XCDR (conditions);
     }
   return 0;
 }
@@ -1333,16 +1340,16 @@ skip_debugger (conditions, data)
   Lisp_Object error_message;
 
   for (tail = Vdebug_ignored_errors; CONSP (tail);
-       tail = XCONS (tail)->cdr)
+       tail = XCDR (tail))
     {
-      if (STRINGP (XCONS (tail)->car))
+      if (STRINGP (XCAR (tail)))
        {
          if (first_string)
            {
              error_message = Ferror_message_string (data);
              first_string = 0;
            }
-         if (fast_string_match (XCONS (tail)->car, error_message) >= 0)
+         if (fast_string_match (XCAR (tail), error_message) >= 0)
            return 1;
        }
       else
@@ -1350,8 +1357,8 @@ skip_debugger (conditions, data)
          Lisp_Object contail;
 
          for (contail = conditions; CONSP (contail);
-              contail = XCONS (contail)->cdr)
-           if (EQ (XCONS (tail)->car, XCONS (contail)->car))
+              contail = XCDR (contail))
+           if (EQ (XCAR (tail), XCAR (contail)))
              return 1;
        }
     }
@@ -1458,7 +1465,7 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr)
              tem = Fmemq (Fcar (condit), conditions);
              if (!NILP (tem))
                return handler;
-             condit = XCONS (condit)->cdr;
+             condit = XCDR (condit);
            }
        }
     }
@@ -1526,8 +1533,6 @@ Also, a symbol satisfies `commandp' if its function definition does so.")
 {
   register Lisp_Object fun;
   register Lisp_Object funcar;
-  register Lisp_Object tem;
-  register int i = 0;
 
   fun = function;
 
@@ -1599,7 +1604,7 @@ this does nothing and returns nil.")
   /* If function is defined and not as an autoload, don't override */
   if (!EQ (XSYMBOL (function)->function, Qunbound)
       && !(CONSP (XSYMBOL (function)->function)
-          && EQ (XCONS (XSYMBOL (function)->function)->car, Qautoload)))
+          && EQ (XCAR (XSYMBOL (function)->function), Qautoload)))
     return Qnil;
 
 #ifdef NO_ARG_ARRAY
@@ -1647,7 +1652,7 @@ do_autoload (fundef, funname)
      Lisp_Object fundef, funname;
 {
   int count = specpdl_ptr - specpdl;
-  Lisp_Object fun, val, queue, first, second;
+  Lisp_Object fun, queue, first, second;
   struct gcpro gcpro1, gcpro2, gcpro3;
 
   fun = funname;
@@ -1929,7 +1934,7 @@ Thus, (apply '+ 1 2 '(3 4)) returns 10.")
     return Ffuncall (nargs - 1, args);
   else if (numargs == 1)
     {
-      args [nargs - 1] = XCONS (spread_arg)->car;
+      args [nargs - 1] = XCAR (spread_arg);
       return Ffuncall (nargs, args);
     }
 
@@ -1977,8 +1982,8 @@ Thus, (apply '+ 1 2 '(3 4)) returns 10.")
   i = nargs - 1;
   while (!NILP (spread_arg))
     {
-      funcall_args [i++] = XCONS (spread_arg)->car;
-      spread_arg = XCONS (spread_arg)->cdr;
+      funcall_args [i++] = XCAR (spread_arg);
+      spread_arg = XCDR (spread_arg);
     }
 
   RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args));
@@ -2101,7 +2106,7 @@ run_hook_with_args (nargs, args, cond)
 
   if (EQ (val, Qunbound) || NILP (val))
     return ret;
-  else if (!CONSP (val) || EQ (XCONS (val)->car, Qlambda))
+  else if (!CONSP (val) || EQ (XCAR (val), Qlambda))
     {
       args[0] = val;
       return Ffuncall (nargs, args);
@@ -2115,9 +2120,9 @@ run_hook_with_args (nargs, args, cond)
           CONSP (val) && ((cond == to_completion)
                           || (cond == until_success ? NILP (ret)
                               : !NILP (ret)));
-          val = XCONS (val)->cdr)
+          val = XCDR (val))
        {
-         if (EQ (XCONS (val)->car, Qt))
+         if (EQ (XCAR (val), Qt))
            {
              /* t indicates this hook has a local binding;
                 it means to run the global binding too.  */
@@ -2126,9 +2131,9 @@ run_hook_with_args (nargs, args, cond)
                   CONSP (globals) && ((cond == to_completion)
                                       || (cond == until_success ? NILP (ret)
                                           : !NILP (ret)));
-                  globals = XCONS (globals)->cdr)
+                  globals = XCDR (globals))
                {
-                 args[0] = XCONS (globals)->car;
+                 args[0] = XCAR (globals);
                  /* In a global value, t should not occur.  If it does, we
                     must ignore it to avoid an endless loop.  */
                  if (!EQ (args[0], Qt))
@@ -2137,7 +2142,7 @@ run_hook_with_args (nargs, args, cond)
            }
          else
            {
-             args[0] = XCONS (val)->car;
+             args[0] = XCAR (val);
              ret = Ffuncall (nargs, args);
            }
        }
@@ -2169,18 +2174,18 @@ run_hook_list_with_args (funlist, nargs, args)
   globals = Qnil;
   GCPRO3 (sym, val, globals);
 
-  for (val = funlist; CONSP (val); val = XCONS (val)->cdr)
+  for (val = funlist; CONSP (val); val = XCDR (val))
     {
-      if (EQ (XCONS (val)->car, Qt))
+      if (EQ (XCAR (val), Qt))
        {
          /* t indicates this hook has a local binding;
             it means to run the global binding too.  */
 
          for (globals = Fdefault_value (sym);
               CONSP (globals);
-              globals = XCONS (globals)->cdr)
+              globals = XCDR (globals))
            {
-             args[0] = XCONS (globals)->car;
+             args[0] = XCAR (globals);
              /* In a global value, t should not occur.  If it does, we
                 must ignore it to avoid an endless loop.  */
              if (!EQ (args[0], Qt))
@@ -2189,7 +2194,7 @@ run_hook_list_with_args (funlist, nargs, args)
        }
       else
        {
-         args[0] = XCONS (val)->car;
+         args[0] = XCAR (val);
          Ffuncall (nargs, args);
        }
     }
@@ -2675,8 +2680,8 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
       tem = read_doc_string (XVECTOR (object)->contents[COMPILED_BYTECODE]);
       if (!CONSP (tem))
        error ("invalid byte code");
-      XVECTOR (object)->contents[COMPILED_BYTECODE] = XCONS (tem)->car;
-      XVECTOR (object)->contents[COMPILED_CONSTANTS] = XCONS (tem)->cdr;
+      XVECTOR (object)->contents[COMPILED_BYTECODE] = XCAR (tem);
+      XVECTOR (object)->contents[COMPILED_CONSTANTS] = XCDR (tem);
     }
   return object;
 }