X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/26631f2b58f96dfa01644457743efca2297e391e..b221615bc47647612a1a0999b5c9b7cfc699fce6:/src/eval.c diff --git a/src/eval.c b/src/eval.c index 4381901c89..5061cbc766 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1,5 +1,5 @@ /* Evaluator for GNU Emacs Lisp interpreter. - Copyright (C) 1985, 86, 87, 93, 94, 95, 99, 2000, 2001 + Copyright (C) 1985, 86, 87, 93, 94, 95, 99, 2000, 2001, 2002 Free Software Foundation, Inc. This file is part of GNU Emacs. @@ -77,6 +77,7 @@ struct catchtag int lisp_eval_depth; int pdlcount; int poll_suppress_count; + int interrupt_input_blocked; struct byte_stack *byte_stack; }; @@ -87,7 +88,7 @@ struct catchtag *catchlist; int gcpro_level; #endif -Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun; +Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun, Qdefvar; Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag; Lisp_Object Qand_rest, Qand_optional; Lisp_Object Qdebug_on_error; @@ -116,7 +117,7 @@ struct specbinding *specpdl; /* Pointer to first unused element in specpdl. */ -struct specbinding *specpdl_ptr; +volatile struct specbinding *specpdl_ptr; /* Maximum size allowed for specpdl allocation */ @@ -233,13 +234,13 @@ call_debugger (arg) int debug_while_redisplaying; int count = SPECPDL_INDEX (); Lisp_Object val; - + if (lisp_eval_depth + 20 > max_lisp_eval_depth) max_lisp_eval_depth = lisp_eval_depth + 20; - + if (specpdl_size + 40 > max_specpdl_size) max_specpdl_size = specpdl_size + 40; - + #ifdef HAVE_X_WINDOWS if (display_hourglass_p) cancel_hourglass (); @@ -260,7 +261,7 @@ call_debugger (arg) redisplay, which necessarily leads to display problems. */ specbind (Qinhibit_eval_during_redisplay, Qt); #endif - + val = apply1 (Vdebugger, arg); /* Interrupting redisplay and resuming it later is not safe under @@ -293,24 +294,18 @@ usage: (or CONDITIONS ...) */) (args) Lisp_Object args; { - register Lisp_Object val; - Lisp_Object args_left; + register Lisp_Object val = Qnil; struct gcpro gcpro1; - if (NILP(args)) - return Qnil; - - args_left = args; - GCPRO1 (args_left); + GCPRO1 (args); - do + while (CONSP (args)) { - val = Feval (Fcar (args_left)); + val = Feval (XCAR (args)); if (!NILP (val)) break; - args_left = Fcdr (args_left); + args = XCDR (args); } - while (!NILP(args_left)); UNGCPRO; return val; @@ -324,24 +319,18 @@ usage: (and CONDITIONS ...) */) (args) Lisp_Object args; { - register Lisp_Object val; - Lisp_Object args_left; + register Lisp_Object val = Qt; struct gcpro gcpro1; - if (NILP(args)) - return Qt; - - args_left = args; - GCPRO1 (args_left); + GCPRO1 (args); - do + while (CONSP (args)) { - val = Feval (Fcar (args_left)); + val = Feval (XCAR (args)); if (NILP (val)) break; - args_left = Fcdr (args_left); + args = XCDR (args); } - while (!NILP(args_left)); UNGCPRO; return val; @@ -409,22 +398,16 @@ usage: (progn BODY ...) */) (args) Lisp_Object args; { - register Lisp_Object val; - Lisp_Object args_left; + register Lisp_Object val = Qnil; struct gcpro gcpro1; - if (NILP(args)) - return Qnil; - - args_left = args; - GCPRO1 (args_left); + GCPRO1 (args); - do + while (CONSP (args)) { - val = Feval (Fcar (args_left)); - args_left = Fcdr (args_left); + val = Feval (XCAR (args)); + args = XCDR (args); } - while (!NILP(args_left)); UNGCPRO; return val; @@ -534,7 +517,7 @@ usage: (setq SYM VAL SYM VAL ...) */) UNGCPRO; return val; } - + DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0, doc: /* Return the argument, without evaluating it. `(quote x)' yields `x'. usage: (quote ARG) */) @@ -543,7 +526,7 @@ usage: (quote ARG) */) { return Fcar (args); } - + DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0, doc: /* Like `quote', but preferred for objects which are functions. In byte compilation, `function' causes its argument to be compiled. @@ -595,17 +578,15 @@ interactive_p (exclude_subrs_p) btp = btp->next; /* If we're running an Emacs 18-style byte-compiled function, there - may be a frame for Fbytecode. Now, given the strictest - definition, this function isn't really being called - interactively, but because that's the way Emacs 18 always builds - byte-compiled functions, we'll accept it for now. */ - if (EQ (*btp->function, Qbytecode)) - btp = btp->next; + may be a frame for Fbytecode at the top level. In any version of + Emacs there can be Fbytecode frames for subexpressions evaluated + inside catch and condition-case. Skip past them. - /* If this isn't a byte-compiled function, then we may now be + If this isn't a byte-compiled function, then we may now be looking at several frames for special forms. Skip past them. */ - while (btp && - btp->nargs == UNEVALLED) + while (btp + && (EQ (*btp->function, Qbytecode) + || btp->nargs == UNEVALLED)) btp = btp->next; /* btp now points at the frame of the innermost function that isn't @@ -615,7 +596,7 @@ interactive_p (exclude_subrs_p) fun = Findirect_function (*btp->function); if (exclude_subrs_p && SUBRP (fun)) return 0; - + /* btp points to the frame of a Lisp function that called interactive-p. Return t if that function was called interactively. */ if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively)) @@ -639,6 +620,9 @@ usage: (defun NAME ARGLIST [DOCSTRING] BODY...) */) defn = Fcons (Qlambda, Fcdr (args)); if (!NILP (Vpurify_flag)) defn = Fpurecopy (defn); + if (CONSP (XSYMBOL (fn_name)->function) + && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload)) + LOADHIST_ATTACH (Fcons (Qt, fn_name)); Ffset (fn_name, defn); LOADHIST_ATTACH (fn_name); return fn_name; @@ -660,9 +644,9 @@ The elements can look like this: (indent INDENT) Set NAME's `lisp-indent-function' property to INDENT. - (edebug DEBUG) + (debug DEBUG) Set NAME's `edebug-form-spec' property to DEBUG. (This is - equivalent to writing a `def-edebug-spec' for the macro. + equivalent to writing a `def-edebug-spec' for the macro.) usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */) (args) Lisp_Object args; @@ -678,8 +662,8 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */) doc = Qnil; if (STRINGP (Fcar (tail))) { - doc = Fcar (tail); - tail = Fcdr (tail); + doc = XCAR (tail); + tail = XCDR (tail); } while (CONSP (Fcar (tail)) @@ -692,7 +676,7 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */) call2 (Vmacro_declaration_function, fn_name, Fcar (tail)); UNGCPRO; } - + tail = Fcdr (tail); } @@ -701,25 +685,29 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */) else tail = Fcons (lambda_list, Fcons (doc, tail)); defn = Fcons (Qmacro, Fcons (Qlambda, tail)); - + if (!NILP (Vpurify_flag)) defn = Fpurecopy (defn); + if (CONSP (XSYMBOL (fn_name)->function) + && EQ (XCAR (XSYMBOL (fn_name)->function), Qautoload)) + LOADHIST_ATTACH (Fcons (Qt, fn_name)); Ffset (fn_name, defn); LOADHIST_ATTACH (fn_name); return fn_name; } -DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 2, 0, +DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0, doc: /* Make SYMBOL a variable alias for symbol ALIASED. Setting the value of SYMBOL will subsequently set the value of ALIASED, and getting the value of SYMBOL will return the value ALIASED has. -ALIASED nil means remove the alias; SYMBOL is unbound after that. */) - (symbol, aliased) - Lisp_Object symbol, aliased; +ALIASED nil means remove the alias; SYMBOL is unbound after that. +Third arg DOCSTRING, if non-nil, is documentation for SYMBOL. */) + (symbol, aliased, docstring) + Lisp_Object symbol, aliased, docstring; { struct Lisp_Symbol *sym; - + CHECK_SYMBOL (symbol); CHECK_SYMBOL (aliased); @@ -730,8 +718,10 @@ ALIASED nil means remove the alias; SYMBOL is unbound after that. */) sym->indirect_variable = 1; sym->value = aliased; sym->constant = SYMBOL_CONSTANT_P (aliased); - LOADHIST_ATTACH (symbol); - + LOADHIST_ATTACH (Fcons (Qdefvar, symbol)); + if (!NILP (docstring)) + Fput (symbol, Qvariable_documentation, docstring); + return aliased; } @@ -767,22 +757,21 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) if (NILP (tem)) Fset_default (sym, Feval (Fcar (tail))); tail = Fcdr (tail); - if (!NILP (Fcar (tail))) + tem = Fcar (tail); + if (!NILP (tem)) { - tem = Fcar (tail); if (!NILP (Vpurify_flag)) tem = Fpurecopy (tem); Fput (sym, Qvariable_documentation, tem); } - LOADHIST_ATTACH (sym); + LOADHIST_ATTACH (Fcons (Qdefvar, sym)); } else - /* A (defvar ) should not take precedence in the load-history over - an earlier (defvar ), so only add to history if the default - value is still unbound. */ - if (NILP (tem)) - LOADHIST_ATTACH (sym); - + /* Simple (defvar ) should not count as a definition at all. + It could get in the way of other definitions, and unloading this + package could try to make the variable unbound. */ + ; + return sym; } @@ -814,7 +803,7 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) tem = Fpurecopy (tem); Fput (sym, Qvariable_documentation, tem); } - LOADHIST_ATTACH (sym); + LOADHIST_ATTACH (Fcons (Qdefvar, sym)); return sym; } @@ -823,13 +812,12 @@ DEFUN ("user-variable-p", Fuser_variable_p, Suser_variable_p, 1, 1, 0, \(The alternative is a variable used internally in a Lisp program.) Determined by whether the first character of the documentation for the variable is `*' or if the variable is customizable (has a non-nil -value of any of `custom-type', `custom-loads' or `standard-value' -on its property list). */) +value of `standard-value' or of `custom-autoload' on its property list). */) (variable) Lisp_Object variable; { Lisp_Object documentation; - + if (!SYMBOLP (variable)) return Qnil; @@ -837,7 +825,7 @@ on its property list). */) if (INTEGERP (documentation) && XINT (documentation) < 0) return Qt; if (STRINGP (documentation) - && ((unsigned char) XSTRING (documentation)->data[0] == '*')) + && ((unsigned char) SREF (documentation, 0) == '*')) return Qt; /* If it is (STRING . INTEGER), a negative integer means a user variable. */ if (CONSP (documentation) @@ -845,13 +833,12 @@ on its property list). */) && INTEGERP (XCDR (documentation)) && XINT (XCDR (documentation)) < 0) return Qt; - /* Customizable? */ - if ((!NILP (Fget (variable, intern ("custom-type")))) - || (!NILP (Fget (variable, intern ("custom-loads")))) - || (!NILP (Fget (variable, intern ("standard-value"))))) + /* Customizable? See `custom-variable-p'. */ + if ((!NILP (Fget (variable, intern ("standard-value")))) + || (!NILP (Fget (variable, intern ("custom-autoload"))))) return Qt; return Qnil; -} +} DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0, doc: /* Bind variables according to VARLIST then eval BODY. @@ -1097,6 +1084,7 @@ internal_catch (tag, func, arg) c.lisp_eval_depth = lisp_eval_depth; c.pdlcount = SPECPDL_INDEX (); c.poll_suppress_count = poll_suppress_count; + c.interrupt_input_blocked = interrupt_input_blocked; c.gcpro = gcprolist; c.byte_stack = byte_stack_list; catchlist = &c; @@ -1138,6 +1126,7 @@ unwind_to_catch (catch, value) /* Restore the polling-suppression count. */ set_poll_suppress_count (catch->poll_suppress_count); + interrupt_input_blocked = catch->interrupt_input_blocked; do { @@ -1161,7 +1150,7 @@ unwind_to_catch (catch, value) #endif backtrace_list = catch->backlist; lisp_eval_depth = catch->lisp_eval_depth; - + _longjmp (catch->jmp, 1); } @@ -1198,9 +1187,9 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...) */) Lisp_Object val; int count = SPECPDL_INDEX (); - record_unwind_protect (0, Fcdr (args)); + record_unwind_protect (Fprogn, Fcdr (args)); val = Feval (Fcar (args)); - return unbind_to (count, val); + return unbind_to (count, val); } /* Chain of condition handlers currently in effect. @@ -1264,6 +1253,7 @@ usage: (condition-case VAR BODYFORM HANDLERS...) */) c.lisp_eval_depth = lisp_eval_depth; c.pdlcount = SPECPDL_INDEX (); c.poll_suppress_count = poll_suppress_count; + c.interrupt_input_blocked = interrupt_input_blocked; c.gcpro = gcprolist; c.byte_stack = byte_stack_list; if (_setjmp (c.jmp)) @@ -1280,7 +1270,7 @@ usage: (condition-case VAR BODYFORM HANDLERS...) */) } c.next = catchlist; catchlist = &c; - + h.var = var; h.handler = handlers; h.next = handlerlist; @@ -1313,12 +1303,8 @@ internal_condition_case (bfun, handlers, hfun) struct catchtag c; struct handler h; -#if 0 /* Can't do this check anymore because realize_basic_faces has - to BLOCK_INPUT, and can call Lisp. What's really needed is a - flag indicating that we're currently handling a signal. */ - /* Since Fsignal resets this to 0, it had better be 0 now - or else we have a potential bug. */ - if (interrupt_input_blocked != 0) +#if 0 /* We now handle interrupt_input_blocked properly. + What we still do not handle is exiting a signal handler. */ abort (); #endif @@ -1329,6 +1315,7 @@ internal_condition_case (bfun, handlers, hfun) c.lisp_eval_depth = lisp_eval_depth; c.pdlcount = SPECPDL_INDEX (); c.poll_suppress_count = poll_suppress_count; + c.interrupt_input_blocked = interrupt_input_blocked; c.gcpro = gcprolist; c.byte_stack = byte_stack_list; if (_setjmp (c.jmp)) @@ -1349,7 +1336,7 @@ internal_condition_case (bfun, handlers, hfun) return val; } -/* Like internal_condition_case but call HFUN with ARG as its argument. */ +/* Like internal_condition_case but call BFUN with ARG as its argument. */ Lisp_Object internal_condition_case_1 (bfun, arg, handlers, hfun) @@ -1369,6 +1356,7 @@ internal_condition_case_1 (bfun, arg, handlers, hfun) c.lisp_eval_depth = lisp_eval_depth; c.pdlcount = SPECPDL_INDEX (); c.poll_suppress_count = poll_suppress_count; + c.interrupt_input_blocked = interrupt_input_blocked; c.gcpro = gcprolist; c.byte_stack = byte_stack_list; if (_setjmp (c.jmp)) @@ -1390,7 +1378,7 @@ internal_condition_case_1 (bfun, arg, handlers, hfun) } -/* Like internal_condition_case but call HFUN with NARGS as first, +/* Like internal_condition_case but call BFUN with NARGS as first, and ARGS as second argument. */ Lisp_Object @@ -1412,6 +1400,7 @@ internal_condition_case_2 (bfun, nargs, args, handlers, hfun) c.lisp_eval_depth = lisp_eval_depth; c.pdlcount = SPECPDL_INDEX (); c.poll_suppress_count = poll_suppress_count; + c.interrupt_input_blocked = interrupt_input_blocked; c.gcpro = gcprolist; c.byte_stack = byte_stack_list; if (_setjmp (c.jmp)) @@ -1465,11 +1454,10 @@ See also the function `condition-case'. */) struct backtrace *bp; immediate_quit = handling_signal = 0; + abort_on_gc = 0; if (gc_in_progress || waiting_for_input) abort (); - TOTALLY_UNBLOCK_INPUT; - if (NILP (error_symbol)) real_error_symbol = Fcar (data); else @@ -1481,7 +1469,7 @@ See also the function `condition-case'. */) if (display_hourglass_p) cancel_hourglass (); #endif -#endif +#endif /* This hook is used by edebug. */ if (! NILP (Vsignal_hook_function) @@ -1507,13 +1495,13 @@ See also the function `condition-case'. */) for (; handlerlist; handlerlist = handlerlist->next) { register Lisp_Object clause; - + if (lisp_eval_depth + 20 > max_lisp_eval_depth) max_lisp_eval_depth = lisp_eval_depth + 20; - + if (specpdl_size + 40 > max_specpdl_size) max_specpdl_size = specpdl_size + 40; - + clause = find_handler_clause (handlerlist->handler, conditions, error_symbol, data, &debugger_value); @@ -1554,7 +1542,7 @@ See also the function `condition-case'. */) data = Fcons (error_symbol, data); string = Ferror_message_string (data); - fatal ("%s", XSTRING (string)->data, 0); + fatal ("%s", SDATA (string), 0); } /* Return nonzero iff LIST is a non-nil atom or @@ -1603,7 +1591,7 @@ skip_debugger (conditions, data) error_message = Ferror_message_string (data); first_string = 0; } - + if (fast_string_match (XCAR (tail), error_message) >= 0) return 1; } @@ -1892,14 +1880,14 @@ un_autoload (oldqueue) Vautoload_queue = oldqueue; while (CONSP (queue)) { - first = Fcar (queue); + first = XCAR (queue); second = Fcdr (first); first = Fcar (first); if (EQ (second, Qnil)) Vfeatures = first; else Ffset (first, second); - queue = Fcdr (queue); + queue = XCDR (queue); } return Qnil; } @@ -1920,7 +1908,7 @@ do_autoload (fundef, funname) of what files are preloaded and when. */ if (! NILP (Vpurify_flag)) error ("Attempt to autoload %s while preparing to dump", - XSTRING (SYMBOL_NAME (funname))->data); + SDATA (SYMBOL_NAME (funname))); fun = funname; CHECK_SYMBOL (funname); @@ -1928,7 +1916,7 @@ do_autoload (fundef, funname) /* 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; @@ -1938,7 +1926,7 @@ do_autoload (fundef, funname) queue = Vautoload_queue; while (CONSP (queue)) { - first = Fcar (queue); + first = XCAR (queue); second = Fcdr (first); first = Fcar (first); @@ -1946,9 +1934,9 @@ do_autoload (fundef, funname) may be an atom if the autoload entry was generated by a defalias or fset. */ if (CONSP (second)) - Fput (first, Qautoload, (Fcdr (second))); + Fput (first, Qautoload, (XCDR (second))); - queue = Fcdr (queue); + queue = XCDR (queue); } /* Once loading finishes, don't undo it. */ @@ -1959,7 +1947,7 @@ do_autoload (fundef, funname) if (!NILP (Fequal (fun, fundef))) error ("Autoloading failed to define function %s", - XSTRING (SYMBOL_NAME (funname))->data); + SDATA (SYMBOL_NAME (funname))); UNGCPRO; } @@ -1976,7 +1964,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, if (handling_signal) abort (); - + if (SYMBOLP (form)) return Fsymbol_value (form); if (!CONSP (form)) @@ -2154,6 +2142,10 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, if (backtrace.debug_on_exit) val = call_debugger (Fcons (Qexit, Fcons (val, Qnil))); backtrace_list = backtrace.next; + +#ifdef HAVE_CARBON + mac_check_for_quit_char(); +#endif return val; } @@ -2176,7 +2168,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) funcall_args = 0; spread_arg = args [nargs - 1]; CHECK_LIST (spread_arg); - + numargs = XINT (Flength (spread_arg)); if (numargs == 0) @@ -2235,6 +2227,7 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) spread_arg = XCDR (spread_arg); } + /* By convention, the caller needs to gcpro Ffuncall's args. */ RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args)); } @@ -2271,7 +2264,7 @@ usage: (run-hooks &rest HOOKS) */) return Qnil; } - + DEFUN ("run-hook-with-args", Frun_hook_with_args, Srun_hook_with_args, 1, MANY, 0, doc: /* Run HOOK with the specified arguments ARGS. @@ -2514,7 +2507,7 @@ call1 (fn, arg1) { struct gcpro gcpro1; #ifdef NO_ARG_ARRAY - Lisp_Object args[2]; + Lisp_Object args[2]; args[0] = fn; args[1] = arg1; @@ -2770,7 +2763,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) default: /* If a subr takes more than 8 arguments without using MANY - or UNEVALLED, we need to extend this function to support it. + or UNEVALLED, we need to extend this function to support it. Until this is done, there is no way to call the function. */ abort (); } @@ -2878,11 +2871,11 @@ funcall_lambda (fun, nargs, arg_vector) for (; CONSP (syms_left); syms_left = XCDR (syms_left)) { QUIT; - + next = XCAR (syms_left); while (!SYMBOLP (next)) next = Fsignal (Qinvalid_function, Fcons (fun, Qnil)); - + if (EQ (next, Qand_rest)) rest = 1; else if (EQ (next, Qand_optional)) @@ -2919,7 +2912,7 @@ funcall_lambda (fun, nargs, arg_vector) AREF (fun, COMPILED_CONSTANTS), AREF (fun, COMPILED_STACK_DEPTH)); } - + return unbind_to (count, val); } @@ -2938,7 +2931,7 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, { tem = AREF (object, COMPILED_BYTECODE); if (CONSP (tem) && STRINGP (XCAR (tem))) - error ("Invalid byte code in %s", XSTRING (XCAR (tem))->data); + error ("Invalid byte code in %s", SDATA (XCAR (tem))); else error ("Invalid byte code"); } @@ -2997,7 +2990,7 @@ specbind (symbol, value) else { Lisp_Object valcontents; - + ovalue = find_symbol_value (symbol); specpdl_ptr->func = 0; specpdl_ptr->old_value = ovalue; @@ -3011,7 +3004,7 @@ specbind (symbol, value) Lisp_Object where, current_buffer; current_buffer = Fcurrent_buffer (); - + /* For a local variable, record both the symbol and which buffer's or frame's value we are saving. */ if (!NILP (Flocal_variable_p (symbol, Qnil))) @@ -3077,14 +3070,17 @@ unbind_to (count, value) while (specpdl_ptr != specpdl + count) { - --specpdl_ptr; - - if (specpdl_ptr->func != 0) - (*specpdl_ptr->func) (specpdl_ptr->old_value); - /* Note that a "binding" of nil is really an unwind protect, - so in that case the "old value" is a list of forms to evaluate. */ - else if (NILP (specpdl_ptr->symbol)) - Fprogn (specpdl_ptr->old_value); + /* Copy the binding, and decrement specpdl_ptr, before we do + the work to unbind it. We decrement first + so that an error in unbinding won't try to unbind + the same entry again, and we copy the binding first + in case more bindings are made during some of the code we run. */ + + struct specbinding this_binding; + this_binding = *--specpdl_ptr; + + if (this_binding.func != 0) + (*this_binding.func) (this_binding.old_value); /* If the symbol is a list, it is really (SYMBOL WHERE . CURRENT-BUFFER) where WHERE is either nil, a buffer, or a frame. If WHERE is a buffer or frame, this indicates we @@ -3092,32 +3088,32 @@ unbind_to (count, value) binding. WHERE nil means that the variable had the default value when it was bound. CURRENT-BUFFER is the buffer that was current when the variable was bound. */ - else if (CONSP (specpdl_ptr->symbol)) + else if (CONSP (this_binding.symbol)) { Lisp_Object symbol, where; - symbol = XCAR (specpdl_ptr->symbol); - where = XCAR (XCDR (specpdl_ptr->symbol)); + symbol = XCAR (this_binding.symbol); + where = XCAR (XCDR (this_binding.symbol)); if (NILP (where)) - Fset_default (symbol, specpdl_ptr->old_value); + Fset_default (symbol, this_binding.old_value); else if (BUFFERP (where)) - set_internal (symbol, specpdl_ptr->old_value, XBUFFER (where), 1); - else - set_internal (symbol, specpdl_ptr->old_value, NULL, 1); + set_internal (symbol, this_binding.old_value, XBUFFER (where), 1); + else + set_internal (symbol, this_binding.old_value, NULL, 1); } else { /* If variable has a trivial value (no forwarding), we can just set it. No need to check for constant symbols here, since that was already done by specbind. */ - if (!MISCP (SYMBOL_VALUE (specpdl_ptr->symbol))) - SET_SYMBOL_VALUE (specpdl_ptr->symbol, specpdl_ptr->old_value); + if (!MISCP (SYMBOL_VALUE (this_binding.symbol))) + SET_SYMBOL_VALUE (this_binding.symbol, this_binding.old_value); else - set_internal (specpdl_ptr->symbol, specpdl_ptr->old_value, 0, 1); + set_internal (this_binding.symbol, this_binding.old_value, 0, 1); } } - + if (NILP (Vquit_flag) && quitf) Vquit_flag = Qt; @@ -3291,7 +3287,7 @@ before making `inhibit-quit' nil. */); Qdeclare = intern ("declare"); staticpro (&Qdeclare); - + /* Note that the process handling also uses Qexit, but we don't want to staticpro it twice, so we just do it here. */ Qexit = intern ("exit"); @@ -3306,6 +3302,9 @@ before making `inhibit-quit' nil. */); Qdefun = intern ("defun"); staticpro (&Qdefun); + Qdefvar = intern ("defvar"); + staticpro (&Qdefvar); + Qand_rest = intern ("&rest"); staticpro (&Qand_rest);