#include <config.h>
#include "lisp.h"
#include "blockinput.h"
#include "commands.h"
#include "keyboard.h"
#include "dispextern.h"
#include <setjmp.h>
#if HAVE_X_WINDOWS
#include "xterm.h"
#endif
struct backtrace
{
struct backtrace *next;
Lisp_Object *function;
Lisp_Object *args;
int nargs;
char evalargs;
char debug_on_exit;
};
struct backtrace *backtrace_list;
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
int gcpro_level;
#endif
Lisp_Object Qautoload, Qmacro, Qexit, Qinteractive, Qcommandp, Qdefun;
Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag;
Lisp_Object Qand_rest, Qand_optional;
Lisp_Object Qdebug_on_error;
Lisp_Object Qdeclare;
Lisp_Object Vrun_hooks;
Lisp_Object Vautoload_queue;
int specpdl_size;
struct specbinding *specpdl;
struct specbinding *specpdl_ptr;
EMACS_INT max_specpdl_size;
int lisp_eval_depth;
EMACS_INT max_lisp_eval_depth;
int debug_on_next_call;
int debugger_may_continue;
Lisp_Object Vstack_trace_on_error;
Lisp_Object Vdebug_on_error;
Lisp_Object Vdebug_ignored_errors;
Lisp_Object Vdebug_on_signal;
Lisp_Object Vsignal_hook_function;
int debug_on_quit;
int when_entered_debugger;
Lisp_Object Vdebugger;
Lisp_Object Vsignaling_function;
int handling_signal;
Lisp_Object Vmacro_declaration_function;
extern Lisp_Object Qrisky_local_variable;
static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, Lisp_Object*));
static void unwind_to_catch P_ ((struct catchtag *, Lisp_Object)) NO_RETURN;
#if __GNUC__
Lisp_Object apply1 () __attribute__((noinline));
Lisp_Object call2 () __attribute__((noinline));
#endif
void
init_eval_once ()
{
specpdl_size = 50;
specpdl = (struct specbinding *) xmalloc (specpdl_size * sizeof (struct specbinding));
specpdl_ptr = specpdl;
max_specpdl_size = 1000;
max_lisp_eval_depth = 300;
Vrun_hooks = Qnil;
}
void
init_eval ()
{
specpdl_ptr = specpdl;
catchlist = 0;
handlerlist = 0;
backtrace_list = 0;
Vquit_flag = Qnil;
debug_on_next_call = 0;
lisp_eval_depth = 0;
#ifdef DEBUG_GCPRO
gcpro_level = 0;
#endif
when_entered_debugger = -1;
}
static Lisp_Object
restore_stack_limits (data)
Lisp_Object data;
{
max_specpdl_size = XINT (XCAR (data));
max_lisp_eval_depth = XINT (XCDR (data));
return Qnil;
}
Lisp_Object
call_debugger (arg)
Lisp_Object arg;
{
int debug_while_redisplaying;
int count = SPECPDL_INDEX ();
Lisp_Object val;
int old_max = max_specpdl_size;
max_specpdl_size += 1;
record_unwind_protect (restore_stack_limits,
Fcons (make_number (old_max),
make_number (max_lisp_eval_depth)));
max_specpdl_size = old_max;
if (lisp_eval_depth + 40 > max_lisp_eval_depth)
max_lisp_eval_depth = lisp_eval_depth + 40;
if (SPECPDL_INDEX () + 100 > max_specpdl_size)
max_specpdl_size = SPECPDL_INDEX () + 100;
#ifdef HAVE_X_WINDOWS
if (display_hourglass_p)
cancel_hourglass ();
#endif
debug_on_next_call = 0;
when_entered_debugger = num_nonmacro_input_events;
debug_while_redisplaying = redisplaying_p;
redisplaying_p = 0;
specbind (intern ("debugger-may-continue"),
debug_while_redisplaying ? Qnil : Qt);
specbind (Qinhibit_redisplay, Qnil);
specbind (Qdebug_on_error, Qnil);
#if 0
specbind (Qinhibit_eval_during_redisplay, Qt);
#endif
val = apply1 (Vdebugger, arg);
if (debug_while_redisplaying)
Ftop_level ();
return unbind_to (count, val);
}
void
do_debug_on_call (code)
Lisp_Object code;
{
debug_on_next_call = 0;
backtrace_list->debug_on_exit = 1;
call_debugger (Fcons (code, Qnil));
}
DEFUN ("or", For, Sor, 0, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
register Lisp_Object val = Qnil;
struct gcpro gcpro1;
GCPRO1 (args);
while (CONSP (args))
{
val = Feval (XCAR (args));
if (!NILP (val))
break;
args = XCDR (args);
}
UNGCPRO;
return val;
}
DEFUN ("and", Fand, Sand, 0, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
register Lisp_Object val = Qt;
struct gcpro gcpro1;
GCPRO1 (args);
while (CONSP (args))
{
val = Feval (XCAR (args));
if (NILP (val))
break;
args = XCDR (args);
}
UNGCPRO;
return val;
}
DEFUN ("if", Fif, Sif, 2, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
register Lisp_Object cond;
struct gcpro gcpro1;
GCPRO1 (args);
cond = Feval (Fcar (args));
UNGCPRO;
if (!NILP (cond))
return Feval (Fcar (Fcdr (args)));
return Fprogn (Fcdr (Fcdr (args)));
}
DEFUN ("cond", Fcond, Scond, 0, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
register Lisp_Object clause, val;
struct gcpro gcpro1;
val = Qnil;
GCPRO1 (args);
while (!NILP (args))
{
clause = Fcar (args);
val = Feval (Fcar (clause));
if (!NILP (val))
{
if (!EQ (XCDR (clause), Qnil))
val = Fprogn (XCDR (clause));
break;
}
args = XCDR (args);
}
UNGCPRO;
return val;
}
DEFUN ("progn", Fprogn, Sprogn, 0, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
register Lisp_Object val = Qnil;
struct gcpro gcpro1;
GCPRO1 (args);
while (CONSP (args))
{
val = Feval (XCAR (args));
args = XCDR (args);
}
UNGCPRO;
return val;
}
DEFUN ("prog1", Fprog1, Sprog1, 1, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
Lisp_Object val;
register Lisp_Object args_left;
struct gcpro gcpro1, gcpro2;
register int argnum = 0;
if (NILP(args))
return Qnil;
args_left = args;
val = Qnil;
GCPRO2 (args, val);
do
{
if (!(argnum++))
val = Feval (Fcar (args_left));
else
Feval (Fcar (args_left));
args_left = Fcdr (args_left);
}
while (!NILP(args_left));
UNGCPRO;
return val;
}
DEFUN ("prog2", Fprog2, Sprog2, 2, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
Lisp_Object val;
register Lisp_Object args_left;
struct gcpro gcpro1, gcpro2;
register int argnum = -1;
val = Qnil;
if (NILP (args))
return Qnil;
args_left = args;
val = Qnil;
GCPRO2 (args, val);
do
{
if (!(argnum++))
val = Feval (Fcar (args_left));
else
Feval (Fcar (args_left));
args_left = Fcdr (args_left);
}
while (!NILP (args_left));
UNGCPRO;
return val;
}
DEFUN ("setq", Fsetq, Ssetq, 0, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
register Lisp_Object args_left;
register Lisp_Object val, sym;
struct gcpro gcpro1;
if (NILP(args))
return Qnil;
args_left = args;
GCPRO1 (args);
do
{
val = Feval (Fcar (Fcdr (args_left)));
sym = Fcar (args_left);
Fset (sym, val);
args_left = Fcdr (Fcdr (args_left));
}
while (!NILP(args_left));
UNGCPRO;
return val;
}
DEFUN ("quote", Fquote, Squote, 1, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
return Fcar (args);
}
DEFUN ("function", Ffunction, Sfunction, 1, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
return Fcar (args);
}
DEFUN ("interactive-p", Finteractive_p, Sinteractive_p, 0, 0, 0,
doc: )
()
{
return (INTERACTIVE && interactive_p (1)) ? Qt : Qnil;
}
DEFUN ("called-interactively-p", Fcalled_interactively_p, Scalled_interactively_p, 0, 0, 0,
doc: )
()
{
return interactive_p (1) ? Qt : Qnil;
}
int
interactive_p (exclude_subrs_p)
int exclude_subrs_p;
{
struct backtrace *btp;
Lisp_Object fun;
btp = backtrace_list;
fun = Findirect_function (*btp->function, Qnil);
if (SUBRP (fun) && (XSUBR (fun) == &Sinteractive_p
|| XSUBR (fun) == &Scalled_interactively_p))
btp = btp->next;
while (btp
&& (EQ (*btp->function, Qbytecode)
|| btp->nargs == UNEVALLED))
btp = btp->next;
fun = Findirect_function (*btp->function, Qnil);
if (exclude_subrs_p && SUBRP (fun))
return 0;
if (btp && btp->next && EQ (*btp->next->function, Qcall_interactively))
return 1;
return 0;
}
DEFUN ("defun", Fdefun, Sdefun, 2, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
register Lisp_Object fn_name;
register Lisp_Object defn;
fn_name = Fcar (args);
CHECK_SYMBOL (fn_name);
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 (Fcons (Qdefun, fn_name));
return fn_name;
}
DEFUN ("defmacro", Fdefmacro, Sdefmacro, 2, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
register Lisp_Object fn_name;
register Lisp_Object defn;
Lisp_Object lambda_list, doc, tail;
fn_name = Fcar (args);
CHECK_SYMBOL (fn_name);
lambda_list = Fcar (Fcdr (args));
tail = Fcdr (Fcdr (args));
doc = Qnil;
if (STRINGP (Fcar (tail)))
{
doc = XCAR (tail);
tail = XCDR (tail);
}
while (CONSP (Fcar (tail))
&& EQ (Fcar (Fcar (tail)), Qdeclare))
{
if (!NILP (Vmacro_declaration_function))
{
struct gcpro gcpro1;
GCPRO1 (args);
call2 (Vmacro_declaration_function, fn_name, Fcar (tail));
UNGCPRO;
}
tail = Fcdr (tail);
}
if (NILP (doc))
tail = Fcons (lambda_list, tail);
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 (Fcons (Qdefun, fn_name));
return fn_name;
}
DEFUN ("defvaralias", Fdefvaralias, Sdefvaralias, 2, 3, 0,
doc: )
(new_alias, base_variable, docstring)
Lisp_Object new_alias, base_variable, docstring;
{
struct Lisp_Symbol *sym;
CHECK_SYMBOL (new_alias);
CHECK_SYMBOL (base_variable);
if (SYMBOL_CONSTANT_P (new_alias))
error ("Cannot make a constant an alias");
sym = XSYMBOL (new_alias);
sym->indirect_variable = 1;
sym->value = 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);
return base_variable;
}
DEFUN ("defvar", Fdefvar, Sdefvar, 1, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
register Lisp_Object sym, tem, tail;
sym = Fcar (args);
tail = Fcdr (args);
if (!NILP (Fcdr (Fcdr (tail))))
error ("Too many arguments");
tem = Fdefault_boundp (sym);
if (!NILP (tail))
{
if (SYMBOL_CONSTANT_P (sym))
{
Lisp_Object tem = Fcar (tail);
if (! (CONSP (tem)
&& EQ (XCAR (tem), Qquote)
&& CONSP (XCDR (tem))
&& EQ (XCAR (XCDR (tem)), sym)))
error ("Constant symbol `%s' specified in defvar",
SDATA (SYMBOL_NAME (sym)));
}
if (NILP (tem))
Fset_default (sym, Feval (Fcar (tail)));
else
{
volatile struct specbinding *pdl = specpdl_ptr;
while (--pdl >= specpdl)
{
if (EQ (pdl->symbol, sym) && !pdl->func
&& EQ (pdl->old_value, Qunbound))
{
message_with_string ("Warning: defvar ignored because %s is let-bound",
SYMBOL_NAME (sym), 1);
break;
}
}
}
tail = Fcdr (tail);
tem = Fcar (tail);
if (!NILP (tem))
{
if (!NILP (Vpurify_flag))
tem = Fpurecopy (tem);
Fput (sym, Qvariable_documentation, tem);
}
LOADHIST_ATTACH (sym);
}
else
;
return sym;
}
DEFUN ("defconst", Fdefconst, Sdefconst, 2, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
register Lisp_Object sym, tem;
sym = Fcar (args);
if (!NILP (Fcdr (Fcdr (Fcdr (args)))))
error ("Too many arguments");
tem = Feval (Fcar (Fcdr (args)));
if (!NILP (Vpurify_flag))
tem = Fpurecopy (tem);
Fset_default (sym, tem);
tem = Fcar (Fcdr (Fcdr (args)));
if (!NILP (tem))
{
if (!NILP (Vpurify_flag))
tem = Fpurecopy (tem);
Fput (sym, Qvariable_documentation, tem);
}
Fput (sym, Qrisky_local_variable, Qt);
LOADHIST_ATTACH (sym);
return sym;
}
static Lisp_Object
user_variable_p_eh (ignore)
Lisp_Object ignore;
{
return Qnil;
}
DEFUN ("user-variable-p", Fuser_variable_p, Suser_variable_p, 1, 1, 0,
doc: )
(variable)
Lisp_Object variable;
{
Lisp_Object documentation;
if (!SYMBOLP (variable))
return Qnil;
if (XSYMBOL (variable)->indirect_variable
&& NILP (internal_condition_case_1 (indirect_variable, variable,
Qt, user_variable_p_eh)))
return Qnil;
while (1)
{
documentation = Fget (variable, Qvariable_documentation);
if (INTEGERP (documentation) && XINT (documentation) < 0)
return Qt;
if (STRINGP (documentation)
&& ((unsigned char) SREF (documentation, 0) == '*'))
return Qt;
if (CONSP (documentation)
&& STRINGP (XCAR (documentation))
&& INTEGERP (XCDR (documentation))
&& XINT (XCDR (documentation)) < 0)
return Qt;
if ((!NILP (Fget (variable, intern ("standard-value"))))
|| (!NILP (Fget (variable, intern ("custom-autoload")))))
return Qt;
if (!XSYMBOL (variable)->indirect_variable)
return Qnil;
variable = XSYMBOL (variable)->value;
}
}
DEFUN ("let*", FletX, SletX, 1, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
Lisp_Object varlist, val, elt;
int count = SPECPDL_INDEX ();
struct gcpro gcpro1, gcpro2, gcpro3;
GCPRO3 (args, elt, varlist);
varlist = Fcar (args);
while (!NILP (varlist))
{
QUIT;
elt = Fcar (varlist);
if (SYMBOLP (elt))
specbind (elt, Qnil);
else if (! NILP (Fcdr (Fcdr (elt))))
signal_error ("`let' bindings can have only one value-form", elt);
else
{
val = Feval (Fcar (Fcdr (elt)));
specbind (Fcar (elt), val);
}
varlist = Fcdr (varlist);
}
UNGCPRO;
val = Fprogn (Fcdr (args));
return unbind_to (count, val);
}
DEFUN ("let", Flet, Slet, 1, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
Lisp_Object *temps, tem;
register Lisp_Object elt, varlist;
int count = SPECPDL_INDEX ();
register int argnum;
struct gcpro gcpro1, gcpro2;
varlist = Fcar (args);
elt = Flength (varlist);
temps = (Lisp_Object *) alloca (XFASTINT (elt) * sizeof (Lisp_Object));
GCPRO2 (args, *temps);
gcpro2.nvars = 0;
for (argnum = 0; !NILP (varlist); varlist = Fcdr (varlist))
{
QUIT;
elt = Fcar (varlist);
if (SYMBOLP (elt))
temps [argnum++] = Qnil;
else if (! NILP (Fcdr (Fcdr (elt))))
signal_error ("`let' bindings can have only one value-form", elt);
else
temps [argnum++] = Feval (Fcar (Fcdr (elt)));
gcpro2.nvars = argnum;
}
UNGCPRO;
varlist = Fcar (args);
for (argnum = 0; !NILP (varlist); varlist = Fcdr (varlist))
{
elt = Fcar (varlist);
tem = temps[argnum++];
if (SYMBOLP (elt))
specbind (elt, tem);
else
specbind (Fcar (elt), tem);
}
elt = Fprogn (Fcdr (args));
return unbind_to (count, elt);
}
DEFUN ("while", Fwhile, Swhile, 1, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
Lisp_Object test, body;
struct gcpro gcpro1, gcpro2;
GCPRO2 (test, body);
test = Fcar (args);
body = Fcdr (args);
while (!NILP (Feval (test)))
{
QUIT;
Fprogn (body);
}
UNGCPRO;
return Qnil;
}
DEFUN ("macroexpand", Fmacroexpand, Smacroexpand, 1, 2, 0,
doc: )
(form, environment)
Lisp_Object form;
Lisp_Object environment;
{
register Lisp_Object expander, sym, def, tem;
while (1)
{
if (!CONSP (form))
break;
def = sym = XCAR (form);
tem = Qnil;
while (SYMBOLP (def))
{
QUIT;
sym = def;
tem = Fassq (sym, environment);
if (NILP (tem))
{
def = XSYMBOL (sym)->function;
if (!EQ (def, Qunbound))
continue;
}
break;
}
if (NILP (tem))
{
if (EQ (def, Qunbound) || !CONSP (def))
break;
if (EQ (XCAR (def), Qautoload))
{
tem = Fnth (make_number (4), def);
if (EQ (tem, Qt) || EQ (tem, Qmacro))
{
struct gcpro gcpro1;
GCPRO1 (form);
do_autoload (def, sym);
UNGCPRO;
continue;
}
else
break;
}
else if (!EQ (XCAR (def), Qmacro))
break;
else expander = XCDR (def);
}
else
{
expander = XCDR (tem);
if (NILP (expander))
break;
}
form = apply1 (expander, XCDR (form));
}
return form;
}
DEFUN ("catch", Fcatch, Scatch, 1, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
register Lisp_Object tag;
struct gcpro gcpro1;
GCPRO1 (args);
tag = Feval (Fcar (args));
UNGCPRO;
return internal_catch (tag, Fprogn, Fcdr (args));
}
Lisp_Object
internal_catch (tag, func, arg)
Lisp_Object tag;
Lisp_Object (*func) ();
Lisp_Object arg;
{
struct catchtag c;
c.next = catchlist;
c.tag = tag;
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;
catchlist = &c;
if (! _setjmp (c.jmp))
c.val = (*func) (arg);
catchlist = c.next;
return c.val;
}
static void
unwind_to_catch (catch, value)
struct catchtag *catch;
Lisp_Object value;
{
register int last_time;
catch->val = value;
set_poll_suppress_count (catch->poll_suppress_count);
UNBLOCK_INPUT_TO (catch->interrupt_input_blocked);
handling_signal = 0;
immediate_quit = 0;
do
{
last_time = catchlist == catch;
unbind_to (catchlist->pdlcount, Qnil);
handlerlist = catchlist->handlerlist;
catchlist = catchlist->next;
}
while (! last_time);
#if HAVE_X_WINDOWS
x_fully_uncatch_errors ();
#endif
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;
_longjmp (catch->jmp, 1);
}
DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0,
doc: )
(tag, value)
register Lisp_Object tag, value;
{
register struct catchtag *c;
if (!NILP (tag))
for (c = catchlist; c; c = c->next)
{
if (EQ (c->tag, tag))
unwind_to_catch (c, value);
}
xsignal2 (Qno_catch, tag, value);
}
DEFUN ("unwind-protect", Funwind_protect, Sunwind_protect, 1, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
Lisp_Object val;
int count = SPECPDL_INDEX ();
record_unwind_protect (Fprogn, Fcdr (args));
val = Feval (Fcar (args));
return unbind_to (count, val);
}
struct handler *handlerlist;
DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0,
doc: )
(args)
Lisp_Object args;
{
register Lisp_Object bodyform, handlers;
volatile Lisp_Object var;
var = Fcar (args);
bodyform = Fcar (Fcdr (args));
handlers = Fcdr (Fcdr (args));
return internal_lisp_condition_case (var, bodyform, handlers);
}
Lisp_Object
internal_lisp_condition_case (var, bodyform, handlers)
volatile Lisp_Object var;
Lisp_Object bodyform, handlers;
{
Lisp_Object val;
struct catchtag c;
struct handler h;
CHECK_SYMBOL (var);
for (val = handlers; CONSP (val); val = XCDR (val))
{
Lisp_Object tem;
tem = XCAR (val);
if (! (NILP (tem)
|| (CONSP (tem)
&& (SYMBOLP (XCAR (tem))
|| CONSP (XCAR (tem))))))
error ("Invalid condition handler", tem);
}
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))
{
if (!NILP (h.var))
specbind (h.var, c.val);
val = Fprogn (Fcdr (h.chosen_clause));
unbind_to (c.pdlcount, Qnil);
return val;
}
c.next = catchlist;
catchlist = &c;
h.var = var;
h.handler = handlers;
h.next = handlerlist;
h.tag = &c;
handlerlist = &h;
val = Feval (bodyform);
catchlist = c.next;
handlerlist = h.next;
return val;
}
Lisp_Object
internal_condition_case (bfun, handlers, hfun)
Lisp_Object (*bfun) ();
Lisp_Object handlers;
Lisp_Object (*hfun) ();
{
Lisp_Object val;
struct catchtag c;
struct handler h;
#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) ();
catchlist = c.next;
handlerlist = h.next;
return val;
}
Lisp_Object
internal_condition_case_1 (bfun, arg, handlers, hfun)
Lisp_Object (*bfun) ();
Lisp_Object arg;
Lisp_Object handlers;
Lisp_Object (*hfun) ();
{
Lisp_Object val;
struct catchtag c;
struct handler h;
#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) (arg);
catchlist = c.next;
handlerlist = h.next;
return val;
}
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) ();
{
Lisp_Object val;
struct catchtag c;
struct handler h;
#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) (nargs, args);
catchlist = c.next;
handlerlist = h.next;
return val;
}
static Lisp_Object find_handler_clause P_ ((Lisp_Object, Lisp_Object,
Lisp_Object, Lisp_Object,
Lisp_Object *));
DEFUN ("signal", Fsignal, Ssignal, 2, 2, 0,
doc: )
(error_symbol, data)
Lisp_Object error_symbol, data;
{
register struct handler *allhandlers = handlerlist;
Lisp_Object conditions;
extern int gc_in_progress;
extern int waiting_for_input;
Lisp_Object debugger_value;
Lisp_Object string;
Lisp_Object real_error_symbol;
struct backtrace *bp;
immediate_quit = handling_signal = 0;
abort_on_gc = 0;
if (gc_in_progress || waiting_for_input)
abort ();
if (NILP (error_symbol))
real_error_symbol = Fcar (data);
else
real_error_symbol = error_symbol;
#if 0
#ifdef HAVE_X_WINDOWS
if (display_hourglass_p)
cancel_hourglass ();
#endif
#endif
if (! NILP (Vsignal_hook_function)
&& ! NILP (error_symbol))
{
if (lisp_eval_depth + 20 > max_lisp_eval_depth)
max_lisp_eval_depth = lisp_eval_depth + 20;
if (SPECPDL_INDEX () + 40 > max_specpdl_size)
max_specpdl_size = SPECPDL_INDEX () + 40;
call2 (Vsignal_hook_function, error_symbol, data);
}
conditions = Fget (real_error_symbol, Qerror_conditions);
Vsignaling_function = Qnil;
if (backtrace_list && !NILP (error_symbol))
{
bp = backtrace_list->next;
if (bp && bp->function && EQ (*bp->function, Qerror))
bp = bp->next;
if (bp && bp->function)
Vsignaling_function = *bp->function;
}
for (; handlerlist; handlerlist = handlerlist->next)
{
register Lisp_Object clause;
clause = find_handler_clause (handlerlist->handler, conditions,
error_symbol, data, &debugger_value);
if (EQ (clause, Qlambda))
{
if (EQ (real_error_symbol, Qquit))
return Qnil;
else
error ("Cannot return from the debugger in an error");
}
if (!NILP (clause))
{
Lisp_Object unwind_data;
struct handler *h = handlerlist;
handlerlist = allhandlers;
if (NILP (error_symbol))
unwind_data = data;
else
unwind_data = Fcons (error_symbol, data);
h->chosen_clause = clause;
unwind_to_catch (h->tag, unwind_data);
}
}
handlerlist = allhandlers;
find_handler_clause (Qerror, conditions, error_symbol, data, &debugger_value);
if (catchlist != 0)
Fthrow (Qtop_level, Qt);
if (! NILP (error_symbol))
data = Fcons (error_symbol, data);
string = Ferror_message_string (data);
fatal ("%s", SDATA (string), 0);
}
void
xsignal (error_symbol, data)
Lisp_Object error_symbol, data;
{
Fsignal (error_symbol, data);
abort ();
}
void
xsignal0 (error_symbol)
Lisp_Object error_symbol;
{
xsignal (error_symbol, Qnil);
}
void
xsignal1 (error_symbol, arg)
Lisp_Object error_symbol, arg;
{
xsignal (error_symbol, list1 (arg));
}
void
xsignal2 (error_symbol, arg1, arg2)
Lisp_Object error_symbol, arg1, arg2;
{
xsignal (error_symbol, list2 (arg1, arg2));
}
void
xsignal3 (error_symbol, arg1, arg2, arg3)
Lisp_Object error_symbol, arg1, arg2, arg3;
{
xsignal (error_symbol, list3 (arg1, arg2, arg3));
}
void
signal_error (s, arg)
char *s;
Lisp_Object arg;
{
Lisp_Object tortoise, hare;
hare = tortoise = arg;
while (CONSP (hare))
{
hare = XCDR (hare);
if (!CONSP (hare))
break;
hare = XCDR (hare);
tortoise = XCDR (tortoise);
if (EQ (hare, tortoise))
break;
}
if (!NILP (hare))
arg = Fcons (arg, Qnil);
xsignal (Qerror, Fcons (build_string (s), arg));
}
static int
wants_debugger (list, conditions)
Lisp_Object list, conditions;
{
if (NILP (list))
return 0;
if (! CONSP (list))
return 1;
while (CONSP (conditions))
{
Lisp_Object this, tail;
this = XCAR (conditions);
for (tail = list; CONSP (tail); tail = XCDR (tail))
if (EQ (XCAR (tail), this))
return 1;
conditions = XCDR (conditions);
}
return 0;
}
static int
skip_debugger (conditions, data)
Lisp_Object conditions, data;
{
Lisp_Object tail;
int first_string = 1;
Lisp_Object error_message;
error_message = Qnil;
for (tail = Vdebug_ignored_errors; CONSP (tail); tail = XCDR (tail))
{
if (STRINGP (XCAR (tail)))
{
if (first_string)
{
error_message = Ferror_message_string (data);
first_string = 0;
}
if (fast_string_match (XCAR (tail), error_message) >= 0)
return 1;
}
else
{
Lisp_Object contail;
for (contail = conditions; CONSP (contail); contail = XCDR (contail))
if (EQ (XCAR (tail), XCAR (contail)))
return 1;
}
}
return 0;
}
static Lisp_Object
find_handler_clause (handlers, conditions, sig, data, debugger_value_ptr)
Lisp_Object handlers, conditions, sig, data;
Lisp_Object *debugger_value_ptr;
{
register Lisp_Object h;
register Lisp_Object tem;
if (EQ (handlers, Qt))
return Qt;
if (EQ (handlers, Qerror)
|| !NILP (Vdebug_on_signal))
{
int debugger_called = 0;
Lisp_Object sig_symbol, combined_data;
int no_debugger = 0;
if (NILP (sig))
{
combined_data = data;
sig_symbol = Fcar (data);
no_debugger = 1;
}
else
{
combined_data = Fcons (sig, data);
sig_symbol = sig;
}
if (wants_debugger (Vstack_trace_on_error, conditions))
{
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
max_specpdl_size--;
}
if (! no_debugger
&& ! INPUT_BLOCKED_P
&& (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)
{
*debugger_value_ptr
= call_debugger (Fcons (Qerror,
Fcons (combined_data, Qnil)));
debugger_called = 1;
}
if (EQ (handlers, Qerror))
{
if (debugger_called)
return Qlambda;
return Qt;
}
}
for (h = handlers; CONSP (h); h = Fcdr (h))
{
Lisp_Object handler, condit;
handler = Fcar (h);
if (!CONSP (handler))
continue;
condit = Fcar (handler);
if (SYMBOLP (condit))
{
tem = Fmemq (Fcar (handler), conditions);
if (!NILP (tem))
return handler;
}
else if (CONSP (condit))
{
while (CONSP (condit))
{
tem = Fmemq (Fcar (condit), conditions);
if (!NILP (tem))
return handler;
condit = XCDR (condit);
}
}
}
return Qnil;
}
void
error (m, a1, a2, a3)
char *m;
char *a1, *a2, *a3;
{
char buf[200];
int size = 200;
int mlen;
char *buffer = buf;
char *args[3];
int allocated = 0;
Lisp_Object string;
args[0] = a1;
args[1] = a2;
args[2] = a3;
mlen = strlen (m);
while (1)
{
int used = doprnt (buffer, size, m, m + mlen, 3, args);
if (used < size)
break;
size *= 2;
if (allocated)
buffer = (char *) xrealloc (buffer, size);
else
{
buffer = (char *) xmalloc (size);
allocated = 1;
}
}
string = build_string (buffer);
if (allocated)
xfree (buffer);
xsignal1 (Qerror, string);
}
DEFUN ("commandp", Fcommandp, Scommandp, 1, 2, 0,
doc: )
(function, for_call_interactively)
Lisp_Object function, for_call_interactively;
{
register Lisp_Object fun;
register Lisp_Object funcar;
fun = function;
fun = indirect_function (fun);
if (EQ (fun, Qunbound))
return Qnil;
if (SUBRP (fun))
{
if (XSUBR (fun)->prompt)
return Qt;
else
return Qnil;
}
else if (COMPILEDP (fun))
return ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_INTERACTIVE
? Qt : Qnil);
if (NILP (for_call_interactively) && (STRINGP (fun) || VECTORP (fun)))
return Qt;
if (!CONSP (fun))
return Qnil;
funcar = XCAR (fun);
if (EQ (funcar, Qlambda))
return Fassq (Qinteractive, Fcdr (XCDR (fun)));
if (EQ (funcar, Qautoload))
return Fcar (Fcdr (Fcdr (XCDR (fun))));
else
return Qnil;
}
DEFUN ("autoload", Fautoload, Sautoload, 2, 5, 0,
doc: )
(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);
if (!EQ (XSYMBOL (function)->function, Qunbound)
&& !(CONSP (XSYMBOL (function)->function)
&& EQ (XCAR (XSYMBOL (function)->function), Qautoload)))
return Qnil;
if (NILP (Vpurify_flag))
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
return Ffset (function, Fcons (Qautoload, Flist (4, &file)));
#endif
}
Lisp_Object
un_autoload (oldqueue)
Lisp_Object oldqueue;
{
register Lisp_Object queue, first, second;
queue = Vautoload_queue;
Vautoload_queue = oldqueue;
while (CONSP (queue))
{
first = XCAR (queue);
second = Fcdr (first);
first = Fcar (first);
if (EQ (first, make_number (0)))
Vfeatures = second;
else
Ffset (first, second);
queue = XCDR (queue);
}
return Qnil;
}
void
do_autoload (fundef, funname)
Lisp_Object fundef, funname;
{
int count = SPECPDL_INDEX ();
Lisp_Object fun, queue, first, second;
struct gcpro gcpro1, gcpro2, gcpro3;
if (! NILP (Vpurify_flag))
error ("Attempt to autoload %s while preparing to dump",
SDATA (SYMBOL_NAME (funname)));
fun = funname;
CHECK_SYMBOL (funname);
GCPRO3 (fun, funname, fundef);
record_unwind_save_match_data ();
record_unwind_protect (un_autoload, Vautoload_queue);
Vautoload_queue = Qt;
Fload (Fcar (Fcdr (fundef)), Qnil, noninteractive ? Qt : Qnil, Qnil, Qt);
queue = Vautoload_queue;
while (CONSP (queue))
{
first = XCAR (queue);
second = Fcdr (first);
first = Fcar (first);
if (SYMBOLP (first) && CONSP (second) && EQ (XCAR (second), Qautoload))
Fput (first, Qautoload, (XCDR (second)));
queue = XCDR (queue);
}
Vautoload_queue = Qt;
unbind_to (count, Qnil);
fun = Findirect_function (fun, Qnil);
if (!NILP (Fequal (fun, fundef)))
error ("Autoloading failed to define function %s",
SDATA (SYMBOL_NAME (funname)));
UNGCPRO;
}
DEFUN ("eval", Feval, Seval, 1, 1, 0,
doc: )
(form)
Lisp_Object form;
{
Lisp_Object fun, val, original_fun, original_args;
Lisp_Object funcar;
struct backtrace backtrace;
struct gcpro gcpro1, gcpro2, gcpro3;
if (handling_signal)
abort ();
if (SYMBOLP (form))
return Fsymbol_value (form);
if (!CONSP (form))
return form;
QUIT;
if ((consing_since_gc > gc_cons_threshold
&& consing_since_gc > gc_relative_threshold)
||
(!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold))
{
GCPRO1 (form);
Fgarbage_collect ();
UNGCPRO;
}
if (++lisp_eval_depth > max_lisp_eval_depth)
{
if (max_lisp_eval_depth < 100)
max_lisp_eval_depth = 100;
if (lisp_eval_depth > max_lisp_eval_depth)
error ("Lisp nesting exceeds `max-lisp-eval-depth'");
}
original_fun = Fcar (form);
original_args = Fcdr (form);
backtrace.next = backtrace_list;
backtrace_list = &backtrace;
backtrace.function = &original_fun;
backtrace.args = &original_args;
backtrace.nargs = UNEVALLED;
backtrace.evalargs = 1;
backtrace.debug_on_exit = 0;
if (debug_on_next_call)
do_debug_on_call (Qt);
retry:
fun = original_fun;
if (SYMBOLP (fun) && !EQ (fun, Qunbound)
&& (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
fun = indirect_function (fun);
if (SUBRP (fun))
{
Lisp_Object numargs;
Lisp_Object argvals[8];
Lisp_Object args_left;
register int i, maxargs;
args_left = original_args;
numargs = Flength (args_left);
CHECK_CONS_LIST ();
if (XINT (numargs) < XSUBR (fun)->min_args ||
(XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < XINT (numargs)))
xsignal2 (Qwrong_number_of_arguments, original_fun, numargs);
if (XSUBR (fun)->max_args == UNEVALLED)
{
backtrace.evalargs = 0;
val = (*XSUBR (fun)->function) (args_left);
goto done;
}
if (XSUBR (fun)->max_args == MANY)
{
Lisp_Object *vals;
register int argnum = 0;
vals = (Lisp_Object *) alloca (XINT (numargs) * sizeof (Lisp_Object));
GCPRO3 (args_left, fun, fun);
gcpro3.var = vals;
gcpro3.nvars = 0;
while (!NILP (args_left))
{
vals[argnum++] = Feval (Fcar (args_left));
args_left = Fcdr (args_left);
gcpro3.nvars = argnum;
}
backtrace.args = vals;
backtrace.nargs = XINT (numargs);
val = (*XSUBR (fun)->function) (XINT (numargs), vals);
UNGCPRO;
goto done;
}
GCPRO3 (args_left, fun, fun);
gcpro3.var = argvals;
gcpro3.nvars = 0;
maxargs = XSUBR (fun)->max_args;
for (i = 0; i < maxargs; args_left = Fcdr (args_left))
{
argvals[i] = Feval (Fcar (args_left));
gcpro3.nvars = ++i;
}
UNGCPRO;
backtrace.args = argvals;
backtrace.nargs = XINT (numargs);
switch (i)
{
case 0:
val = (*XSUBR (fun)->function) ();
goto done;
case 1:
val = (*XSUBR (fun)->function) (argvals[0]);
goto done;
case 2:
val = (*XSUBR (fun)->function) (argvals[0], argvals[1]);
goto done;
case 3:
val = (*XSUBR (fun)->function) (argvals[0], argvals[1],
argvals[2]);
goto done;
case 4:
val = (*XSUBR (fun)->function) (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]);
goto done;
case 6:
val = (*XSUBR (fun)->function) (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]);
goto done;
case 8:
val = (*XSUBR (fun)->function) (argvals[0], argvals[1], argvals[2],
argvals[3], argvals[4], argvals[5],
argvals[6], argvals[7]);
goto done;
default:
abort ();
}
}
if (COMPILEDP (fun))
val = apply_lambda (fun, original_args, 1);
else
{
if (EQ (fun, Qunbound))
xsignal1 (Qvoid_function, original_fun);
if (!CONSP (fun))
xsignal1 (Qinvalid_function, original_fun);
funcar = XCAR (fun);
if (!SYMBOLP (funcar))
xsignal1 (Qinvalid_function, original_fun);
if (EQ (funcar, Qautoload))
{
do_autoload (fun, original_fun);
goto retry;
}
if (EQ (funcar, Qmacro))
val = Feval (apply1 (Fcdr (fun), original_args));
else if (EQ (funcar, Qlambda))
val = apply_lambda (fun, original_args, 1);
else
xsignal1 (Qinvalid_function, original_fun);
}
done:
CHECK_CONS_LIST ();
lisp_eval_depth--;
if (backtrace.debug_on_exit)
val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
backtrace_list = backtrace.next;
return val;
}
DEFUN ("apply", Fapply, Sapply, 2, MANY, 0,
doc: )
(nargs, args)
int nargs;
Lisp_Object *args;
{
register int i, numargs;
register Lisp_Object spread_arg;
register Lisp_Object *funcall_args;
Lisp_Object fun;
struct gcpro gcpro1;
fun = args [0];
funcall_args = 0;
spread_arg = args [nargs - 1];
CHECK_LIST (spread_arg);
numargs = XINT (Flength (spread_arg));
if (numargs == 0)
return Ffuncall (nargs - 1, args);
else if (numargs == 1)
{
args [nargs - 1] = XCAR (spread_arg);
return Ffuncall (nargs, args);
}
numargs += nargs - 2;
if (SYMBOLP (fun) && !EQ (fun, Qunbound)
&& (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
fun = indirect_function (fun);
if (EQ (fun, Qunbound))
{
fun = args[0];
goto funcall;
}
if (SUBRP (fun))
{
if (numargs < XSUBR (fun)->min_args
|| (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
goto funcall;
else if (XSUBR (fun)->max_args > numargs)
{
funcall_args = (Lisp_Object *) alloca ((1 + XSUBR (fun)->max_args)
* sizeof (Lisp_Object));
for (i = numargs; i < XSUBR (fun)->max_args;)
funcall_args[++i] = Qnil;
GCPRO1 (*funcall_args);
gcpro1.nvars = 1 + XSUBR (fun)->max_args;
}
}
funcall:
if (!funcall_args)
{
funcall_args = (Lisp_Object *) alloca ((1 + numargs)
* sizeof (Lisp_Object));
GCPRO1 (*funcall_args);
gcpro1.nvars = 1 + numargs;
}
bcopy (args, funcall_args, nargs * sizeof (Lisp_Object));
i = nargs - 1;
while (!NILP (spread_arg))
{
funcall_args [i++] = XCAR (spread_arg);
spread_arg = XCDR (spread_arg);
}
RETURN_UNGCPRO (Ffuncall (gcpro1.nvars, funcall_args));
}
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));
DEFUN ("run-hooks", Frun_hooks, Srun_hooks, 0, MANY, 0,
doc: )
(nargs, args)
int nargs;
Lisp_Object *args;
{
Lisp_Object hook[1];
register int i;
for (i = 0; i < nargs; i++)
{
hook[0] = args[i];
run_hook_with_args (1, hook, to_completion);
}
return Qnil;
}
DEFUN ("run-hook-with-args", Frun_hook_with_args,
Srun_hook_with_args, 1, MANY, 0,
doc: )
(nargs, args)
int nargs;
Lisp_Object *args;
{
return run_hook_with_args (nargs, args, to_completion);
}
DEFUN ("run-hook-with-args-until-success", Frun_hook_with_args_until_success,
Srun_hook_with_args_until_success, 1, MANY, 0,
doc: )
(nargs, args)
int nargs;
Lisp_Object *args;
{
return run_hook_with_args (nargs, args, until_success);
}
DEFUN ("run-hook-with-args-until-failure", Frun_hook_with_args_until_failure,
Srun_hook_with_args_until_failure, 1, MANY, 0,
doc: )
(nargs, args)
int nargs;
Lisp_Object *args;
{
return run_hook_with_args (nargs, args, until_failure);
}
static Lisp_Object
run_hook_with_args (nargs, args, cond)
int nargs;
Lisp_Object *args;
enum run_hooks_condition cond;
{
Lisp_Object sym, val, ret;
Lisp_Object globals;
struct gcpro gcpro1, gcpro2, gcpro3;
if (NILP (Vrun_hooks))
return Qnil;
sym = args[0];
val = find_symbol_value (sym);
ret = (cond == until_failure ? Qt : Qnil);
if (EQ (val, Qunbound) || NILP (val))
return ret;
else if (!CONSP (val) || EQ (XCAR (val), Qlambda))
{
args[0] = val;
return Ffuncall (nargs, args);
}
else
{
globals = Qnil;
GCPRO3 (sym, val, globals);
for (;
CONSP (val) && ((cond == to_completion)
|| (cond == until_success ? NILP (ret)
: !NILP (ret)));
val = XCDR (val))
{
if (EQ (XCAR (val), Qt))
{
for (globals = Fdefault_value (sym);
CONSP (globals) && ((cond == to_completion)
|| (cond == until_success ? NILP (ret)
: !NILP (ret)));
globals = XCDR (globals))
{
args[0] = XCAR (globals);
if (!EQ (args[0], Qt))
ret = Ffuncall (nargs, args);
}
}
else
{
args[0] = XCAR (val);
ret = Ffuncall (nargs, args);
}
}
UNGCPRO;
return ret;
}
}
Lisp_Object
run_hook_list_with_args (funlist, nargs, args)
Lisp_Object funlist;
int nargs;
Lisp_Object *args;
{
Lisp_Object sym;
Lisp_Object val;
Lisp_Object globals;
struct gcpro gcpro1, gcpro2, gcpro3;
sym = args[0];
globals = Qnil;
GCPRO3 (sym, val, globals);
for (val = funlist; CONSP (val); val = XCDR (val))
{
if (EQ (XCAR (val), Qt))
{
for (globals = Fdefault_value (sym);
CONSP (globals);
globals = XCDR (globals))
{
args[0] = XCAR (globals);
if (!EQ (args[0], Qt))
Ffuncall (nargs, args);
}
}
else
{
args[0] = XCAR (val);
Ffuncall (nargs, args);
}
}
UNGCPRO;
return Qnil;
}
void
run_hook_with_args_2 (hook, arg1, arg2)
Lisp_Object hook, arg1, arg2;
{
Lisp_Object temp[3];
temp[0] = hook;
temp[1] = arg1;
temp[2] = arg2;
Frun_hook_with_args (3, temp);
}
Lisp_Object
apply1 (fn, arg)
Lisp_Object fn, arg;
{
struct gcpro gcpro1;
GCPRO1 (fn);
if (NILP (arg))
RETURN_UNGCPRO (Ffuncall (1, &fn));
gcpro1.nvars = 2;
#ifdef NO_ARG_ARRAY
{
Lisp_Object args[2];
args[0] = fn;
args[1] = arg;
gcpro1.var = args;
RETURN_UNGCPRO (Fapply (2, args));
}
#else
RETURN_UNGCPRO (Fapply (2, &fn));
#endif
}
Lisp_Object
call0 (fn)
Lisp_Object fn;
{
struct gcpro gcpro1;
GCPRO1 (fn);
RETURN_UNGCPRO (Ffuncall (1, &fn));
}
Lisp_Object
call1 (fn, arg1)
Lisp_Object fn, arg1;
{
struct gcpro gcpro1;
#ifdef NO_ARG_ARRAY
Lisp_Object args[2];
args[0] = fn;
args[1] = arg1;
GCPRO1 (args[0]);
gcpro1.nvars = 2;
RETURN_UNGCPRO (Ffuncall (2, args));
#else
GCPRO1 (fn);
gcpro1.nvars = 2;
RETURN_UNGCPRO (Ffuncall (2, &fn));
#endif
}
Lisp_Object
call2 (fn, arg1, arg2)
Lisp_Object fn, arg1, arg2;
{
struct gcpro gcpro1;
#ifdef NO_ARG_ARRAY
Lisp_Object args[3];
args[0] = fn;
args[1] = arg1;
args[2] = arg2;
GCPRO1 (args[0]);
gcpro1.nvars = 3;
RETURN_UNGCPRO (Ffuncall (3, args));
#else
GCPRO1 (fn);
gcpro1.nvars = 3;
RETURN_UNGCPRO (Ffuncall (3, &fn));
#endif
}
Lisp_Object
call3 (fn, arg1, arg2, arg3)
Lisp_Object fn, arg1, arg2, arg3;
{
struct gcpro gcpro1;
#ifdef NO_ARG_ARRAY
Lisp_Object args[4];
args[0] = fn;
args[1] = arg1;
args[2] = arg2;
args[3] = arg3;
GCPRO1 (args[0]);
gcpro1.nvars = 4;
RETURN_UNGCPRO (Ffuncall (4, args));
#else
GCPRO1 (fn);
gcpro1.nvars = 4;
RETURN_UNGCPRO (Ffuncall (4, &fn));
#endif
}
Lisp_Object
call4 (fn, arg1, arg2, arg3, arg4)
Lisp_Object fn, arg1, arg2, arg3, arg4;
{
struct gcpro gcpro1;
#ifdef NO_ARG_ARRAY
Lisp_Object args[5];
args[0] = fn;
args[1] = arg1;
args[2] = arg2;
args[3] = arg3;
args[4] = arg4;
GCPRO1 (args[0]);
gcpro1.nvars = 5;
RETURN_UNGCPRO (Ffuncall (5, args));
#else
GCPRO1 (fn);
gcpro1.nvars = 5;
RETURN_UNGCPRO (Ffuncall (5, &fn));
#endif
}
Lisp_Object
call5 (fn, arg1, arg2, arg3, arg4, arg5)
Lisp_Object fn, arg1, arg2, arg3, arg4, arg5;
{
struct gcpro gcpro1;
#ifdef NO_ARG_ARRAY
Lisp_Object args[6];
args[0] = fn;
args[1] = arg1;
args[2] = arg2;
args[3] = arg3;
args[4] = arg4;
args[5] = arg5;
GCPRO1 (args[0]);
gcpro1.nvars = 6;
RETURN_UNGCPRO (Ffuncall (6, args));
#else
GCPRO1 (fn);
gcpro1.nvars = 6;
RETURN_UNGCPRO (Ffuncall (6, &fn));
#endif
}
Lisp_Object
call6 (fn, arg1, arg2, arg3, arg4, arg5, arg6)
Lisp_Object fn, arg1, arg2, arg3, arg4, arg5, arg6;
{
struct gcpro gcpro1;
#ifdef NO_ARG_ARRAY
Lisp_Object args[7];
args[0] = fn;
args[1] = arg1;
args[2] = arg2;
args[3] = arg3;
args[4] = arg4;
args[5] = arg5;
args[6] = arg6;
GCPRO1 (args[0]);
gcpro1.nvars = 7;
RETURN_UNGCPRO (Ffuncall (7, args));
#else
GCPRO1 (fn);
gcpro1.nvars = 7;
RETURN_UNGCPRO (Ffuncall (7, &fn));
#endif
}
DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
doc: )
(nargs, args)
int nargs;
Lisp_Object *args;
{
Lisp_Object fun, original_fun;
Lisp_Object funcar;
int numargs = nargs - 1;
Lisp_Object lisp_numargs;
Lisp_Object val;
struct backtrace backtrace;
register Lisp_Object *internal_args;
register int i;
QUIT;
if ((consing_since_gc > gc_cons_threshold
&& consing_since_gc > gc_relative_threshold)
||
(!NILP (Vmemory_full) && consing_since_gc > memory_full_cons_threshold))
Fgarbage_collect ();
if (++lisp_eval_depth > max_lisp_eval_depth)
{
if (max_lisp_eval_depth < 100)
max_lisp_eval_depth = 100;
if (lisp_eval_depth > max_lisp_eval_depth)
error ("Lisp nesting exceeds `max-lisp-eval-depth'");
}
backtrace.next = backtrace_list;
backtrace_list = &backtrace;
backtrace.function = &args[0];
backtrace.args = &args[1];
backtrace.nargs = nargs - 1;
backtrace.evalargs = 0;
backtrace.debug_on_exit = 0;
if (debug_on_next_call)
do_debug_on_call (Qlambda);
CHECK_CONS_LIST ();
original_fun = args[0];
retry:
fun = original_fun;
if (SYMBOLP (fun) && !EQ (fun, Qunbound)
&& (fun = XSYMBOL (fun)->function, SYMBOLP (fun)))
fun = indirect_function (fun);
if (SUBRP (fun))
{
if (numargs < XSUBR (fun)->min_args
|| (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs))
{
XSETFASTINT (lisp_numargs, numargs);
xsignal2 (Qwrong_number_of_arguments, original_fun, lisp_numargs);
}
if (XSUBR (fun)->max_args == UNEVALLED)
xsignal1 (Qinvalid_function, original_fun);
if (XSUBR (fun)->max_args == MANY)
{
val = (*XSUBR (fun)->function) (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));
for (i = numargs; i < XSUBR (fun)->max_args; i++)
internal_args[i] = Qnil;
}
else
internal_args = args + 1;
switch (XSUBR (fun)->max_args)
{
case 0:
val = (*XSUBR (fun)->function) ();
goto done;
case 1:
val = (*XSUBR (fun)->function) (internal_args[0]);
goto done;
case 2:
val = (*XSUBR (fun)->function) (internal_args[0], internal_args[1]);
goto done;
case 3:
val = (*XSUBR (fun)->function) (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]);
goto done;
case 5:
val = (*XSUBR (fun)->function) (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]);
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]);
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]);
goto done;
default:
abort ();
}
}
if (COMPILEDP (fun))
val = funcall_lambda (fun, numargs, args + 1);
else
{
if (EQ (fun, Qunbound))
xsignal1 (Qvoid_function, original_fun);
if (!CONSP (fun))
xsignal1 (Qinvalid_function, original_fun);
funcar = XCAR (fun);
if (!SYMBOLP (funcar))
xsignal1 (Qinvalid_function, original_fun);
if (EQ (funcar, Qlambda))
val = funcall_lambda (fun, numargs, args + 1);
else if (EQ (funcar, Qautoload))
{
do_autoload (fun, original_fun);
CHECK_CONS_LIST ();
goto retry;
}
else
xsignal1 (Qinvalid_function, original_fun);
}
done:
CHECK_CONS_LIST ();
lisp_eval_depth--;
if (backtrace.debug_on_exit)
val = call_debugger (Fcons (Qexit, Fcons (val, Qnil)));
backtrace_list = backtrace.next;
return val;
}
Lisp_Object
apply_lambda (fun, args, eval_flag)
Lisp_Object fun, args;
int eval_flag;
{
Lisp_Object args_left;
Lisp_Object numargs;
register Lisp_Object *arg_vector;
struct gcpro gcpro1, gcpro2, gcpro3;
register int i;
register Lisp_Object tem;
numargs = Flength (args);
arg_vector = (Lisp_Object *) alloca (XINT (numargs) * sizeof (Lisp_Object));
args_left = args;
GCPRO3 (*arg_vector, args_left, fun);
gcpro1.nvars = 0;
for (i = 0; i < XINT (numargs);)
{
tem = Fcar (args_left), args_left = Fcdr (args_left);
if (eval_flag) tem = Feval (tem);
arg_vector[i++] = tem;
gcpro1.nvars = i;
}
UNGCPRO;
if (eval_flag)
{
backtrace_list->args = arg_vector;
backtrace_list->nargs = i;
}
backtrace_list->evalargs = 0;
tem = funcall_lambda (fun, XINT (numargs), arg_vector);
if (backtrace_list->debug_on_exit)
tem = call_debugger (Fcons (Qexit, Fcons (tem, Qnil)));
backtrace_list->debug_on_exit = 0;
return tem;
}
static Lisp_Object
funcall_lambda (fun, nargs, arg_vector)
Lisp_Object fun;
int nargs;
register Lisp_Object *arg_vector;
{
Lisp_Object val, syms_left, next;
int count = SPECPDL_INDEX ();
int i, optional, rest;
if (CONSP (fun))
{
syms_left = XCDR (fun);
if (CONSP (syms_left))
syms_left = XCAR (syms_left);
else
xsignal1 (Qinvalid_function, fun);
}
else if (COMPILEDP (fun))
syms_left = AREF (fun, COMPILED_ARGLIST);
else
abort ();
i = optional = rest = 0;
for (; CONSP (syms_left); syms_left = XCDR (syms_left))
{
QUIT;
next = XCAR (syms_left);
if (!SYMBOLP (next))
xsignal1 (Qinvalid_function, fun);
if (EQ (next, Qand_rest))
rest = 1;
else if (EQ (next, Qand_optional))
optional = 1;
else if (rest)
{
specbind (next, Flist (nargs - i, &arg_vector[i]));
i = nargs;
}
else if (i < nargs)
specbind (next, arg_vector[i++]);
else if (!optional)
xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
else
specbind (next, Qnil);
}
if (!NILP (syms_left))
xsignal1 (Qinvalid_function, fun);
else if (i < nargs)
xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
if (CONSP (fun))
val = Fprogn (XCDR (XCDR (fun)));
else
{
if (CONSP (AREF (fun, COMPILED_BYTECODE)))
Ffetch_bytecode (fun);
val = Fbyte_code (AREF (fun, COMPILED_BYTECODE),
AREF (fun, COMPILED_CONSTANTS),
AREF (fun, COMPILED_STACK_DEPTH));
}
return unbind_to (count, val);
}
DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode,
1, 1, 0,
doc: )
(object)
Lisp_Object object;
{
Lisp_Object tem;
if (COMPILEDP (object) && CONSP (AREF (object, COMPILED_BYTECODE)))
{
tem = read_doc_string (AREF (object, COMPILED_BYTECODE));
if (!CONSP (tem))
{
tem = AREF (object, COMPILED_BYTECODE);
if (CONSP (tem) && STRINGP (XCAR (tem)))
error ("Invalid byte code in %s", SDATA (XCAR (tem)));
else
error ("Invalid byte code");
}
AREF (object, COMPILED_BYTECODE) = XCAR (tem);
AREF (object, COMPILED_CONSTANTS) = XCDR (tem);
}
return object;
}
void
grow_specpdl ()
{
register int count = SPECPDL_INDEX ();
if (specpdl_size >= max_specpdl_size)
{
if (max_specpdl_size < 400)
max_specpdl_size = 400;
if (specpdl_size >= max_specpdl_size)
signal_error ("Variable binding depth exceeds max-specpdl-size", Qnil);
}
specpdl_size *= 2;
if (specpdl_size > max_specpdl_size)
specpdl_size = max_specpdl_size;
specpdl = (struct specbinding *) xrealloc (specpdl, specpdl_size * sizeof (struct specbinding));
specpdl_ptr = specpdl + count;
}
void
specbind (symbol, value)
Lisp_Object symbol, value;
{
Lisp_Object ovalue;
Lisp_Object valcontents;
CHECK_SYMBOL (symbol);
if (specpdl_ptr == specpdl + specpdl_size)
grow_specpdl ();
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 valcontents;
ovalue = find_symbol_value (symbol);
specpdl_ptr->func = 0;
specpdl_ptr->old_value = ovalue;
valcontents = XSYMBOL (symbol)->value;
if (BUFFER_LOCAL_VALUEP (valcontents)
|| SOME_BUFFER_LOCAL_VALUEP (valcontents)
|| BUFFER_OBJFWDP (valcontents))
{
Lisp_Object where, current_buffer;
current_buffer = Fcurrent_buffer ();
if (!NILP (Flocal_variable_p (symbol, Qnil)))
where = current_buffer;
else if (!BUFFER_OBJFWDP (valcontents)
&& XBUFFER_LOCAL_VALUE (valcontents)->found_for_frame)
where = XBUFFER_LOCAL_VALUE (valcontents)->frame;
else
where = Qnil;
specpdl_ptr->symbol = Fcons (symbol, Fcons (where, current_buffer));
if (NILP (where)
&& BUFFER_OBJFWDP (valcontents))
{
++specpdl_ptr;
Fset_default (symbol, value);
return;
}
}
else
specpdl_ptr->symbol = symbol;
specpdl_ptr++;
if (BUFFER_OBJFWDP (ovalue) || KBOARD_OBJFWDP (ovalue))
store_symval_forwarding (symbol, ovalue, value, NULL);
else
set_internal (symbol, value, 0, 1);
}
}
void
record_unwind_protect (function, arg)
Lisp_Object (*function) P_ ((Lisp_Object));
Lisp_Object arg;
{
eassert (!handling_signal);
if (specpdl_ptr == specpdl + specpdl_size)
grow_specpdl ();
specpdl_ptr->func = function;
specpdl_ptr->symbol = Qnil;
specpdl_ptr->old_value = arg;
specpdl_ptr++;
}
Lisp_Object
unbind_to (count, value)
int count;
Lisp_Object value;
{
Lisp_Object quitf = Vquit_flag;
struct gcpro gcpro1, gcpro2;
GCPRO2 (value, quitf);
Vquit_flag = Qnil;
while (specpdl_ptr != specpdl + count)
{
struct specbinding this_binding;
this_binding = *--specpdl_ptr;
if (this_binding.func != 0)
(*this_binding.func) (this_binding.old_value);
else if (CONSP (this_binding.symbol))
{
Lisp_Object symbol, where;
symbol = XCAR (this_binding.symbol);
where = XCAR (XCDR (this_binding.symbol));
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);
}
else
{
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);
}
}
if (NILP (Vquit_flag) && !NILP (quitf))
Vquit_flag = quitf;
UNGCPRO;
return value;
}
DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
doc: )
(level, flag)
Lisp_Object level, flag;
{
register struct backtrace *backlist = backtrace_list;
register int i;
CHECK_NUMBER (level);
for (i = 0; backlist && i < XINT (level); i++)
{
backlist = backlist->next;
}
if (backlist)
backlist->debug_on_exit = !NILP (flag);
return flag;
}
DEFUN ("backtrace", Fbacktrace, Sbacktrace, 0, 0, "",
doc: )
()
{
register struct backtrace *backlist = backtrace_list;
register int i;
Lisp_Object tail;
Lisp_Object tem;
extern Lisp_Object Vprint_level;
struct gcpro gcpro1;
XSETFASTINT (Vprint_level, 3);
tail = Qnil;
GCPRO1 (tail);
while (backlist)
{
write_string (backlist->debug_on_exit ? "* " : " ", 2);
if (backlist->nargs == UNEVALLED)
{
Fprin1 (Fcons (*backlist->function, *backlist->args), Qnil);
write_string ("\n", -1);
}
else
{
tem = *backlist->function;
Fprin1 (tem, Qnil);
write_string ("(", -1);
if (backlist->nargs == MANY)
{
for (tail = *backlist->args, i = 0;
!NILP (tail);
tail = Fcdr (tail), i++)
{
if (i) write_string (" ", -1);
Fprin1 (Fcar (tail), Qnil);
}
}
else
{
for (i = 0; i < backlist->nargs; i++)
{
if (i) write_string (" ", -1);
Fprin1 (backlist->args[i], Qnil);
}
}
write_string (")\n", -1);
}
backlist = backlist->next;
}
Vprint_level = Qnil;
UNGCPRO;
return Qnil;
}
DEFUN ("backtrace-frame", Fbacktrace_frame, Sbacktrace_frame, 1, 1, NULL,
doc: )
(nframes)
Lisp_Object nframes;
{
register struct backtrace *backlist = backtrace_list;
register int i;
Lisp_Object tem;
CHECK_NATNUM (nframes);
for (i = 0; backlist && i < XFASTINT (nframes); i++)
backlist = backlist->next;
if (!backlist)
return Qnil;
if (backlist->nargs == UNEVALLED)
return Fcons (Qnil, Fcons (*backlist->function, *backlist->args));
else
{
if (backlist->nargs == MANY)
tem = *backlist->args;
else
tem = Flist (backlist->nargs, backlist->args);
return Fcons (Qt, Fcons (*backlist->function, tem));
}
}
void
mark_backtrace ()
{
register struct backtrace *backlist;
register int i;
for (backlist = backtrace_list; backlist; backlist = backlist->next)
{
mark_object (*backlist->function);
if (backlist->nargs == UNEVALLED || backlist->nargs == MANY)
i = 0;
else
i = backlist->nargs - 1;
for (; i >= 0; i--)
mark_object (backlist->args[i]);
}
}
void
syms_of_eval ()
{
DEFVAR_INT ("max-specpdl-size", &max_specpdl_size,
doc: );
DEFVAR_INT ("max-lisp-eval-depth", &max_lisp_eval_depth,
doc: );
DEFVAR_LISP ("quit-flag", &Vquit_flag,
doc: );
Vquit_flag = Qnil;
DEFVAR_LISP ("inhibit-quit", &Vinhibit_quit,
doc: );
Vinhibit_quit = Qnil;
Qinhibit_quit = intern ("inhibit-quit");
staticpro (&Qinhibit_quit);
Qautoload = intern ("autoload");
staticpro (&Qautoload);
Qdebug_on_error = intern ("debug-on-error");
staticpro (&Qdebug_on_error);
Qmacro = intern ("macro");
staticpro (&Qmacro);
Qdeclare = intern ("declare");
staticpro (&Qdeclare);
Qexit = intern ("exit");
staticpro (&Qexit);
Qinteractive = intern ("interactive");
staticpro (&Qinteractive);
Qcommandp = intern ("commandp");
staticpro (&Qcommandp);
Qdefun = intern ("defun");
staticpro (&Qdefun);
Qand_rest = intern ("&rest");
staticpro (&Qand_rest);
Qand_optional = intern ("&optional");
staticpro (&Qand_optional);
DEFVAR_LISP ("stack-trace-on-error", &Vstack_trace_on_error,
doc: );
Vstack_trace_on_error = Qnil;
DEFVAR_LISP ("debug-on-error", &Vdebug_on_error,
doc: );
Vdebug_on_error = Qnil;
DEFVAR_LISP ("debug-ignored-errors", &Vdebug_ignored_errors,
doc: );
Vdebug_ignored_errors = Qnil;
DEFVAR_BOOL ("debug-on-quit", &debug_on_quit,
doc: );
debug_on_quit = 0;
DEFVAR_BOOL ("debug-on-next-call", &debug_on_next_call,
doc: );
DEFVAR_BOOL ("debugger-may-continue", &debugger_may_continue,
doc: );
debugger_may_continue = 1;
DEFVAR_LISP ("debugger", &Vdebugger,
doc: );
Vdebugger = Qnil;
DEFVAR_LISP ("signal-hook-function", &Vsignal_hook_function,
doc: );
Vsignal_hook_function = Qnil;
DEFVAR_LISP ("debug-on-signal", &Vdebug_on_signal,
doc: );
Vdebug_on_signal = Qnil;
DEFVAR_LISP ("macro-declaration-function", &Vmacro_declaration_function,
doc: );
Vmacro_declaration_function = Qnil;
Vrun_hooks = intern ("run-hooks");
staticpro (&Vrun_hooks);
staticpro (&Vautoload_queue);
Vautoload_queue = Qnil;
staticpro (&Vsignaling_function);
Vsignaling_function = Qnil;
defsubr (&Sor);
defsubr (&Sand);
defsubr (&Sif);
defsubr (&Scond);
defsubr (&Sprogn);
defsubr (&Sprog1);
defsubr (&Sprog2);
defsubr (&Ssetq);
defsubr (&Squote);
defsubr (&Sfunction);
defsubr (&Sdefun);
defsubr (&Sdefmacro);
defsubr (&Sdefvar);
defsubr (&Sdefvaralias);
defsubr (&Sdefconst);
defsubr (&Suser_variable_p);
defsubr (&Slet);
defsubr (&SletX);
defsubr (&Swhile);
defsubr (&Smacroexpand);
defsubr (&Scatch);
defsubr (&Sthrow);
defsubr (&Sunwind_protect);
defsubr (&Scondition_case);
defsubr (&Ssignal);
defsubr (&Sinteractive_p);
defsubr (&Scalled_interactively_p);
defsubr (&Scommandp);
defsubr (&Sautoload);
defsubr (&Seval);
defsubr (&Sapply);
defsubr (&Sfuncall);
defsubr (&Srun_hooks);
defsubr (&Srun_hook_with_args);
defsubr (&Srun_hook_with_args_until_success);
defsubr (&Srun_hook_with_args_until_failure);
defsubr (&Sfetch_bytecode);
defsubr (&Sbacktrace_debug);
defsubr (&Sbacktrace);
defsubr (&Sbacktrace_frame);
}