/* Evaluator for GNU Emacs Lisp interpreter.
Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1999, 2000, 2001,
- 2002, 2003, 2004, 2005, 2006, 2007, 2008
+ 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
Free Software Foundation, Inc.
This file is part of GNU Emacs.
-GNU Emacs is free software; you can redistribute it and/or modify
+GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation; either version 3, or (at your option)
-any later version.
+the Free Software Foundation, either version 3 of the License, or
+(at your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
-along with GNU Emacs; see the file COPYING. If not, write to
-the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA. */
+along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */
#include <config.h>
+#include <setjmp.h>
#include "lisp.h"
#include "blockinput.h"
#include "commands.h"
#include "keyboard.h"
#include "dispextern.h"
-#include <setjmp.h>
+#include "frame.h" /* For XFRAME. */
#if HAVE_X_WINDOWS
#include "xterm.h"
struct backtrace *backtrace_list;
-/* This structure helps implement the `catch' and `throw' control
- structure. A struct catchtag contains all the information needed
- to restore the state of the interpreter after a non-local jump.
-
- Handlers for error conditions (represented by `struct handler'
- structures) just point to a catch tag to do the cleanup required
- for their jumps.
-
- catchtag structures are chained together in the C calling stack;
- the `next' member points to the next outer catchtag.
-
- A call like (throw TAG VAL) searches for a catchtag whose `tag'
- member is TAG, and then unbinds to it. The `val' member is used to
- hold VAL while the stack is unwound; `val' is returned as the value
- of the catch form.
-
- All the other members are concerned with restoring the interpreter
- state. */
-
-struct catchtag
-{
- Lisp_Object tag;
- Lisp_Object val;
- struct catchtag *next;
- struct gcpro *gcpro;
- jmp_buf jmp;
- struct backtrace *backlist;
- struct handler *handlerlist;
- int lisp_eval_depth;
- int pdlcount;
- int poll_suppress_count;
- int interrupt_input_blocked;
- struct byte_stack *byte_stack;
-};
-
struct catchtag *catchlist;
#ifdef DEBUG_GCPRO
Lisp_Object Qdebug_on_error;
Lisp_Object Qdeclare;
Lisp_Object Qdebug;
+extern Lisp_Object Qinteractive_form;
/* This holds either the symbol `run-hooks' or nil.
It is nil at an early stage of startup, and when Emacs
extern Lisp_Object Qfunction;
-static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, Lisp_Object*));
-static void unwind_to_catch P_ ((struct catchtag *, Lisp_Object)) NO_RETURN;
+static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object*);
+static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN;
#if __GNUC__
/* "gcc -O3" enables automatic function inlining, which optimizes out
the arguments for the invocations of these functions, whereas they
expect these values on the stack. */
-Lisp_Object apply1 () __attribute__((noinline));
-Lisp_Object call2 () __attribute__((noinline));
+Lisp_Object apply1 (Lisp_Object fn, Lisp_Object arg) __attribute__((noinline));
+Lisp_Object call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2) __attribute__((noinline));
#endif
\f
void
-init_eval_once ()
+init_eval_once (void)
{
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 = 400;
+ max_lisp_eval_depth = 500;
Vrun_hooks = Qnil;
}
void
-init_eval ()
+init_eval (void)
{
specpdl_ptr = specpdl;
catchlist = 0;
/* unwind-protect function used by call_debugger. */
static Lisp_Object
-restore_stack_limits (data)
- Lisp_Object data;
+restore_stack_limits (Lisp_Object data)
{
max_specpdl_size = XINT (XCAR (data));
max_lisp_eval_depth = XINT (XCDR (data));
/* Call the Lisp debugger, giving it argument ARG. */
Lisp_Object
-call_debugger (arg)
- Lisp_Object arg;
+call_debugger (Lisp_Object arg)
{
int debug_while_redisplaying;
int count = SPECPDL_INDEX ();
if (SPECPDL_INDEX () + 100 > max_specpdl_size)
max_specpdl_size = SPECPDL_INDEX () + 100;
-#ifdef HAVE_X_WINDOWS
+#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
cancel_hourglass ();
#endif
}
void
-do_debug_on_call (code)
- Lisp_Object code;
+do_debug_on_call (Lisp_Object code)
{
debug_on_next_call = 0;
backtrace_list->debug_on_exit = 1;
}
DEFUN ("prog1", Fprog1, Sprog1, 1, UNEVALLED, 0,
- doc: /* Eval FIRST and BODY sequentially; value from FIRST.
+ doc: /* Eval FIRST and BODY sequentially; return value from FIRST.
The value of FIRST is saved during the evaluation of the remaining args,
whose values are discarded.
usage: (prog1 FIRST BODY...) */)
}
DEFUN ("prog2", Fprog2, Sprog2, 2, UNEVALLED, 0,
- doc: /* Eval FORM1, FORM2 and BODY sequentially; value from FORM2.
+ doc: /* Eval FORM1, FORM2 and BODY sequentially; return value from FORM2.
The value of FORM2 is saved during the evaluation of the
remaining args, whose values are discarded.
usage: (prog2 FORM1 FORM2 BODY...) */)
DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
- doc: /* Return t if the function was run directly by user input.
+ doc: /* Return t if the containing function was run directly by user input.
This means that the function was called with `call-interactively'
\(which includes being called as the binding of a key)
-and input is currently coming from the keyboard (not in keyboard macro),
+and input is currently coming from the keyboard (not a keyboard macro),
and Emacs is not running in batch mode (`noninteractive' is nil).
The only known proper use of `interactive-p' is in deciding whether to
making a mistake. Think: what do you want to do when the command is
called from a keyboard macro?
-If you want to test whether your function was called with
-`call-interactively', the way to do that is by adding an extra
-optional argument, and making the `interactive' spec specify non-nil
-unconditionally for that argument. (`p' is a good way to do this.) */)
+To test whether your function was called with `call-interactively',
+either (i) add an extra optional argument and give it an `interactive'
+spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
+use `called-interactively-p'. */)
()
{
return (INTERACTIVE && interactive_p (1)) ? Qt : Qnil;
}
-DEFUN ("called-interactively-p", Fcalled_interactively_p, Scalled_interactively_p, 0, 0, 0,
- doc: /* Return t if the function using this was called with `call-interactively'.
-This is used for implementing advice and other function-modifying
-features of Emacs.
+DEFUN ("called-interactively-p", Fcalled_interactively_p, Scalled_interactively_p, 0, 1, 0,
+ doc: /* Return t if the containing function was called by `call-interactively'.
+If KIND is `interactive', then only return t if the call was made
+interactively by the user, i.e. not in `noninteractive' mode nor
+when `executing-kbd-macro'.
+If KIND is `any', on the other hand, it will return t for any kind of
+interactive call, including being called as the binding of a key, or
+from a keyboard macro, or in `noninteractive' mode.
-The cleanest way to test whether your function was called with
-`call-interactively' is by adding an extra optional argument,
-and making the `interactive' spec specify non-nil unconditionally
-for that argument. (`p' is a good way to do this.) */)
- ()
+The only known proper use of `interactive' for KIND is in deciding
+whether to display a helpful message, or how to display it. If you're
+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)). */)
+ (kind)
+ Lisp_Object kind;
{
- return interactive_p (1) ? Qt : Qnil;
+ return ((INTERACTIVE || !EQ (kind, intern ("interactive")))
+ && interactive_p (1)) ? Qt : Qnil;
}
called is a built-in. */
int
-interactive_p (exclude_subrs_p)
- int exclude_subrs_p;
+interactive_p (int exclude_subrs_p)
{
struct backtrace *btp;
Lisp_Object fun;
and the result should be a form to be evaluated instead of the original.
DECL is a declaration, optional, which can specify how to indent
-calls to this macro and how Edebug should handle it. It looks like this:
+calls to this macro, how Edebug should handle it, and which argument
+should be treated as documentation. It looks like this:
(declare SPECS...)
The elements can look like this:
(indent INDENT)
(debug DEBUG)
Set NAME's `edebug-form-spec' property to DEBUG. (This is
equivalent to writing a `def-edebug-spec' for the macro.)
+
+ (doc-string ELT)
+ Set NAME's `doc-string-elt' property to ELT.
+
usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */)
(args)
Lisp_Object args;
doc: /* Make NEW-ALIAS a variable alias for symbol BASE-VARIABLE.
Aliased variables always have the same value; setting one sets the other.
Third arg DOCSTRING, if non-nil, is documentation for NEW-ALIAS. If it is
- omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
- or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
- itself an alias.
+omitted or nil, NEW-ALIAS gets the documentation string of BASE-VARIABLE,
+or of the variable at the end of the chain of aliases, if BASE-VARIABLE is
+itself an alias. If NEW-ALIAS is bound, and BASE-VARIABLE is not,
+then the value of BASE-VARIABLE is set to that of NEW-ALIAS.
The return value is BASE-VARIABLE. */)
(new_alias, base_variable, docstring)
Lisp_Object new_alias, base_variable, docstring;
CHECK_SYMBOL (new_alias);
CHECK_SYMBOL (base_variable);
- if (SYMBOL_CONSTANT_P (new_alias))
+ sym = XSYMBOL (new_alias);
+
+ if (sym->constant)
+ /* Not sure why, but why not? */
error ("Cannot make a constant an alias");
- sym = XSYMBOL (new_alias);
- sym->indirect_variable = 1;
- sym->value = base_variable;
+ switch (sym->redirect)
+ {
+ case SYMBOL_FORWARDED:
+ error ("Cannot make an internal variable an alias");
+ case SYMBOL_LOCALIZED:
+ error ("Don't know how to make a localized variable an alias");
+ }
+
+ /* http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00834.html
+ If n_a is bound, but b_v is not, set the value of b_v to n_a,
+ so that old-code that affects n_a before the aliasing is setup
+ still works. */
+ if (NILP (Fboundp (base_variable)))
+ set_internal (base_variable, find_symbol_value (new_alias), Qnil, 1);
+
+ {
+ struct specbinding *p;
+
+ for (p = specpdl_ptr - 1; p >= specpdl; p--)
+ if (p->func == NULL
+ && (EQ (new_alias,
+ CONSP (p->symbol) ? XCAR (p->symbol) : p->symbol)))
+ error ("Don't know how to make a let-bound variable an alias");
+ }
+
+ sym->redirect = SYMBOL_VARALIAS;
+ SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable));
sym->constant = SYMBOL_CONSTANT_P (base_variable);
LOADHIST_ATTACH (new_alias);
- if (!NILP (docstring))
- Fput (new_alias, Qvariable_documentation, docstring);
- else
- Fput (new_alias, Qvariable_documentation, Qnil);
+ /* Even if docstring is nil: remove old docstring. */
+ Fput (new_alias, Qvariable_documentation, docstring);
return base_variable;
}
/* Error handler used in Fuser_variable_p. */
static Lisp_Object
-user_variable_p_eh (ignore)
- Lisp_Object ignore;
+user_variable_p_eh (Lisp_Object ignore)
{
return Qnil;
}
+static Lisp_Object
+lisp_indirect_variable (Lisp_Object sym)
+{
+ XSETSYMBOL (sym, indirect_variable (XSYMBOL (sym)));
+ return sym;
+}
+
DEFUN ("user-variable-p", Fuser_variable_p, Suser_variable_p, 1, 1, 0,
doc: /* Return t if VARIABLE is intended to be set and modified by users.
\(The alternative is a variable used internally in a Lisp program.)
return Qnil;
/* If indirect and there's an alias loop, don't check anything else. */
- if (XSYMBOL (variable)->indirect_variable
- && NILP (internal_condition_case_1 (indirect_variable, variable,
+ if (XSYMBOL (variable)->redirect == SYMBOL_VARALIAS
+ && NILP (internal_condition_case_1 (lisp_indirect_variable, variable,
Qt, user_variable_p_eh)))
return Qnil;
|| (!NILP (Fget (variable, intern ("custom-autoload")))))
return Qt;
- if (!XSYMBOL (variable)->indirect_variable)
+ if (!(XSYMBOL (variable)->redirect == SYMBOL_VARALIAS))
return Qnil;
/* An indirect variable? Let's follow the chain. */
- variable = XSYMBOL (variable)->value;
+ XSETSYMBOL (variable, SYMBOL_ALIAS (XSYMBOL (variable)));
}
}
\f
This is how catches are done from within C code. */
Lisp_Object
-internal_catch (tag, func, arg)
- Lisp_Object tag;
- Lisp_Object (*func) ();
- Lisp_Object arg;
+internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object arg)
{
/* This structure is made part of the chain `catchlist'. */
struct catchtag c;
This is used for correct unwinding in Fthrow and Fsignal. */
static void
-unwind_to_catch (catch, value)
- struct catchtag *catch;
- Lisp_Object value;
+unwind_to_catch (struct catchtag *catch, Lisp_Object value)
{
register int last_time;
When a handler handles an error, control returns to the `condition-case'
and it executes the handler's BODY...
-with VAR bound to (SIGNALED-CONDITIONS . SIGNAL-DATA) from the error.
+with VAR bound to (ERROR-SYMBOL . SIGNAL-DATA) from the error.
(If VAR is nil, the handler can't access that information.)
Then the value of the last BODY form is returned from the `condition-case'
expression.
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;
+internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform,
+ Lisp_Object handlers)
{
Lisp_Object val;
struct catchtag c;
but allow the debugger to run if that is enabled. */
Lisp_Object
-internal_condition_case (bfun, handlers, hfun)
- Lisp_Object (*bfun) ();
- Lisp_Object handlers;
- Lisp_Object (*hfun) ();
+internal_condition_case (Lisp_Object (*bfun) (void), Lisp_Object handlers,
+ Lisp_Object (*hfun) (Lisp_Object))
{
Lisp_Object val;
struct catchtag c;
/* Like internal_condition_case but call BFUN with ARG as its argument. */
Lisp_Object
-internal_condition_case_1 (bfun, arg, handlers, hfun)
- Lisp_Object (*bfun) ();
- Lisp_Object arg;
- Lisp_Object handlers;
- Lisp_Object (*hfun) ();
+internal_condition_case_1 (Lisp_Object (*bfun) (Lisp_Object), Lisp_Object arg,
+ Lisp_Object handlers, Lisp_Object (*hfun) (Lisp_Object))
{
Lisp_Object val;
struct catchtag c;
return val;
}
+/* Like internal_condition_case_1 but call BFUN with ARG1 and ARG2 as
+ its arguments. */
+
+Lisp_Object
+internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object),
+ Lisp_Object arg1,
+ Lisp_Object arg2,
+ Lisp_Object handlers,
+ Lisp_Object (*hfun) (Lisp_Object))
+{
+ Lisp_Object val;
+ 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;
+ c.handlerlist = handlerlist;
+ 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))
+ {
+ return (*hfun) (c.val);
+ }
+ c.next = catchlist;
+ catchlist = &c;
+ h.handler = handlers;
+ h.var = Qnil;
+ h.next = handlerlist;
+ h.tag = &c;
+ handlerlist = &h;
+
+ val = (*bfun) (arg1, arg2);
+ catchlist = c.next;
+ handlerlist = h.next;
+ return val;
+}
/* Like internal_condition_case but call BFUN with NARGS as first,
and ARGS as second argument. */
Lisp_Object
-internal_condition_case_2 (bfun, nargs, args, handlers, hfun)
- Lisp_Object (*bfun) ();
- int nargs;
- Lisp_Object *args;
- Lisp_Object handlers;
- Lisp_Object (*hfun) ();
+internal_condition_case_n (Lisp_Object (*bfun) (int, Lisp_Object*),
+ int nargs,
+ Lisp_Object *args,
+ Lisp_Object handlers,
+ Lisp_Object (*hfun) (Lisp_Object))
{
Lisp_Object val;
struct catchtag c;
}
\f
-static Lisp_Object find_handler_clause P_ ((Lisp_Object, Lisp_Object,
- Lisp_Object, Lisp_Object));
+static Lisp_Object find_handler_clause (Lisp_Object, Lisp_Object,
+ Lisp_Object, Lisp_Object);
DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
doc: /* Signal an error. Args are ERROR-SYMBOL and associated DATA.
#if 0 /* rms: I don't know why this was here,
but it is surely wrong for an error that is handled. */
-#ifdef HAVE_X_WINDOWS
+#ifdef HAVE_WINDOW_SYSTEM
if (display_hourglass_p)
cancel_hourglass ();
#endif
Used for anything but Qquit (which can return from Fsignal). */
void
-xsignal (error_symbol, data)
- Lisp_Object error_symbol, data;
+xsignal (Lisp_Object error_symbol, Lisp_Object data)
{
Fsignal (error_symbol, data);
abort ();
/* Like xsignal, but takes 0, 1, 2, or 3 args instead of a list. */
void
-xsignal0 (error_symbol)
- Lisp_Object error_symbol;
+xsignal0 (Lisp_Object error_symbol)
{
xsignal (error_symbol, Qnil);
}
void
-xsignal1 (error_symbol, arg)
- Lisp_Object error_symbol, arg;
+xsignal1 (Lisp_Object error_symbol, Lisp_Object arg)
{
xsignal (error_symbol, list1 (arg));
}
void
-xsignal2 (error_symbol, arg1, arg2)
- Lisp_Object error_symbol, arg1, arg2;
+xsignal2 (Lisp_Object error_symbol, Lisp_Object arg1, Lisp_Object arg2)
{
xsignal (error_symbol, list2 (arg1, arg2));
}
void
-xsignal3 (error_symbol, arg1, arg2, arg3)
- Lisp_Object error_symbol, arg1, arg2, arg3;
+xsignal3 (Lisp_Object error_symbol, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
{
xsignal (error_symbol, list3 (arg1, arg2, arg3));
}
If ARG is not a genuine list, make it a one-element list. */
void
-signal_error (s, arg)
- char *s;
- Lisp_Object arg;
+signal_error (char *s, Lisp_Object arg)
{
Lisp_Object tortoise, hare;
a list containing one of CONDITIONS. */
static int
-wants_debugger (list, conditions)
- Lisp_Object list, conditions;
+wants_debugger (Lisp_Object list, Lisp_Object conditions)
{
if (NILP (list))
return 0;
according to debugger-ignored-errors. */
static int
-skip_debugger (conditions, data)
- Lisp_Object conditions, data;
+skip_debugger (Lisp_Object conditions, Lisp_Object data)
{
Lisp_Object tail;
int first_string = 1;
return 0;
}
+/* Call the debugger if calling it is currently enabled for CONDITIONS.
+ SIG and DATA describe the signal, as in find_handler_clause. */
+
+static int
+maybe_call_debugger (Lisp_Object conditions, Lisp_Object sig, Lisp_Object data)
+{
+ Lisp_Object combined_data;
+
+ combined_data = Fcons (sig, data);
+
+ if (
+ /* Don't try to run the debugger with interrupts blocked.
+ The editing loop would return anyway. */
+ ! INPUT_BLOCKED_P
+ /* Does user want to enter debugger for this kind of error? */
+ && (EQ (sig, Qquit)
+ ? debug_on_quit
+ : wants_debugger (Vdebug_on_error, conditions))
+ && ! skip_debugger (conditions, combined_data)
+ /* rms: what's this for? */
+ && when_entered_debugger < num_nonmacro_input_events)
+ {
+ call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil)));
+ return 1;
+ }
+
+ return 0;
+}
+
/* 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.
a second error here in case we're handling specpdl overflow. */
static Lisp_Object
-find_handler_clause (handlers, conditions, sig, data)
- Lisp_Object handlers, conditions, sig, data;
+find_handler_clause (Lisp_Object handlers, Lisp_Object conditions,
+ Lisp_Object sig, Lisp_Object data)
{
register Lisp_Object h;
register Lisp_Object tem;
{
if (!NILP (sig) && wants_debugger (Vstack_trace_on_error, conditions))
{
+ max_lisp_eval_depth += 15;
max_specpdl_size++;
- #ifdef PROTOTYPES
- internal_with_output_to_temp_buffer ("*Backtrace*",
- (Lisp_Object (*) (Lisp_Object)) Fbacktrace,
- Qnil);
- #else
- internal_with_output_to_temp_buffer ("*Backtrace*",
- Fbacktrace, Qnil);
- #endif
+ if (noninteractive)
+ Fbacktrace ();
+ else
+ internal_with_output_to_temp_buffer
+ ("*Backtrace*",
+ (Lisp_Object (*) (Lisp_Object)) Fbacktrace,
+ Qnil);
max_specpdl_size--;
+ max_lisp_eval_depth -= 15;
}
if (!debugger_considered)
return Qnil;
}
-/* Call the debugger if calling it is currently enabled for CONDITIONS.
- SIG and DATA describe the signal, as in find_handler_clause. */
-
-int
-maybe_call_debugger (conditions, sig, data)
- Lisp_Object conditions, sig, data;
-{
- Lisp_Object combined_data;
-
- combined_data = Fcons (sig, data);
-
- if (
- /* Don't try to run the debugger with interrupts blocked.
- The editing loop would return anyway. */
- ! INPUT_BLOCKED_P
- /* Does user wants to enter debugger for this kind of error? */
- && (EQ (sig, Qquit)
- ? debug_on_quit
- : wants_debugger (Vdebug_on_error, conditions))
- && ! skip_debugger (conditions, combined_data)
- /* rms: what's this for? */
- && when_entered_debugger < num_nonmacro_input_events)
- {
- call_debugger (Fcons (Qerror, Fcons (combined_data, Qnil)));
- return 1;
- }
-
- return 0;
-}
-
/* dump an error message; called like printf */
/* VARARGS 1 */
fun = function;
while (SYMBOLP (fun))
{
- Lisp_Object tmp = Fget (fun, intern ("interactive-form"));
+ Lisp_Object tmp = Fget (fun, Qinteractive_form);
if (!NILP (tmp))
if_prop = Qt;
fun = Fsymbol_function (fun);
return Qnil;
}
-/* ARGSUSED */
DEFUN ("autoload", Fautoload, Sautoload, 2, 5, 0,
doc: /* Define FUNCTION to autoload from FILE.
FUNCTION is a symbol; FILE is a file name string to pass to `load'.
(function, file, docstring, interactive, type)
Lisp_Object function, file, docstring, interactive, type;
{
-#ifdef NO_ARG_ARRAY
- Lisp_Object args[4];
-#endif
-
CHECK_SYMBOL (function);
CHECK_STRING (file);
/* Only add entries after dumping, because the ones before are
not useful and else we get loads of them from the loaddefs.el. */
LOADHIST_ATTACH (Fcons (Qautoload, function));
-
-#ifdef NO_ARG_ARRAY
- args[0] = file;
- args[1] = docstring;
- args[2] = interactive;
- args[3] = type;
-
- return Ffset (function, Fcons (Qautoload, Flist (4, &args[0])));
-#else /* NO_ARG_ARRAY */
- return Ffset (function, Fcons (Qautoload, Flist (4, &file)));
-#endif /* not NO_ARG_ARRAY */
+ else
+ /* We don't want the docstring in purespace (instead,
+ Snarf-documentation should (hopefully) overwrite it).
+ We used to use 0 here, but that leads to accidental sharing in
+ purecopy's hash-consing, so we use a (hopefully) unique integer
+ instead. */
+ docstring = make_number (XHASH (function));
+ return Ffset (function,
+ Fpurecopy (list5 (Qautoload, file, docstring,
+ interactive, type)));
}
Lisp_Object
-un_autoload (oldqueue)
- Lisp_Object oldqueue;
+un_autoload (Lisp_Object oldqueue)
{
register Lisp_Object queue, first, second;
FUNDEF is the autoload definition (a list). */
void
-do_autoload (fundef, funname)
- Lisp_Object fundef, funname;
+do_autoload (Lisp_Object fundef, Lisp_Object funname)
{
int count = SPECPDL_INDEX ();
Lisp_Object fun;
the function. We do this in the specific case of autoloading
because autoloading is not an explicit request "load this file",
but rather a request to "call this function".
-
+
The value saved here is to be restored into Vautoload_queue. */
record_unwind_protect (un_autoload, Vautoload_queue);
Vautoload_queue = Qt;
if (XSUBR (fun)->max_args == UNEVALLED)
{
backtrace.evalargs = 0;
- val = (*XSUBR (fun)->function) (args_left);
+ val = (XSUBR (fun)->function.a1) (args_left);
goto done;
}
backtrace.args = vals;
backtrace.nargs = XINT (numargs);
- val = (*XSUBR (fun)->function) (XINT (numargs), vals);
+ val = (XSUBR (fun)->function.am) (XINT (numargs), vals);
UNGCPRO;
goto done;
}
switch (i)
{
case 0:
- val = (*XSUBR (fun)->function) ();
+ val = (XSUBR (fun)->function.a0) ();
goto done;
case 1:
- val = (*XSUBR (fun)->function) (argvals[0]);
+ val = (XSUBR (fun)->function.a1) (argvals[0]);
goto done;
case 2:
- val = (*XSUBR (fun)->function) (argvals[0], argvals[1]);
+ val = (XSUBR (fun)->function.a2) (argvals[0], argvals[1]);
goto done;
case 3:
- val = (*XSUBR (fun)->function) (argvals[0], argvals[1],
- argvals[2]);
+ val = (XSUBR (fun)->function.a3) (argvals[0], argvals[1],
+ argvals[2]);
goto done;
case 4:
- val = (*XSUBR (fun)->function) (argvals[0], argvals[1],
- argvals[2], argvals[3]);
+ val = (XSUBR (fun)->function.a4) (argvals[0], argvals[1],
+ argvals[2], argvals[3]);
goto done;
case 5:
- val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
- argvals[3], argvals[4]);
+ val = (XSUBR (fun)->function.a5) (argvals[0], argvals[1], argvals[2],
+ argvals[3], argvals[4]);
goto done;
case 6:
- val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
- argvals[3], argvals[4], argvals[5]);
+ val = (XSUBR (fun)->function.a6) (argvals[0], argvals[1], argvals[2],
+ argvals[3], argvals[4], argvals[5]);
goto done;
case 7:
- val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
- argvals[3], argvals[4], argvals[5],
- argvals[6]);
+ val = (XSUBR (fun)->function.a7) (argvals[0], argvals[1], argvals[2],
+ argvals[3], argvals[4], argvals[5],
+ argvals[6]);
goto done;
case 8:
- val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
- argvals[3], argvals[4], argvals[5],
- argvals[6], argvals[7]);
+ val = (XSUBR (fun)->function.a8) (argvals[0], argvals[1], argvals[2],
+ argvals[3], argvals[4], argvals[5],
+ argvals[6], argvals[7]);
goto done;
default:
gcpro1.nvars = 1 + numargs;
}
- bcopy (args, funcall_args, nargs * sizeof (Lisp_Object));
+ memcpy (funcall_args, args, nargs * sizeof (Lisp_Object));
/* Spread the last arg we got. Its first element goes in
the slot that it used to occupy, hence this value of I. */
i = nargs - 1;
/* Run hook variables in various ways. */
enum run_hooks_condition {to_completion, until_success, until_failure};
-static Lisp_Object run_hook_with_args P_ ((int, Lisp_Object *,
- enum run_hooks_condition));
+static Lisp_Object run_hook_with_args (int, Lisp_Object *,
+ enum run_hooks_condition);
DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0,
doc: /* Run each hook in HOOKS.
except that it isn't necessary to gcpro ARGS[0]. */
static Lisp_Object
-run_hook_with_args (nargs, args, cond)
- int nargs;
- Lisp_Object *args;
- enum run_hooks_condition cond;
+run_hook_with_args (int nargs, Lisp_Object *args, enum run_hooks_condition cond)
{
Lisp_Object sym, val, ret;
- Lisp_Object globals;
struct gcpro gcpro1, gcpro2, gcpro3;
/* If we are dying or still initializing,
}
else
{
- globals = Qnil;
+ Lisp_Object globals = Qnil;
GCPRO3 (sym, val, globals);
for (;
{
/* t indicates this hook has a local binding;
it means to run the global binding too. */
+ globals = Fdefault_value (sym);
+ if (NILP (globals)) continue;
- for (globals = Fdefault_value (sym);
- CONSP (globals) && ((cond == to_completion)
- || (cond == until_success ? NILP (ret)
- : !NILP (ret)));
- globals = XCDR (globals))
+ if (!CONSP (globals) || EQ (XCAR (globals), Qlambda))
+ {
+ args[0] = globals;
+ ret = Ffuncall (nargs, args);
+ }
+ else
{
- 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))
- ret = Ffuncall (nargs, args);
+ for (;
+ CONSP (globals) && ((cond == to_completion)
+ || (cond == until_success ? NILP (ret)
+ : !NILP (ret)));
+ globals = XCDR (globals))
+ {
+ 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))
+ ret = Ffuncall (nargs, args);
+ }
}
}
else
except that it isn't necessary to gcpro ARGS[0]. */
Lisp_Object
-run_hook_list_with_args (funlist, nargs, args)
- Lisp_Object funlist;
- int nargs;
- Lisp_Object *args;
+run_hook_list_with_args (Lisp_Object funlist, int nargs, Lisp_Object *args)
{
Lisp_Object sym;
Lisp_Object val;
/* Run the hook HOOK, giving each function the two args ARG1 and ARG2. */
void
-run_hook_with_args_2 (hook, arg1, arg2)
- Lisp_Object hook, arg1, arg2;
+run_hook_with_args_2 (Lisp_Object hook, Lisp_Object arg1, Lisp_Object arg2)
{
Lisp_Object temp[3];
temp[0] = hook;
\f
/* Apply fn to arg */
Lisp_Object
-apply1 (fn, arg)
- Lisp_Object fn, arg;
+apply1 (Lisp_Object fn, Lisp_Object arg)
{
struct gcpro gcpro1;
if (NILP (arg))
RETURN_UNGCPRO (Ffuncall (1, &fn));
gcpro1.nvars = 2;
-#ifdef NO_ARG_ARRAY
{
Lisp_Object args[2];
args[0] = fn;
gcpro1.var = args;
RETURN_UNGCPRO (Fapply (2, args));
}
-#else /* not NO_ARG_ARRAY */
- RETURN_UNGCPRO (Fapply (2, &fn));
-#endif /* not NO_ARG_ARRAY */
}
/* Call function fn on no arguments */
Lisp_Object
-call0 (fn)
- Lisp_Object fn;
+call0 (Lisp_Object fn)
{
struct gcpro gcpro1;
/* Call function fn with 1 argument arg1 */
/* ARGSUSED */
Lisp_Object
-call1 (fn, arg1)
- Lisp_Object fn, arg1;
+call1 (Lisp_Object fn, Lisp_Object arg1)
{
struct gcpro gcpro1;
-#ifdef NO_ARG_ARRAY
Lisp_Object args[2];
args[0] = fn;
GCPRO1 (args[0]);
gcpro1.nvars = 2;
RETURN_UNGCPRO (Ffuncall (2, args));
-#else /* not NO_ARG_ARRAY */
- GCPRO1 (fn);
- gcpro1.nvars = 2;
- RETURN_UNGCPRO (Ffuncall (2, &fn));
-#endif /* not NO_ARG_ARRAY */
}
/* Call function fn with 2 arguments arg1, arg2 */
/* ARGSUSED */
Lisp_Object
-call2 (fn, arg1, arg2)
- Lisp_Object fn, arg1, arg2;
+call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2)
{
struct gcpro gcpro1;
-#ifdef NO_ARG_ARRAY
Lisp_Object args[3];
args[0] = fn;
args[1] = arg1;
GCPRO1 (args[0]);
gcpro1.nvars = 3;
RETURN_UNGCPRO (Ffuncall (3, args));
-#else /* not NO_ARG_ARRAY */
- GCPRO1 (fn);
- gcpro1.nvars = 3;
- RETURN_UNGCPRO (Ffuncall (3, &fn));
-#endif /* not NO_ARG_ARRAY */
}
/* Call function fn with 3 arguments arg1, arg2, arg3 */
/* ARGSUSED */
Lisp_Object
-call3 (fn, arg1, arg2, arg3)
- Lisp_Object fn, arg1, arg2, arg3;
+call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3)
{
struct gcpro gcpro1;
-#ifdef NO_ARG_ARRAY
Lisp_Object args[4];
args[0] = fn;
args[1] = arg1;
GCPRO1 (args[0]);
gcpro1.nvars = 4;
RETURN_UNGCPRO (Ffuncall (4, args));
-#else /* not NO_ARG_ARRAY */
- GCPRO1 (fn);
- gcpro1.nvars = 4;
- RETURN_UNGCPRO (Ffuncall (4, &fn));
-#endif /* not NO_ARG_ARRAY */
}
/* Call function fn with 4 arguments arg1, arg2, arg3, arg4 */
/* ARGSUSED */
Lisp_Object
-call4 (fn, arg1, arg2, arg3, arg4)
- Lisp_Object fn, arg1, arg2, arg3, arg4;
+call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
+ Lisp_Object arg4)
{
struct gcpro gcpro1;
-#ifdef NO_ARG_ARRAY
Lisp_Object args[5];
args[0] = fn;
args[1] = arg1;
GCPRO1 (args[0]);
gcpro1.nvars = 5;
RETURN_UNGCPRO (Ffuncall (5, args));
-#else /* not NO_ARG_ARRAY */
- GCPRO1 (fn);
- gcpro1.nvars = 5;
- RETURN_UNGCPRO (Ffuncall (5, &fn));
-#endif /* not NO_ARG_ARRAY */
}
/* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5 */
/* ARGSUSED */
Lisp_Object
-call5 (fn, arg1, arg2, arg3, arg4, arg5)
- Lisp_Object fn, arg1, arg2, arg3, arg4, arg5;
+call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
+ Lisp_Object arg4, Lisp_Object arg5)
{
struct gcpro gcpro1;
-#ifdef NO_ARG_ARRAY
Lisp_Object args[6];
args[0] = fn;
args[1] = arg1;
GCPRO1 (args[0]);
gcpro1.nvars = 6;
RETURN_UNGCPRO (Ffuncall (6, args));
-#else /* not NO_ARG_ARRAY */
- GCPRO1 (fn);
- gcpro1.nvars = 6;
- RETURN_UNGCPRO (Ffuncall (6, &fn));
-#endif /* not NO_ARG_ARRAY */
}
/* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6 */
/* ARGSUSED */
Lisp_Object
-call6 (fn, arg1, arg2, arg3, arg4, arg5, arg6)
- Lisp_Object fn, arg1, arg2, arg3, arg4, arg5, arg6;
+call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
+ Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6)
{
struct gcpro gcpro1;
-#ifdef NO_ARG_ARRAY
Lisp_Object args[7];
args[0] = fn;
args[1] = arg1;
GCPRO1 (args[0]);
gcpro1.nvars = 7;
RETURN_UNGCPRO (Ffuncall (7, args));
-#else /* not NO_ARG_ARRAY */
- GCPRO1 (fn);
- gcpro1.nvars = 7;
- RETURN_UNGCPRO (Ffuncall (7, &fn));
-#endif /* not NO_ARG_ARRAY */
+}
+
+/* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7 */
+/* ARGSUSED */
+Lisp_Object
+call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3,
+ Lisp_Object arg4, Lisp_Object arg5, Lisp_Object arg6, Lisp_Object arg7)
+{
+ struct gcpro gcpro1;
+ Lisp_Object args[8];
+ args[0] = fn;
+ args[1] = arg1;
+ args[2] = arg2;
+ args[3] = arg3;
+ args[4] = arg4;
+ args[5] = arg5;
+ args[6] = arg6;
+ args[7] = arg7;
+ GCPRO1 (args[0]);
+ gcpro1.nvars = 8;
+ RETURN_UNGCPRO (Ffuncall (8, args));
}
/* The caller should GCPRO all the elements of ARGS. */
if (XSUBR (fun)->max_args == MANY)
{
- val = (*XSUBR (fun)->function) (numargs, args + 1);
+ val = (XSUBR (fun)->function.am) (numargs, args + 1);
goto done;
}
if (XSUBR (fun)->max_args > numargs)
{
internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object));
- bcopy (args + 1, internal_args, numargs * sizeof (Lisp_Object));
+ memcpy (internal_args, args + 1, numargs * sizeof (Lisp_Object));
for (i = numargs; i < XSUBR (fun)->max_args; i++)
internal_args[i] = Qnil;
}
switch (XSUBR (fun)->max_args)
{
case 0:
- val = (*XSUBR (fun)->function) ();
+ val = (XSUBR (fun)->function.a0) ();
goto done;
case 1:
- val = (*XSUBR (fun)->function) (internal_args[0]);
+ val = (XSUBR (fun)->function.a1) (internal_args[0]);
goto done;
case 2:
- val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1]);
+ val = (XSUBR (fun)->function.a2) (internal_args[0], internal_args[1]);
goto done;
case 3:
- val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
- internal_args[2]);
+ val = (XSUBR (fun)->function.a3) (internal_args[0], internal_args[1],
+ internal_args[2]);
goto done;
case 4:
- val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
- internal_args[2], internal_args[3]);
+ val = (XSUBR (fun)->function.a4) (internal_args[0], internal_args[1],
+ internal_args[2], internal_args[3]);
goto done;
case 5:
- val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
- internal_args[2], internal_args[3],
- internal_args[4]);
+ val = (XSUBR (fun)->function.a5) (internal_args[0], internal_args[1],
+ internal_args[2], internal_args[3],
+ internal_args[4]);
goto done;
case 6:
- val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
- internal_args[2], internal_args[3],
- internal_args[4], internal_args[5]);
+ val = (XSUBR (fun)->function.a6) (internal_args[0], internal_args[1],
+ internal_args[2], internal_args[3],
+ internal_args[4], internal_args[5]);
goto done;
case 7:
- val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
- internal_args[2], internal_args[3],
- internal_args[4], internal_args[5],
- internal_args[6]);
+ val = (XSUBR (fun)->function.a7) (internal_args[0], internal_args[1],
+ internal_args[2], internal_args[3],
+ internal_args[4], internal_args[5],
+ internal_args[6]);
goto done;
case 8:
- val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1],
- internal_args[2], internal_args[3],
- internal_args[4], internal_args[5],
- internal_args[6], internal_args[7]);
+ val = (XSUBR (fun)->function.a8) (internal_args[0], internal_args[1],
+ internal_args[2], internal_args[3],
+ internal_args[4], internal_args[5],
+ internal_args[6], internal_args[7]);
goto done;
default:
}
\f
Lisp_Object
-apply_lambda (fun, args, eval_flag)
- Lisp_Object fun, args;
- int eval_flag;
+apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag)
{
Lisp_Object args_left;
Lisp_Object numargs;
FUN must be either a lambda-expression or a compiled-code object. */
static Lisp_Object
-funcall_lambda (fun, nargs, arg_vector)
- Lisp_Object fun;
- int nargs;
- register Lisp_Object *arg_vector;
+funcall_lambda (Lisp_Object fun, int nargs, register Lisp_Object *arg_vector)
{
Lisp_Object val, syms_left, next;
int count = SPECPDL_INDEX ();
}
\f
void
-grow_specpdl ()
+grow_specpdl (void)
{
register int count = SPECPDL_INDEX ();
if (specpdl_size >= max_specpdl_size)
specpdl_ptr = specpdl + count;
}
+/* specpdl_ptr->symbol is a field which describes which variable is
+ let-bound, so it can be properly undone when we unbind_to.
+ It can have the following two shapes:
+ - SYMBOL : if it's a plain symbol, it means that we have let-bound
+ a symbol that is not buffer-local (at least at the time
+ the let binding started). Note also that it should not be
+ aliased (i.e. when let-binding V1 that's aliased to V2, we want
+ to record V2 here).
+ - (SYMBOL WHERE . BUFFER) : this means that it is a let-binding for
+ variable SYMBOL which can be buffer-local. WHERE tells us
+ which buffer is affected (or nil if the let-binding affects the
+ global value of the variable) and BUFFER tells us which buffer was
+ current (i.e. if WHERE is non-nil, then BUFFER==WHERE, otherwise
+ BUFFER did not yet have a buffer-local value). */
+
void
-specbind (symbol, value)
- Lisp_Object symbol, value;
+specbind (Lisp_Object symbol, Lisp_Object value)
{
- Lisp_Object valcontents;
+ struct Lisp_Symbol *sym;
+
+ eassert (!handling_signal);
CHECK_SYMBOL (symbol);
+ sym = XSYMBOL (symbol);
if (specpdl_ptr == specpdl + specpdl_size)
grow_specpdl ();
- /* The most common case is that of a non-constant symbol with a
- trivial value. Make that as fast as we can. */
- valcontents = SYMBOL_VALUE (symbol);
- if (!MISCP (valcontents) && !SYMBOL_CONSTANT_P (symbol))
- {
- specpdl_ptr->symbol = symbol;
- specpdl_ptr->old_value = valcontents;
- specpdl_ptr->func = NULL;
- ++specpdl_ptr;
- SET_SYMBOL_VALUE (symbol, value);
- }
- else
- {
- Lisp_Object ovalue = find_symbol_value (symbol);
- specpdl_ptr->func = 0;
- specpdl_ptr->old_value = ovalue;
-
- valcontents = XSYMBOL (symbol)->value;
-
- if (BUFFER_LOCAL_VALUEP (valcontents)
- || BUFFER_OBJFWDP (valcontents))
- {
- 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)))
- where = current_buffer;
- else if (BUFFER_LOCAL_VALUEP (valcontents)
- && XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame)
- where = XBUFFER_LOCAL_VALUE (valcontents)->frame;
+ start:
+ switch (sym->redirect)
+ {
+ case SYMBOL_VARALIAS:
+ sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start;
+ 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);
+ specpdl_ptr->func = NULL;
+ ++specpdl_ptr;
+ if (!sym->constant)
+ SET_SYMBOL_VAL (sym, value);
else
- where = Qnil;
-
- /* We're not using the `unused' slot in the specbinding
- structure because this would mean we have to do more
- work for simple variables. */
- specpdl_ptr->symbol = Fcons (symbol, Fcons (where, current_buffer));
-
- /* If SYMBOL is a per-buffer variable which doesn't have a
- buffer-local value here, make the `let' change the global
- value by changing the value of SYMBOL in all buffers not
- having their own value. This is consistent with what
- happens with other buffer-local variables. */
- if (NILP (where)
- && BUFFER_OBJFWDP (valcontents))
- {
- ++specpdl_ptr;
- Fset_default (symbol, value);
- return;
- }
+ set_internal (symbol, value, Qnil, 1);
+ break;
}
- else
- specpdl_ptr->symbol = symbol;
-
- specpdl_ptr++;
- /* We used to do
- if (BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue))
- store_symval_forwarding (symbol, ovalue, value, NULL);
- else
- but ovalue comes from find_symbol_value which should never return
- such an internal value. */
- eassert (!(BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue)));
- set_internal (symbol, value, 0, 1);
+ case SYMBOL_LOCALIZED:
+ if (SYMBOL_BLV (sym)->frame_local)
+ error ("Frame-local vars cannot be let-bound");
+ case SYMBOL_FORWARDED:
+ {
+ Lisp_Object ovalue = find_symbol_value (symbol);
+ specpdl_ptr->func = 0;
+ specpdl_ptr->old_value = ovalue;
+
+ eassert (sym->redirect != SYMBOL_LOCALIZED
+ || (EQ (SYMBOL_BLV (sym)->where,
+ SYMBOL_BLV (sym)->frame_local ?
+ Fselected_frame () : Fcurrent_buffer ())));
+
+ if (sym->redirect == SYMBOL_LOCALIZED
+ || BUFFER_OBJFWDP (SYMBOL_FWD (sym)))
+ {
+ Lisp_Object where, cur_buf = 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)))
+ {
+ eassert (sym->redirect != SYMBOL_LOCALIZED
+ || (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)))
+ where = SYMBOL_BLV (sym)->where;
+ else
+ where = Qnil;
+
+ /* We're not using the `unused' slot in the specbinding
+ structure because this would mean we have to do more
+ work for simple variables. */
+ /* FIXME: The third value `current_buffer' is only used in
+ 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));
+
+ /* If SYMBOL is a per-buffer variable which doesn't have a
+ buffer-local value here, make the `let' change the global
+ value by changing the value of SYMBOL in all buffers not
+ having their own value. This is consistent with what
+ happens with other buffer-local variables. */
+ if (NILP (where)
+ && sym->redirect == SYMBOL_FORWARDED)
+ {
+ eassert (BUFFER_OBJFWDP (SYMBOL_FWD (sym)));
+ ++specpdl_ptr;
+ Fset_default (symbol, value);
+ return;
+ }
+ }
+ else
+ specpdl_ptr->symbol = symbol;
+
+ specpdl_ptr++;
+ set_internal (symbol, value, Qnil, 1);
+ break;
+ }
+ default: abort ();
}
}
void
-record_unwind_protect (function, arg)
- Lisp_Object (*function) P_ ((Lisp_Object));
- Lisp_Object arg;
+record_unwind_protect (Lisp_Object (*function) (Lisp_Object), Lisp_Object arg)
{
eassert (!handling_signal);
}
Lisp_Object
-unbind_to (count, value)
- int count;
- Lisp_Object value;
+unbind_to (int count, Lisp_Object value)
{
Lisp_Object quitf = Vquit_flag;
struct gcpro gcpro1, gcpro2;
if (NILP (where))
Fset_default (symbol, this_binding.old_value);
- else if (BUFFERP (where))
- set_internal (symbol, this_binding.old_value, XBUFFER (where), 1);
- else
- set_internal (symbol, this_binding.old_value, NULL, 1);
+ /* If `where' is non-nil, reset the value in the appropriate
+ local binding, but only if that binding still exists. */
+ else if (BUFFERP (where)
+ ? !NILP (Flocal_variable_p (symbol, where))
+ : !NILP (Fassq (symbol, XFRAME (where)->param_alist)))
+ set_internal (symbol, this_binding.old_value, where, 1);
}
+ /* 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. */
+ else if (XSYMBOL (this_binding.symbol)->redirect == SYMBOL_PLAINVAL)
+ SET_SYMBOL_VAL (XSYMBOL (this_binding.symbol),
+ this_binding.old_value);
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 (this_binding.symbol)))
- SET_SYMBOL_VALUE (this_binding.symbol, this_binding.old_value);
- else
- set_internal (this_binding.symbol, this_binding.old_value, 0, 1);
- }
+ /* NOTE: we only ever come here if make_local_foo was used for
+ the first time on this var within this let. */
+ Fset_default (this_binding.symbol, this_binding.old_value);
}
if (NILP (Vquit_flag) && !NILP (quitf))
\f
void
-mark_backtrace ()
+mark_backtrace (void)
{
register struct backtrace *backlist;
register int i;
}
void
-syms_of_eval ()
+syms_of_eval (void)
{
DEFVAR_INT ("max-specpdl-size", &max_specpdl_size,
doc: /* *Limit on number of Lisp variable bindings and `unwind-protect's.
before making `inhibit-quit' nil. */);
Vinhibit_quit = Qnil;
- Qinhibit_quit = intern ("inhibit-quit");
+ Qinhibit_quit = intern_c_string ("inhibit-quit");
staticpro (&Qinhibit_quit);
- Qautoload = intern ("autoload");
+ Qautoload = intern_c_string ("autoload");
staticpro (&Qautoload);
- Qdebug_on_error = intern ("debug-on-error");
+ Qdebug_on_error = intern_c_string ("debug-on-error");
staticpro (&Qdebug_on_error);
- Qmacro = intern ("macro");
+ Qmacro = intern_c_string ("macro");
staticpro (&Qmacro);
- Qdeclare = intern ("declare");
+ Qdeclare = intern_c_string ("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");
+ Qexit = intern_c_string ("exit");
staticpro (&Qexit);
- Qinteractive = intern ("interactive");
+ Qinteractive = intern_c_string ("interactive");
staticpro (&Qinteractive);
- Qcommandp = intern ("commandp");
+ Qcommandp = intern_c_string ("commandp");
staticpro (&Qcommandp);
- Qdefun = intern ("defun");
+ Qdefun = intern_c_string ("defun");
staticpro (&Qdefun);
- Qand_rest = intern ("&rest");
+ Qand_rest = intern_c_string ("&rest");
staticpro (&Qand_rest);
- Qand_optional = intern ("&optional");
+ Qand_optional = intern_c_string ("&optional");
staticpro (&Qand_optional);
- Qdebug = intern ("debug");
+ Qdebug = intern_c_string ("debug");
staticpro (&Qdebug);
DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error,
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.
-See also variable `debug-on-quit'. */);
+The command `toggle-debug-on-error' toggles this.
+See also the variable `debug-on-quit'. */);
Vdebug_on_error = Qnil;
DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors,
The value the function returns is not used. */);
Vmacro_declaration_function = Qnil;
- Vrun_hooks = intern ("run-hooks");
+ Vrun_hooks = intern_c_string ("run-hooks");
staticpro (&Vrun_hooks);
staticpro (&Vautoload_queue);