X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/377127ce1248b5f148ae349cc50944c032fcf7be..0087ade67a7c8e31b32579a353381fb00b53a112:/src/eval.c diff --git a/src/eval.c b/src/eval.c index a933e05d4b..f911433e71 100644 --- a/src/eval.c +++ b/src/eval.c @@ -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 -#ifdef STDC_HEADERS -#include -#endif - #include "lisp.h" #include "blockinput.h" @@ -85,10 +81,16 @@ struct catchtag int lisp_eval_depth; int pdlcount; int poll_suppress_count; + struct byte_stack *byte_stack; }; 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 +191,9 @@ init_eval () Vquit_flag = Qnil; debug_on_next_call = 0; lisp_eval_depth = 0; +#ifdef DEBUG_GCPRO + gcpro_level = 0; +#endif /* This is less than the initial value of num_nonmacro_input_events. */ when_entered_debugger = -1; } @@ -322,11 +327,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; @@ -623,18 +628,11 @@ If INITVALUE is missing, SYMBOL's value is not set.") 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\ +The intent is that neither programs nor users should ever change this value.\n\ Always sets the value of SYMBOL to the result of evalling INITVALUE.\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\ -Note: do not use `defconst' for user options in libraries that are not\n\ -normally loaded, since it is useful for users to be able to specify\n\ -their own values for such variables before loading the library.\n\ -Since `defconst' unconditionally assigns the variable,\n\ -it would override the user's choice.") +DOCSTRING is optional.") (args) Lisp_Object args; { @@ -677,9 +675,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; } @@ -825,7 +823,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. */ @@ -851,7 +849,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); @@ -867,17 +865,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; } @@ -925,6 +923,7 @@ internal_catch (tag, func, arg) c.pdlcount = specpdl_ptr - specpdl; c.poll_suppress_count = poll_suppress_count; c.gcpro = gcprolist; + c.byte_stack = byte_stack_list; catchlist = &c; /* Call FUNC. */ @@ -977,7 +976,14 @@ unwind_to_catch (catch, value) } while (! last_time); + byte_stack_list = catch->byte_stack; 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; @@ -1069,8 +1075,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); } @@ -1082,6 +1088,7 @@ See also the function `signal' for more info.") c.pdlcount = specpdl_ptr - specpdl; c.poll_suppress_count = poll_suppress_count; c.gcpro = gcprolist; + c.byte_stack = byte_stack_list; if (_setjmp (c.jmp)) { if (!NILP (h.var)) @@ -1142,6 +1149,7 @@ internal_condition_case (bfun, handlers, hfun) c.pdlcount = specpdl_ptr - specpdl; c.poll_suppress_count = poll_suppress_count; c.gcpro = gcprolist; + c.byte_stack = byte_stack_list; if (_setjmp (c.jmp)) { return (*hfun) (c.val); @@ -1181,6 +1189,7 @@ internal_condition_case_1 (bfun, arg, handlers, hfun) c.pdlcount = specpdl_ptr - specpdl; c.poll_suppress_count = poll_suppress_count; c.gcpro = gcprolist; + c.byte_stack = byte_stack_list; if (_setjmp (c.jmp)) { return (*hfun) (c.val); @@ -1215,6 +1224,8 @@ See also the function `condition-case'.") (error_symbol, data) Lisp_Object error_symbol, data; { + /* When memory is full, ERROR-SYMBOL is nil, + and DATA is (REAL-ERROR-SYMBOL . REAL-DATA). */ register struct handler *allhandlers = handlerlist; Lisp_Object conditions; extern int gc_in_progress; @@ -1222,9 +1233,8 @@ 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; - quit_error_check (); immediate_quit = 0; if (gc_in_progress || waiting_for_input) abort (); @@ -1236,6 +1246,11 @@ See also the function `condition-case'.") else real_error_symbol = error_symbol; +#ifdef HAVE_X_WINDOWS + if (display_busy_cursor_p) + Fx_hide_busy_cursor (Qt); +#endif + /* This hook is used by edebug. */ if (! NILP (Vsignal_hook_function)) call2 (Vsignal_hook_function, error_symbol, data); @@ -1311,11 +1326,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 +1348,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 +1365,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; } } @@ -1361,8 +1376,9 @@ skip_debugger (conditions, data) /* Value of Qlambda means we have called debugger and user has continued. There are two ways to pass SIG and DATA: - - SIG is the error symbol, and DATA is the rest of the 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. Store value returned from debugger into *DEBUGGER_VALUE_PTR. */ @@ -1385,11 +1401,16 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr) int count = specpdl_ptr - specpdl; int debugger_called = 0; Lisp_Object sig_symbol, combined_data; + /* This is set to 1 if we are handling a memory-full error, + because these must not run the debugger. + (There is no room in memory to do that!) */ + int no_debugger = 0; if (NILP (sig)) { combined_data = data; sig_symbol = Fcar (data); + no_debugger = 1; } else { @@ -1408,9 +1429,10 @@ find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr) Fbacktrace, Qnil); #endif } - if ((EQ (sig_symbol, Qquit) - ? debug_on_quit - : wants_debugger (Vdebug_on_error, conditions)) + if (! no_debugger + && (EQ (sig_symbol, Qquit) + ? debug_on_quit + : wants_debugger (Vdebug_on_error, conditions)) && ! skip_debugger (conditions, combined_data) && when_entered_debugger < num_nonmacro_input_events) { @@ -1451,7 +1473,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); } } } @@ -1519,8 +1541,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; @@ -1592,7 +1612,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 @@ -1640,19 +1660,22 @@ 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; CHECK_SYMBOL (funname, 0); GCPRO3 (fun, funname, fundef); - /* Value saved here is to be restored into Vautoload_queue */ + /* Preserve the match data. */ + record_unwind_protect (Fset_match_data, Fmatch_data (Qnil, Qnil)); + + /* Value saved here is to be restored into Vautoload_queue. */ record_unwind_protect (un_autoload, Vautoload_queue); Vautoload_queue = Qt; Fload (Fcar (Fcdr (fundef)), Qnil, noninteractive ? Qt : Qnil, Qnil, Qt); - /* Save the old autoloads, in case we ever do an unload. */ + /* Save the old autoloads, in case we ever do an unload. */ queue = Vautoload_queue; while (CONSP (queue)) { @@ -1662,7 +1685,7 @@ do_autoload (fundef, funname) /* 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. */ + or fset. */ if (CONSP (second)) Fput (first, Qautoload, (Fcdr (second))); @@ -1691,6 +1714,11 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, struct backtrace backtrace; struct gcpro gcpro1, gcpro2, gcpro3; + /* Since Fsignal resets this to 0, it had better be 0 now + or else we have a potential bug. */ + if (interrupt_input_blocked != 0) + abort (); + if (SYMBOLP (form)) { if (EQ (Vmocklisp_arguments, Qt)) @@ -1914,7 +1942,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); } @@ -1962,8 +1990,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)); @@ -2072,7 +2100,8 @@ run_hook_with_args (nargs, args, cond) enum run_hooks_condition cond; { Lisp_Object sym, val, ret; - struct gcpro gcpro1, gcpro2; + Lisp_Object globals; + struct gcpro gcpro1, gcpro2, gcpro3; /* If we are dying or still initializing, don't do anything--it would probably crash if we tried. */ @@ -2085,34 +2114,34 @@ 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); } else { - GCPRO2 (sym, val); + globals = Qnil; + GCPRO3 (sym, val, globals); for (; 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. */ - Lisp_Object globals; for (globals = Fdefault_value (sym); 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)) @@ -2121,7 +2150,7 @@ run_hook_with_args (nargs, args, cond) } else { - args[0] = XCONS (val)->car; + args[0] = XCAR (val); ret = Ffuncall (nargs, args); } } @@ -2146,24 +2175,25 @@ run_hook_list_with_args (funlist, nargs, args) { Lisp_Object sym; Lisp_Object val; - struct gcpro gcpro1, gcpro2; + Lisp_Object globals; + struct gcpro gcpro1, gcpro2, gcpro3; sym = args[0]; - GCPRO2 (sym, val); + 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. */ - Lisp_Object globals; 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)) @@ -2172,7 +2202,7 @@ run_hook_list_with_args (funlist, nargs, args) } else { - args[0] = XCONS (val)->car; + args[0] = XCAR (val); Ffuncall (nargs, args); } } @@ -2658,8 +2688,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; }