X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/7a22490f14441898e1c4f6679f5924f097f3bb34..844e0de1bc2bf56118b749f50a4880db7c918fd5:/src/eval.c diff --git a/src/eval.c b/src/eval.c index 8ee259110f..436953e911 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1,6 +1,7 @@ /* Evaluator for GNU Emacs Lisp interpreter. - Copyright (C) 1985-1987, 1993-1995, 1999-2013 Free Software - Foundation, Inc. + +Copyright (C) 1985-1987, 1993-1995, 1999-2014 Free Software Foundation, +Inc. This file is part of GNU Emacs. @@ -26,26 +27,12 @@ along with GNU Emacs. If not, see . */ #include "commands.h" #include "keyboard.h" #include "dispextern.h" -#include "frame.h" /* For XFRAME. */ - -#if HAVE_X_WINDOWS -#include "xterm.h" -#endif +#include "guile.h" -#if !BYTE_MARK_STACK -static -#endif -struct catchtag *catchlist; +static void unbind_once (void *ignore); -/* Chain of condition handlers currently in effect. - The elements of this chain are contained in the stack frames - of Fcondition_case and internal_condition_case. - When an error is signaled (by calling Fsignal, below), - this chain is searched for an element that applies. */ +/* Chain of condition and catch handlers currently in effect. */ -#if !BYTE_MARK_STACK -static -#endif struct handler *handlerlist; #ifdef DEBUG_GCPRO @@ -92,7 +79,7 @@ union specbinding *specpdl_ptr; /* Depth in Lisp evaluations and function calls. */ -static EMACS_INT lisp_eval_depth; +EMACS_INT lisp_eval_depth; /* The value of num_nonmacro_input_events as of the last time we started to enter the debugger. If we decide to enter the debugger @@ -152,13 +139,6 @@ specpdl_where (union specbinding *pdl) return pdl->let.where; } -static Lisp_Object -specpdl_arg (union specbinding *pdl) -{ - eassert (pdl->kind == SPECPDL_UNWIND); - return pdl->unwind.arg; -} - Lisp_Object backtrace_function (union specbinding *pdl) { @@ -234,6 +214,37 @@ backtrace_next (union specbinding *pdl) return pdl; } +struct handler * +make_catch_handler (Lisp_Object tag) +{ + struct handler *c = xmalloc (sizeof (*c)); + c->type = CATCHER; + c->tag_or_ch = tag; + c->val = Qnil; + c->var = Qnil; + c->body = Qnil; + c->next = handlerlist; + c->lisp_eval_depth = lisp_eval_depth; + c->interrupt_input_blocked = interrupt_input_blocked; + c->ptag = make_prompt_tag (); + return c; +} + +struct handler * +make_condition_handler (Lisp_Object tag) +{ + struct handler *c = xmalloc (sizeof (*c)); + c->type = CONDITION_CASE; + c->tag_or_ch = tag; + c->val = Qnil; + c->var = Qnil; + c->body = Qnil; + c->next = handlerlist; + c->lisp_eval_depth = lisp_eval_depth; + c->interrupt_input_blocked = interrupt_input_blocked; + c->ptag = make_prompt_tag (); + return c; +} void init_eval_once (void) @@ -249,12 +260,14 @@ init_eval_once (void) Vrun_hooks = Qnil; } +static struct handler *handlerlist_sentinel; + void init_eval (void) { specpdl_ptr = specpdl; - catchlist = 0; - handlerlist = 0; + handlerlist_sentinel = make_catch_handler (Qunbound); + handlerlist = handlerlist_sentinel; Vquit_flag = Qnil; debug_on_next_call = 0; lisp_eval_depth = 0; @@ -274,30 +287,27 @@ restore_stack_limits (Lisp_Object data) max_lisp_eval_depth = XINT (XCDR (data)); } +static void grow_specpdl (void); + /* Call the Lisp debugger, giving it argument ARG. */ Lisp_Object call_debugger (Lisp_Object arg) { bool debug_while_redisplaying; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); Lisp_Object val; + EMACS_INT old_depth = max_lisp_eval_depth; + /* Do not allow max_specpdl_size less than actual depth (Bug#16603). */ EMACS_INT old_max = max_specpdl_size; - /* Temporarily bump up the stack limits, - so the debugger won't run out of stack. */ - - 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 (max_specpdl_size - 100 < SPECPDL_INDEX ()) - max_specpdl_size = SPECPDL_INDEX () + 100; + /* Restore limits after leaving the debugger. */ + record_unwind_protect (restore_stack_limits, + Fcons (make_number (old_max), + make_number (old_depth))); #ifdef HAVE_WINDOW_SYSTEM if (display_hourglass_p) @@ -329,7 +339,8 @@ call_debugger (Lisp_Object arg) if (debug_while_redisplaying) Ftop_level (); - return unbind_to (count, val); + dynwind_end (); + return val; } static void @@ -418,9 +429,9 @@ Each clause looks like (CONDITION BODY...). CONDITION is evaluated and, if the value is non-nil, this clause succeeds: then the expressions in BODY are evaluated and the last one's value is the value of the cond-form. +If a clause has one element, as in (CONDITION), then the cond-form +returns CONDITION's value, if that is non-nil. If no clause succeeds, cond returns nil. -If a clause has one element, as in (CONDITION), -CONDITION's value if non-nil is returned from the cond-form. usage: (cond CLAUSES...) */) (Lisp_Object args) { @@ -611,18 +622,18 @@ then the value of BASE-VARIABLE is set to that of NEW-ALIAS. The return value is BASE-VARIABLE. */) (Lisp_Object new_alias, Lisp_Object base_variable, Lisp_Object docstring) { - struct Lisp_Symbol *sym; + sym_t sym; CHECK_SYMBOL (new_alias); CHECK_SYMBOL (base_variable); sym = XSYMBOL (new_alias); - if (sym->constant) + if (SYMBOL_CONSTANT (sym)) /* Not sure why, but why not? */ error ("Cannot make a constant an alias"); - switch (sym->redirect) + switch (SYMBOL_REDIRECT (sym)) { case SYMBOL_FORWARDED: error ("Cannot make an internal variable an alias"); @@ -646,11 +657,11 @@ The return value is BASE-VARIABLE. */) error ("Don't know how to make a let-bound variable an alias"); } - sym->declared_special = 1; - XSYMBOL (base_variable)->declared_special = 1; - sym->redirect = SYMBOL_VARALIAS; + SET_SYMBOL_DECLARED_SPECIAL (sym, 1); + SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (base_variable), 1); + SET_SYMBOL_REDIRECT (sym, SYMBOL_VARALIAS); SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable)); - sym->constant = SYMBOL_CONSTANT_P (base_variable); + SET_SYMBOL_CONSTANT (sym, SYMBOL_CONSTANT_P (base_variable)); LOADHIST_ATTACH (new_alias); /* Even if docstring is nil: remove old docstring. */ Fput (new_alias, Qvariable_documentation, docstring); @@ -744,7 +755,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) tem = Fdefault_boundp (sym); /* Do it before evaluating the initial value, for self-references. */ - XSYMBOL (sym)->declared_special = 1; + SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym), 1); if (NILP (tem)) Fset_default (sym, eval_sub (XCAR (tail))); @@ -768,7 +779,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) LOADHIST_ATTACH (sym); } else if (!NILP (Vinternal_interpreter_environment) - && !XSYMBOL (sym)->declared_special) + && ! SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym))) /* A simple (defvar foo) with lexical scoping does "nothing" except declare that var to be dynamically scoped *locally* (i.e. within the current file or let-block). */ @@ -812,7 +823,7 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) if (!NILP (Vpurify_flag)) tem = Fpurecopy (tem); Fset_default (sym, tem); - XSYMBOL (sym)->declared_special = 1; + SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (sym), 1); tem = Fcar (XCDR (XCDR (args))); if (!NILP (tem)) { @@ -832,7 +843,7 @@ DEFUN ("internal-make-var-non-special", Fmake_var_non_special, (Lisp_Object symbol) { CHECK_SYMBOL (symbol); - XSYMBOL (symbol)->declared_special = 0; + SET_SYMBOL_DECLARED_SPECIAL (XSYMBOL (symbol), 0); return Qnil; } @@ -847,7 +858,7 @@ usage: (let* VARLIST BODY...) */) (Lisp_Object args) { Lisp_Object varlist, var, val, elt, lexenv; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); struct gcpro gcpro1, gcpro2, gcpro3; GCPRO3 (args, elt, varlist); @@ -874,7 +885,7 @@ usage: (let* VARLIST BODY...) */) } if (!NILP (lexenv) && SYMBOLP (var) - && !XSYMBOL (var)->declared_special + && ! SYMBOL_DECLARED_SPECIAL (XSYMBOL (var)) && NILP (Fmemq (var, Vinternal_interpreter_environment))) /* Lexically bind VAR by adding it to the interpreter's binding alist. */ @@ -896,7 +907,8 @@ usage: (let* VARLIST BODY...) */) } UNGCPRO; val = Fprogn (XCDR (args)); - return unbind_to (count, val); + dynwind_end (); + return val; } DEFUN ("let", Flet, Slet, 1, UNEVALLED, 0, @@ -910,7 +922,7 @@ usage: (let VARLIST BODY...) */) { Lisp_Object *temps, tem, lexenv; register Lisp_Object elt, varlist; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); ptrdiff_t argnum; struct gcpro gcpro1, gcpro2; USE_SAFE_ALLOCA; @@ -952,7 +964,7 @@ usage: (let VARLIST BODY...) */) tem = temps[argnum++]; if (!NILP (lexenv) && SYMBOLP (var) - && !XSYMBOL (var)->declared_special + && ! SYMBOL_DECLARED_SPECIAL (XSYMBOL (var)) && NILP (Fmemq (var, Vinternal_interpreter_environment))) /* Lexically bind VAR by adding it to the lexenv alist. */ lexenv = Fcons (Fcons (var, tem), lexenv); @@ -967,7 +979,8 @@ usage: (let VARLIST BODY...) */) elt = Fprogn (XCDR (args)); SAFE_FREE (); - return unbind_to (count, elt); + dynwind_end (); + return elt; } DEFUN ("while", Fwhile, Swhile, 1, UNEVALLED, 0, @@ -1025,7 +1038,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. */) tem = Fassq (sym, environment); if (NILP (tem)) { - def = XSYMBOL (sym)->function; + def = SYMBOL_FUNCTION (sym); if (!NILP (def)) continue; } @@ -1085,6 +1098,131 @@ usage: (catch TAG BODY...) */) return internal_catch (tag, Fprogn, XCDR (args)); } +/* Assert that E is true, as a comment only. Use this instead of + eassert (E) when E contains variables that might be clobbered by a + longjmp. */ + +#define clobbered_eassert(E) ((void) 0) + +static void +set_handlerlist (void *data) +{ + handlerlist = data; +} + +static void +restore_handler (void *data) +{ + struct handler *c = data; + unblock_input_to (c->interrupt_input_blocked); + immediate_quit = 0; +} + +struct icc_thunk_env +{ + enum { ICC_0, ICC_1, ICC_2, ICC_3, ICC_N } type; + union + { + Lisp_Object (*fun0) (void); + Lisp_Object (*fun1) (Lisp_Object); + Lisp_Object (*fun2) (Lisp_Object, Lisp_Object); + Lisp_Object (*fun3) (Lisp_Object, Lisp_Object, Lisp_Object); + Lisp_Object (*funn) (ptrdiff_t, Lisp_Object *); + }; + union + { + struct + { + Lisp_Object arg1; + Lisp_Object arg2; + Lisp_Object arg3; + }; + struct + { + ptrdiff_t nargs; + Lisp_Object *args; + }; + }; + struct handler *c; +}; + +static Lisp_Object +icc_thunk (void *data) +{ + Lisp_Object tem; + struct icc_thunk_env *e = data; + scm_dynwind_begin (0); + scm_dynwind_unwind_handler (restore_handler, e->c, 0); + scm_dynwind_unwind_handler (set_handlerlist, + handlerlist, + SCM_F_WIND_EXPLICITLY); + handlerlist = e->c; + switch (e->type) + { + case ICC_0: + tem = e->fun0 (); + break; + case ICC_1: + tem = e->fun1 (e->arg1); + break; + case ICC_2: + tem = e->fun2 (e->arg1, e->arg2); + break; + case ICC_3: + tem = e->fun3 (e->arg1, e->arg2, e->arg3); + break; + case ICC_N: + tem = e->funn (e->nargs, e->args); + break; + default: + emacs_abort (); + } + scm_dynwind_end (); + return tem; +} + +static Lisp_Object +icc_handler (void *data, Lisp_Object k, Lisp_Object v) +{ + Lisp_Object (*f) (Lisp_Object) = data; + return f (v); +} + +struct icc_handler_n_env +{ + Lisp_Object (*fun) (Lisp_Object, ptrdiff_t, Lisp_Object *); + ptrdiff_t nargs; + Lisp_Object *args; +}; + +static Lisp_Object +icc_handler_n (void *data, Lisp_Object k, Lisp_Object v) +{ + struct icc_handler_n_env *e = data; + return e->fun (v, e->nargs, e->args); +} + +static Lisp_Object +icc_lisp_handler (void *data, Lisp_Object k, Lisp_Object val) +{ + Lisp_Object tem; + struct handler *h = data; + Lisp_Object var = h->var; + scm_dynwind_begin (0); + if (!NILP (var)) + { + if (!NILP (Vinternal_interpreter_environment)) + specbind (Qinternal_interpreter_environment, + Fcons (Fcons (var, val), + Vinternal_interpreter_environment)); + else + specbind (var, val); + } + tem = Fprogn (h->body); + scm_dynwind_end (); + return tem; +} + /* Set up a catch, then call C function FUNC on argument ARG. FUNC should return a Lisp_Object. This is how catches are done from within C code. */ @@ -1092,29 +1230,14 @@ usage: (catch TAG BODY...) */) Lisp_Object 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; - - /* Fill in the components of c, and put it on the list. */ - c.next = catchlist; - c.tag = tag; - c.val = Qnil; - 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; - - /* Call FUNC. */ - if (! sys_setjmp (c.jmp)) - c.val = (*func) (arg); - - /* Throw works by a longjmp that comes right here. */ - catchlist = c.next; - return c.val; + struct handler *c = make_catch_handler (tag); + struct icc_thunk_env env = { .type = ICC_1, + .fun1 = func, + .arg1 = arg, + .c = c }; + return call_with_prompt (c->ptag, + make_c_closure (icc_thunk, &env, 0, 0), + make_c_closure (icc_handler, Fidentity, 2, 0)); } /* Unwind the specbind, catch, and handler stacks back to CATCH, and @@ -1133,39 +1256,12 @@ internal_catch (Lisp_Object tag, Lisp_Object (*func) (Lisp_Object), Lisp_Object This is used for correct unwinding in Fthrow and Fsignal. */ +static Lisp_Object unbind_to_1 (ptrdiff_t, Lisp_Object, bool); + static _Noreturn void -unwind_to_catch (struct catchtag *catch, Lisp_Object value) +unwind_to_catch (struct handler *catch, Lisp_Object value) { - bool last_time; - - /* Save the value in the tag. */ - catch->val = value; - - /* Restore certain special C variables. */ - set_poll_suppress_count (catch->poll_suppress_count); - unblock_input_to (catch->interrupt_input_blocked); - immediate_quit = 0; - - do - { - last_time = catchlist == catch; - - /* Unwind the specpdl stack, and then restore the proper set of - handlers. */ - unbind_to (catchlist->pdlcount, Qnil); - handlerlist = catchlist->handlerlist; - catchlist = catchlist->next; - } - while (! last_time); - - byte_stack_list = catch->byte_stack; - gcprolist = catch->gcpro; -#ifdef DEBUG_GCPRO - gcpro_level = gcprolist ? gcprolist->level + 1 : 0; -#endif - lisp_eval_depth = catch->lisp_eval_depth; - - sys_longjmp (catch->jmp, 1); + abort_to_prompt (catch->ptag, scm_list_1 (value)); } DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0, @@ -1173,12 +1269,12 @@ DEFUN ("throw", Fthrow, Sthrow, 2, 2, 0, Both TAG and VALUE are evalled. */) (register Lisp_Object tag, Lisp_Object value) { - register struct catchtag *c; + struct handler *c; if (!NILP (tag)) - for (c = catchlist; c; c = c->next) + for (c = handlerlist; c; c = c->next) { - if (EQ (c->tag, tag)) + if (c->type == CATCHER && EQ (c->tag_or_ch, tag)) unwind_to_catch (c, value); } xsignal2 (Qno_catch, tag, value); @@ -1194,11 +1290,12 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...) */) (Lisp_Object args) { Lisp_Object val; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); record_unwind_protect (unwind_body, XCDR (args)); val = eval_sub (XCAR (args)); - return unbind_to (count, val); + dynwind_end (); + return val; } DEFUN ("condition-case", Fcondition_case, Scondition_case, 2, UNEVALLED, 0, @@ -1236,6 +1333,35 @@ usage: (condition-case VAR BODYFORM &rest HANDLERS) */) return internal_lisp_condition_case (var, bodyform, handlers); } +static Lisp_Object +ilcc1 (Lisp_Object var, Lisp_Object bodyform, Lisp_Object handlers) +{ + if (CONSP (handlers)) + { + Lisp_Object clause = XCAR (handlers); + Lisp_Object condition = XCAR (clause); + Lisp_Object body = XCDR (clause); + if (!CONSP (condition)) + condition = Fcons (condition, Qnil); + struct handler *c = make_condition_handler (condition); + c->var = var; + c->body = body; + struct icc_thunk_env env = { .type = ICC_3, + .fun3 = ilcc1, + .arg1 = var, + .arg2 = bodyform, + .arg3 = XCDR (handlers), + .c = c }; + return call_with_prompt (c->ptag, + make_c_closure (icc_thunk, &env, 0, 0), + make_c_closure (icc_lisp_handler, c, 2, 0)); + } + else + { + return eval_sub (bodyform); + } +} + /* Like Fcondition_case, but the args are separate rather than passed in a list. Used by Fbyte_code. */ @@ -1244,15 +1370,14 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform, Lisp_Object handlers) { Lisp_Object val; - struct catchtag c; - struct handler h; + struct handler *c; + struct handler *oldhandlerlist = handlerlist; CHECK_SYMBOL (var); for (val = handlers; CONSP (val); val = XCDR (val)) { - Lisp_Object tem; - tem = XCAR (val); + Lisp_Object tem = XCAR (val); if (! (NILP (tem) || (CONSP (tem) && (SYMBOLP (XCAR (tem)) @@ -1261,40 +1386,7 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform, SDATA (Fprin1_to_string (tem, Qt))); } - c.tag = Qnil; - c.val = Qnil; - 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 (sys_setjmp (c.jmp)) - { - if (!NILP (h.var)) - specbind (h.var, c.val); - val = Fprogn (Fcdr (h.chosen_clause)); - - /* Note that this just undoes the binding of h.var; whoever - longjumped to us unwound the stack to c.pdlcount before - throwing. */ - 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 = eval_sub (bodyform); - catchlist = c.next; - handlerlist = h.next; - return val; + return ilcc1 (var, bodyform, Freverse (handlers)); } /* Call the function BFUN with no arguments, catching errors within it @@ -1312,34 +1404,12 @@ internal_condition_case (Lisp_Object (*bfun) (void), Lisp_Object handlers, Lisp_Object (*hfun) (Lisp_Object)) { Lisp_Object val; - struct catchtag c; - struct handler h; - - c.tag = Qnil; - c.val = Qnil; - 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 (sys_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; + struct handler *c = make_condition_handler (handlers); + + struct icc_thunk_env env = { .type = ICC_0, .fun0 = bfun, .c = c }; + return call_with_prompt (c->ptag, + make_c_closure (icc_thunk, &env, 0, 0), + make_c_closure (icc_handler, hfun, 2, 0)); } /* Like internal_condition_case but call BFUN with ARG as its argument. */ @@ -1349,34 +1419,15 @@ 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; - struct handler h; - - c.tag = Qnil; - c.val = Qnil; - 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 (sys_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; + struct handler *c = make_condition_handler (handlers); + + struct icc_thunk_env env = { .type = ICC_1, + .fun1 = bfun, + .arg1 = arg, + .c = c }; + return call_with_prompt (c->ptag, + make_c_closure (icc_thunk, &env, 0, 0), + make_c_closure (icc_handler, hfun, 2, 0)); } /* Like internal_condition_case_1 but call BFUN with ARG1 and ARG2 as @@ -1390,34 +1441,15 @@ internal_condition_case_2 (Lisp_Object (*bfun) (Lisp_Object, Lisp_Object), Lisp_Object (*hfun) (Lisp_Object)) { Lisp_Object val; - struct catchtag c; - struct handler h; - - c.tag = Qnil; - c.val = Qnil; - 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 (sys_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; + struct handler *c = make_condition_handler (handlers); + struct icc_thunk_env env = { .type = ICC_2, + .fun2 = bfun, + .arg1 = arg1, + .arg2 = arg2, + .c = c }; + return call_with_prompt (c->ptag, + make_c_closure (icc_thunk, &env, 0, 0), + make_c_closure (icc_handler, hfun, 2, 0)); } /* Like internal_condition_case but call BFUN with NARGS as first, @@ -1433,34 +1465,17 @@ internal_condition_case_n (Lisp_Object (*bfun) (ptrdiff_t, Lisp_Object *), Lisp_Object *args)) { Lisp_Object val; - struct catchtag c; - struct handler h; - - c.tag = Qnil; - c.val = Qnil; - 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 (sys_setjmp (c.jmp)) - { - return (*hfun) (c.val, nargs, args); - } - 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; + struct handler *c = make_condition_handler (handlers); + + struct icc_thunk_env env = { .type = ICC_N, + .funn = bfun, + .nargs = nargs, + .args = args, + .c = c }; + struct icc_handler_n_env henv = { .fun = hfun, .nargs = nargs, .args = args }; + return call_with_prompt (c->ptag, + make_c_closure (icc_thunk, &env, 0, 0), + make_c_closure (icc_handler_n, &henv, 2, 0)); } @@ -1507,8 +1522,7 @@ See also the function `condition-case'. */) struct handler *h; immediate_quit = 0; - abort_on_gc = 0; - if (gc_in_progress || waiting_for_input) + if (waiting_for_input) emacs_abort (); #if 0 /* rms: I don't know why this was here, @@ -1551,7 +1565,9 @@ See also the function `condition-case'. */) for (h = handlerlist; h; h = h->next) { - clause = find_handler_clause (h->handler, conditions); + if (h->type != CONDITION_CASE) + continue; + clause = find_handler_clause (h->tag_or_ch, conditions); if (!NILP (clause)) break; } @@ -1564,11 +1580,11 @@ See also the function `condition-case'. */) || NILP (clause) /* A `debug' symbol in the handler list disables the normal suppression of the debugger. */ - || (CONSP (clause) && CONSP (XCAR (clause)) - && !NILP (Fmemq (Qdebug, XCAR (clause)))) + || (CONSP (clause) && CONSP (clause) + && !NILP (Fmemq (Qdebug, clause))) /* Special handler that means "print a message and run debugger if requested". */ - || EQ (h->handler, Qerror))) + || EQ (h->tag_or_ch, Qerror))) { bool debugger_called = maybe_call_debugger (conditions, error_symbol, data); @@ -1583,12 +1599,14 @@ See also the function `condition-case'. */) Lisp_Object unwind_data = (NILP (error_symbol) ? data : Fcons (error_symbol, data)); - h->chosen_clause = clause; - unwind_to_catch (h->tag, unwind_data); + unwind_to_catch (h, unwind_data); } else { - if (catchlist != 0) + if (handlerlist != handlerlist_sentinel) + /* FIXME: This will come right back here if there's no `top-level' + catcher. A better solution would be to abort here, and instead + add a catch-all condition handler so we never come here. */ Fthrow (Qtop_level, Qt); } @@ -1774,29 +1792,8 @@ find_handler_clause (Lisp_Object handlers, Lisp_Object conditions) for (h = handlers; CONSP (h); h = XCDR (h)) { Lisp_Object handler = XCAR (h); - Lisp_Object condit, tem; - - if (!CONSP (handler)) - continue; - condit = XCAR (handler); - /* Handle a single condition name in handler HANDLER. */ - if (SYMBOLP (condit)) - { - tem = Fmemq (Fcar (handler), conditions); - if (!NILP (tem)) - return handler; - } - /* Handle a list of condition names in handler HANDLER. */ - else if (CONSP (condit)) - { - Lisp_Object tail; - for (tail = condit; CONSP (tail); tail = XCDR (tail)) - { - tem = Fmemq (XCAR (tail), conditions); - if (!NILP (tem)) - return handler; - } - } + if (!NILP (Fmemq (handler, conditions))) + return handlers; } return Qnil; @@ -1872,11 +1869,9 @@ then strings and vectors are not accepted. */) fun = Fsymbol_function (fun); } - /* Emacs primitives are interactive if their DEFUN specifies an - interactive spec. */ - if (SUBRP (fun)) - return XSUBR (fun)->intspec ? Qt : if_prop; - + if (scm_is_true (scm_procedure_p (fun))) + return (scm_is_true (scm_procedure_property (fun, Qinteractive_form)) + ? Qt : if_prop); /* Bytecode objects are interactive if they are long enough to have an element whose index is COMPILED_INTERACTIVE, which is where the interactive spec is stored. */ @@ -1922,16 +1917,10 @@ this does nothing and returns nil. */) CHECK_STRING (file); /* If function is defined and not as an autoload, don't override. */ - if (!NILP (XSYMBOL (function)->function) - && !AUTOLOADP (XSYMBOL (function)->function)) + if (!NILP (SYMBOL_FUNCTION (function)) + && !AUTOLOADP (SYMBOL_FUNCTION (function))) return Qnil; - if (!NILP (Vpurify_flag) && EQ (docstring, make_number (0))) - /* `read1' in lread.c has found the docstring starting with "\ - and assumed the docstring will be provided by Snarf-documentation, so it - passed us 0 instead. 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 Fdefalias (function, list5 (Qautoload, file, docstring, interactive, type), Qnil); @@ -1971,17 +1960,21 @@ If equal to `macro', MACRO-ONLY specifies that FUNDEF should only be loaded if it is defines a macro. */) (Lisp_Object fundef, Lisp_Object funname, Lisp_Object macro_only) { - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); struct gcpro gcpro1, gcpro2, gcpro3; - if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef))) + if (!CONSP (fundef) || !EQ (Qautoload, XCAR (fundef))) { + dynwind_end (); return fundef; + } if (EQ (macro_only, Qmacro)) { Lisp_Object kind = Fnth (make_number (4), fundef); - if (! (EQ (kind, Qt) || EQ (kind, Qmacro))) - return fundef; + if (! (EQ (kind, Qt) || EQ (kind, Qmacro))) { + dynwind_end (); + return fundef; + } } /* This is to make sure that loadup.el gives a clear picture @@ -2012,7 +2005,7 @@ it is defines a macro. */) /* Once loading finishes, don't undo it. */ Vautoload_queue = Qt; - unbind_to (count, Qnil); + dynwind_end (); UNGCPRO; @@ -2033,13 +2026,17 @@ it is defines a macro. */) DEFUN ("eval", Feval, Seval, 1, 2, 0, doc: /* Evaluate FORM and return its value. -If LEXICAL is t, evaluate using lexical scoping. */) +If LEXICAL is t, evaluate using lexical scoping. +LEXICAL can also be an actual lexical environment, in the form of an +alist mapping symbols to their value. */) (Lisp_Object form, Lisp_Object lexical) { - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); specbind (Qinternal_interpreter_environment, CONSP (lexical) || NILP (lexical) ? lexical : list1 (Qt)); - return unbind_to (count, eval_sub (form)); + Lisp_Object tem0 = eval_sub (form); + dynwind_end (); + return tem0; } /* Grow the specpdl stack by one entry. @@ -2088,12 +2085,20 @@ record_in_backtrace (Lisp_Object function, Lisp_Object *args, ptrdiff_t nargs) specpdl_ptr->bt.args = args; specpdl_ptr->bt.nargs = nargs; grow_specpdl (); + scm_dynwind_unwind_handler (unbind_once, NULL, SCM_F_WIND_EXPLICITLY); +} + +static void +set_lisp_eval_depth (void *data) +{ + EMACS_INT n = (EMACS_INT) data; + lisp_eval_depth = n; } /* Eval a sub-expression of the current expression (i.e. in the same lexical scope). */ -Lisp_Object -eval_sub (Lisp_Object form) +static Lisp_Object +eval_sub_1 (Lisp_Object form) { Lisp_Object fun, val, original_fun, original_args; Lisp_Object funcar; @@ -2123,6 +2128,11 @@ eval_sub (Lisp_Object form) maybe_gc (); UNGCPRO; + scm_dynwind_begin (0); + scm_dynwind_unwind_handler (set_lisp_eval_depth, + (void *) lisp_eval_depth, + SCM_F_WIND_EXPLICITLY); + if (++lisp_eval_depth > max_lisp_eval_depth) { if (max_lisp_eval_depth < 100) @@ -2146,123 +2156,32 @@ eval_sub (Lisp_Object form) /* Optimize for no indirection. */ fun = original_fun; - if (SYMBOLP (fun) && !NILP (fun) - && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) + if (!SYMBOLP (fun)) + fun = Ffunction (Fcons (fun, Qnil)); + else if (!NILP (fun) && (fun = SYMBOL_FUNCTION (fun), SYMBOLP (fun))) fun = indirect_function (fun); - if (SUBRP (fun)) + if (scm_is_true (scm_procedure_p (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); - - else if (XSUBR (fun)->max_args == UNEVALLED) - val = (XSUBR (fun)->function.aUNEVALLED) (args_left); - else if (XSUBR (fun)->max_args == MANY) - { - /* Pass a vector of evaluated arguments. */ - Lisp_Object *vals; - ptrdiff_t argnum = 0; - USE_SAFE_ALLOCA; - - SAFE_ALLOCA_LISP (vals, XINT (numargs)); - - GCPRO3 (args_left, fun, fun); - gcpro3.var = vals; - gcpro3.nvars = 0; - - while (!NILP (args_left)) - { - vals[argnum++] = eval_sub (Fcar (args_left)); - args_left = Fcdr (args_left); - gcpro3.nvars = argnum; - } - - set_backtrace_args (specpdl_ptr - 1, vals); - set_backtrace_nargs (specpdl_ptr - 1, XINT (numargs)); - - val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals); - UNGCPRO; - SAFE_FREE (); - } - else - { - 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] = eval_sub (Fcar (args_left)); - gcpro3.nvars = ++i; - } - - UNGCPRO; + Lisp_Object args_left = original_args; + Lisp_Object nargs = Flength (args_left); + Lisp_Object *args; + size_t argnum = 0; - set_backtrace_args (specpdl_ptr - 1, argvals); - set_backtrace_nargs (specpdl_ptr - 1, XINT (numargs)); + SAFE_ALLOCA_LISP (args, XINT (nargs)); - switch (i) - { - case 0: - val = (XSUBR (fun)->function.a0 ()); - break; - case 1: - val = (XSUBR (fun)->function.a1 (argvals[0])); - break; - case 2: - val = (XSUBR (fun)->function.a2 (argvals[0], argvals[1])); - break; - case 3: - val = (XSUBR (fun)->function.a3 - (argvals[0], argvals[1], argvals[2])); - break; - case 4: - val = (XSUBR (fun)->function.a4 - (argvals[0], argvals[1], argvals[2], argvals[3])); - break; - case 5: - val = (XSUBR (fun)->function.a5 - (argvals[0], argvals[1], argvals[2], argvals[3], - argvals[4])); - break; - case 6: - val = (XSUBR (fun)->function.a6 - (argvals[0], argvals[1], argvals[2], argvals[3], - argvals[4], argvals[5])); - break; - case 7: - val = (XSUBR (fun)->function.a7 - (argvals[0], argvals[1], argvals[2], argvals[3], - argvals[4], argvals[5], argvals[6])); - break; - - case 8: - val = (XSUBR (fun)->function.a8 - (argvals[0], argvals[1], argvals[2], argvals[3], - argvals[4], argvals[5], argvals[6], argvals[7])); - break; - - default: - /* Someone has created a subr that takes more arguments than - is supported by this code. We need to either rewrite the - subr to use a different argument protocol, or add more - cases to this switch. */ - emacs_abort (); - } - } + while (! NILP (args_left)) + { + args[argnum++] = eval_sub (Fcar (args_left)); + args_left = Fcdr (args_left); + } + set_backtrace_args (specpdl_ptr - 1, args); + set_backtrace_nargs (specpdl_ptr - 1, argnum); + val = scm_call_n (fun, args, argnum); + } + else if (CONSP (fun) && EQ (XCAR (fun), Qspecial_operator)) + { + val = scm_apply_0 (XCDR (fun), original_args); } else if (COMPILEDP (fun)) val = apply_lambda (fun, original_args); @@ -2282,7 +2201,7 @@ eval_sub (Lisp_Object form) } if (EQ (funcar, Qmacro)) { - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); Lisp_Object exp; /* Bind lexical-binding during expansion of the macro, so the macro can know reliably if the code it outputs will be @@ -2290,7 +2209,7 @@ eval_sub (Lisp_Object form) specbind (Qlexical_binding, NILP (Vinternal_interpreter_environment) ? Qnil : Qt); exp = apply1 (Fcdr (fun), original_args); - unbind_to (count, Qnil); + dynwind_end (); val = eval_sub (exp); } else if (EQ (funcar, Qlambda) @@ -2299,13 +2218,59 @@ eval_sub (Lisp_Object form) else xsignal1 (Qinvalid_function, original_fun); } - check_cons_list (); - lisp_eval_depth--; if (backtrace_debug_on_exit (specpdl_ptr - 1)) val = call_debugger (list2 (Qexit, val)); - specpdl_ptr--; + scm_dynwind_end (); + + return val; +} + +Lisp_Object +eval_sub (Lisp_Object form) +{ + return scm_c_value_ref (eval_sub_1 (form), 0); +} + +static Lisp_Object +values_to_list (Lisp_Object values) +{ + Lisp_Object list = Qnil; + for (int i = scm_c_nvalues (values) - 1; i >= 0; i--) + list = Fcons (scm_c_value_ref (values, i), list); + return list; +} + +DEFUN ("multiple-value-call", Fmultiple_value_call, Smultiple_value_call, + 2, UNEVALLED, 0, + doc: /* Call with multiple values. +usage: (multiple-value-call FUNCTION-FORM FORM) */) + (Lisp_Object args) +{ + Lisp_Object function_form = eval_sub (XCAR (args)); + Lisp_Object values = Qnil; + while (CONSP (args = XCDR (args))) + values = nconc2 (Fnreverse (values_to_list (eval_sub_1 (XCAR (args)))), + values); + return apply1 (function_form, Fnreverse (values)); +} +DEFUN ("values", Fvalues, Svalues, 0, MANY, 0, + doc: /* Return multiple values. */) + (ptrdiff_t nargs, Lisp_Object *args) +{ + return scm_c_values (args, nargs); +} + +DEFUN ("bind-symbol", Fbind_symbol, Sbind_symbol, 3, 3, 0, + doc: /* Bind symbol. */) + (Lisp_Object symbol, Lisp_Object value, Lisp_Object thunk) +{ + Lisp_Object val; + dynwind_begin (); + specbind (symbol, value); + val = call0 (thunk); + dynwind_end (); return val; } @@ -2343,32 +2308,14 @@ usage: (apply FUNCTION &rest ARGUMENTS) */) /* Optimize for no indirection. */ if (SYMBOLP (fun) && !NILP (fun) - && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) + && (fun = SYMBOL_FUNCTION (fun), SYMBOLP (fun))) fun = indirect_function (fun); if (NILP (fun)) { /* Let funcall get the error. */ 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; /* Let funcall get the error. */ - else if (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args > numargs) - { - /* Avoid making funcall cons up a yet another new vector of arguments - by explicitly supplying nil's for optional values. */ - SAFE_ALLOCA_LISP (funcall_args, 1 + XSUBR (fun)->max_args); - for (i = numargs; i < XSUBR (fun)->max_args;) - funcall_args[++i] = Qnil; - GCPRO1 (*funcall_args); - gcpro1.nvars = 1 + XSUBR (fun)->max_args; - } - } - funcall: /* We add 1 to numargs because funcall_args includes the function itself as well as its arguments. */ if (!funcall_args) @@ -2543,7 +2490,7 @@ run_hook_with_args (ptrdiff_t nargs, Lisp_Object *args, if (EQ (val, Qunbound) || NILP (val)) return ret; - else if (!CONSP (val) || EQ (XCAR (val), Qlambda)) + else if (!CONSP (val) || FUNCTIONP (val)) { args[0] = val; return funcall (nargs, args); @@ -2616,14 +2563,14 @@ apply1 (Lisp_Object fn, Lisp_Object arg) GCPRO1 (fn); if (NILP (arg)) - RETURN_UNGCPRO (Ffuncall (1, &fn)); + return Ffuncall (1, &fn); gcpro1.nvars = 2; { Lisp_Object args[2]; args[0] = fn; args[1] = arg; gcpro1.var = args; - RETURN_UNGCPRO (Fapply (2, args)); + return Fapply (2, args); } } @@ -2634,7 +2581,7 @@ call0 (Lisp_Object fn) struct gcpro gcpro1; GCPRO1 (fn); - RETURN_UNGCPRO (Ffuncall (1, &fn)); + return Ffuncall (1, &fn); } /* Call function fn with 1 argument arg1. */ @@ -2649,7 +2596,7 @@ call1 (Lisp_Object fn, Lisp_Object arg1) args[1] = arg1; GCPRO1 (args[0]); gcpro1.nvars = 2; - RETURN_UNGCPRO (Ffuncall (2, args)); + return Ffuncall (2, args); } /* Call function fn with 2 arguments arg1, arg2. */ @@ -2664,7 +2611,7 @@ call2 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2) args[2] = arg2; GCPRO1 (args[0]); gcpro1.nvars = 3; - RETURN_UNGCPRO (Ffuncall (3, args)); + return Ffuncall (3, args); } /* Call function fn with 3 arguments arg1, arg2, arg3. */ @@ -2680,7 +2627,7 @@ call3 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3) args[3] = arg3; GCPRO1 (args[0]); gcpro1.nvars = 4; - RETURN_UNGCPRO (Ffuncall (4, args)); + return Ffuncall (4, args); } /* Call function fn with 4 arguments arg1, arg2, arg3, arg4. */ @@ -2698,7 +2645,7 @@ call4 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, args[4] = arg4; GCPRO1 (args[0]); gcpro1.nvars = 5; - RETURN_UNGCPRO (Ffuncall (5, args)); + return Ffuncall (5, args); } /* Call function fn with 5 arguments arg1, arg2, arg3, arg4, arg5. */ @@ -2717,7 +2664,7 @@ call5 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, args[5] = arg5; GCPRO1 (args[0]); gcpro1.nvars = 6; - RETURN_UNGCPRO (Ffuncall (6, args)); + return Ffuncall (6, args); } /* Call function fn with 6 arguments arg1, arg2, arg3, arg4, arg5, arg6. */ @@ -2737,7 +2684,7 @@ call6 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, args[6] = arg6; GCPRO1 (args[0]); gcpro1.nvars = 7; - RETURN_UNGCPRO (Ffuncall (7, args)); + return Ffuncall (7, args); } /* Call function fn with 7 arguments arg1, arg2, arg3, arg4, arg5, arg6, arg7. */ @@ -2758,7 +2705,7 @@ call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, args[7] = arg7; GCPRO1 (args[0]); gcpro1.nvars = 8; - RETURN_UNGCPRO (Ffuncall (8, args)); + return Ffuncall (8, args); } /* The caller should GCPRO all the elements of ARGS. */ @@ -2772,7 +2719,7 @@ DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, return Qnil; } -DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0, +DEFUN ("funcall", Ffuncall1, Sfuncall, 1, MANY, 0, doc: /* Call first argument as a function, passing remaining arguments to it. Return the value that function returns. Thus, (funcall 'cons 'x 'y) returns (x . y). @@ -2789,6 +2736,11 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) QUIT; + scm_dynwind_begin (0); + scm_dynwind_unwind_handler (set_lisp_eval_depth, + (void *) lisp_eval_depth, + SCM_F_WIND_EXPLICITLY); + if (++lisp_eval_depth > max_lisp_eval_depth) { if (max_lisp_eval_depth < 100) @@ -2806,8 +2758,6 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) if (debug_on_next_call) do_debug_on_call (Qlambda); - check_cons_list (); - original_fun = args[0]; retry: @@ -2815,88 +2765,12 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) /* Optimize for no indirection. */ fun = original_fun; if (SYMBOLP (fun) && !NILP (fun) - && (fun = XSYMBOL (fun)->function, SYMBOLP (fun))) + && (fun = SYMBOL_FUNCTION (fun), SYMBOLP (fun))) fun = indirect_function (fun); - if (SUBRP (fun)) + if (scm_is_true (scm_procedure_p (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); - } - - else if (XSUBR (fun)->max_args == UNEVALLED) - xsignal1 (Qinvalid_function, original_fun); - - else if (XSUBR (fun)->max_args == MANY) - val = (XSUBR (fun)->function.aMANY) (numargs, args + 1); - else - { - if (XSUBR (fun)->max_args > numargs) - { - internal_args = alloca (XSUBR (fun)->max_args - * sizeof *internal_args); - memcpy (internal_args, args + 1, numargs * word_size); - 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.a0 ()); - break; - case 1: - val = (XSUBR (fun)->function.a1 (internal_args[0])); - break; - case 2: - val = (XSUBR (fun)->function.a2 - (internal_args[0], internal_args[1])); - break; - case 3: - val = (XSUBR (fun)->function.a3 - (internal_args[0], internal_args[1], internal_args[2])); - break; - case 4: - val = (XSUBR (fun)->function.a4 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3])); - break; - case 5: - val = (XSUBR (fun)->function.a5 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3], internal_args[4])); - break; - case 6: - val = (XSUBR (fun)->function.a6 - (internal_args[0], internal_args[1], internal_args[2], - internal_args[3], internal_args[4], internal_args[5])); - break; - case 7: - 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])); - break; - - case 8: - 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])); - break; - - default: - - /* If a subr takes more than 8 arguments without using MANY - or UNEVALLED, we need to extend this function to support it. - Until this is done, there is no way to call the function. */ - emacs_abort (); - } - } + val = scm_call_n (fun, args + 1, numargs); } else if (COMPILEDP (fun)) val = funcall_lambda (fun, numargs, args + 1); @@ -2915,19 +2789,22 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) else if (EQ (funcar, Qautoload)) { Fautoload_do_load (fun, original_fun, Qnil); - check_cons_list (); goto retry; } else xsignal1 (Qinvalid_function, original_fun); } - check_cons_list (); - lisp_eval_depth--; if (backtrace_debug_on_exit (specpdl_ptr - 1)) val = call_debugger (list2 (Qexit, val)); - specpdl_ptr--; + scm_dynwind_end (); return val; } + +Lisp_Object +Ffuncall (ptrdiff_t nargs, Lisp_Object *args) +{ + return scm_c_value_ref (Ffuncall1 (nargs, args), 0); +} static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args) @@ -2981,7 +2858,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, register Lisp_Object *arg_vector) { Lisp_Object val, syms_left, next, lexenv; - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); ptrdiff_t i; bool optional, rest; @@ -3018,6 +2895,7 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, and constants vector yet, fetch them from the file. */ if (CONSP (AREF (fun, COMPILED_BYTECODE))) Ffetch_bytecode (fun); + dynwind_end (); return exec_byte_code (AREF (fun, COMPILED_BYTECODE), AREF (fun, COMPILED_CONSTANTS), AREF (fun, COMPILED_STACK_DEPTH), @@ -3090,7 +2968,8 @@ funcall_lambda (Lisp_Object fun, ptrdiff_t nargs, Qnil, 0, 0); } - return unbind_to (count, val); + dynwind_end (); + return val; } DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, @@ -3121,7 +3000,7 @@ DEFUN ("fetch-bytecode", Ffetch_bytecode, Sfetch_bytecode, which was made in the buffer that is now current. */ bool -let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol) +let_shadows_buffer_binding_p (sym_t symbol) { union specbinding *p; Lisp_Object buf = Fcurrent_buffer (); @@ -3129,8 +3008,8 @@ let_shadows_buffer_binding_p (struct Lisp_Symbol *symbol) for (p = specpdl_ptr; p > specpdl; ) if ((--p)->kind > SPECPDL_LET) { - struct Lisp_Symbol *let_bound_symbol = XSYMBOL (specpdl_symbol (p)); - eassert (let_bound_symbol->redirect != SYMBOL_VARALIAS); + sym_t let_bound_symbol = XSYMBOL (specpdl_symbol (p)); + eassert (SYMBOL_REDIRECT (let_bound_symbol) != SYMBOL_VARALIAS); if (symbol == let_bound_symbol && EQ (specpdl_where (p), buf)) return 1; @@ -3151,31 +3030,28 @@ let_shadows_global_binding_p (Lisp_Object symbol) return 0; } -/* `specpdl_ptr->symbol' is a field which describes which variable is +/* `specpdl_ptr' 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 + It can be either a plain SPECPDL_LET or a SPECPDL_LET_LOCAL/DEFAULT. + - SYMBOL is the variable being bound. Note 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). */ + - WHERE tells us in which buffer the binding took place. + This is used for SPECPDL_LET_LOCAL bindings (i.e. bindings to a + buffer-local variable) as well as for SPECPDL_LET_DEFAULT bindings, + i.e. bindings to the default value of a variable which can be + buffer-local. */ void specbind (Lisp_Object symbol, Lisp_Object value) { - struct Lisp_Symbol *sym; + sym_t sym; CHECK_SYMBOL (symbol); sym = XSYMBOL (symbol); start: - switch (sym->redirect) + switch (SYMBOL_REDIRECT (sym)) { case SYMBOL_VARALIAS: sym = indirect_variable (sym); XSETSYMBOL (symbol, sym); goto start; @@ -3186,7 +3062,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->let.symbol = symbol; specpdl_ptr->let.old_value = SYMBOL_VAL (sym); grow_specpdl (); - if (!sym->constant) + if (! SYMBOL_CONSTANT (sym)) SET_SYMBOL_VAL (sym, value); else set_internal (symbol, value, Qnil, 1); @@ -3202,10 +3078,10 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->let.old_value = ovalue; specpdl_ptr->let.where = Fcurrent_buffer (); - eassert (sym->redirect != SYMBOL_LOCALIZED + eassert (SYMBOL_REDIRECT (sym) != SYMBOL_LOCALIZED || (EQ (SYMBOL_BLV (sym)->where, Fcurrent_buffer ()))); - if (sym->redirect == SYMBOL_LOCALIZED) + if (SYMBOL_REDIRECT (sym) == SYMBOL_LOCALIZED) { if (!blv_found (SYMBOL_BLV (sym))) specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; @@ -3222,7 +3098,7 @@ specbind (Lisp_Object symbol, Lisp_Object value) specpdl_ptr->let.kind = SPECPDL_LET_DEFAULT; grow_specpdl (); Fset_default (symbol, value); - return; + goto done; } } else @@ -3234,160 +3110,135 @@ specbind (Lisp_Object symbol, Lisp_Object value) } default: emacs_abort (); } + + done: + scm_dynwind_unwind_handler (unbind_once, NULL, SCM_F_WIND_EXPLICITLY); } /* Push unwind-protect entries of various types. */ void -record_unwind_protect (void (*function) (Lisp_Object), Lisp_Object arg) +record_unwind_protect_1 (void (*function) (Lisp_Object), Lisp_Object arg, + bool wind_explicitly) { - specpdl_ptr->unwind.kind = SPECPDL_UNWIND; - specpdl_ptr->unwind.func = function; - specpdl_ptr->unwind.arg = arg; - grow_specpdl (); + record_unwind_protect_ptr_1 (function, arg, wind_explicitly); } void -record_unwind_protect_ptr (void (*function) (void *), void *arg) +record_unwind_protect (void (*function) (Lisp_Object), Lisp_Object arg) { - specpdl_ptr->unwind_ptr.kind = SPECPDL_UNWIND_PTR; - specpdl_ptr->unwind_ptr.func = function; - specpdl_ptr->unwind_ptr.arg = arg; - grow_specpdl (); + record_unwind_protect_1 (function, arg, true); } void -record_unwind_protect_int (void (*function) (int), int arg) +record_unwind_protect_ptr_1 (void (*function) (void *), void *arg, + bool wind_explicitly) { - specpdl_ptr->unwind_int.kind = SPECPDL_UNWIND_INT; - specpdl_ptr->unwind_int.func = function; - specpdl_ptr->unwind_int.arg = arg; - grow_specpdl (); + scm_dynwind_unwind_handler (function, + arg, + (wind_explicitly + ? SCM_F_WIND_EXPLICITLY + : 0)); } void -record_unwind_protect_void (void (*function) (void)) +record_unwind_protect_ptr (void (*function) (void *), void *arg) { - specpdl_ptr->unwind_void.kind = SPECPDL_UNWIND_VOID; - specpdl_ptr->unwind_void.func = function; - grow_specpdl (); + record_unwind_protect_ptr_1 (function, arg, true); } -static void -do_nothing (void) -{} - -/* Push an unwind-protect entry that does nothing, so that - set_unwind_protect_ptr can overwrite it later. */ - void -record_unwind_protect_nothing (void) +record_unwind_protect_int_1 (void (*function) (int), int arg, + bool wind_explicitly) { - record_unwind_protect_void (do_nothing); + record_unwind_protect_ptr_1 (function, arg, wind_explicitly); } -/* Clear the unwind-protect entry COUNT, so that it does nothing. - It need not be at the top of the stack. */ - void -clear_unwind_protect (ptrdiff_t count) +record_unwind_protect_int (void (*function) (int), int arg) { - union specbinding *p = specpdl + count; - p->unwind_void.kind = SPECPDL_UNWIND_VOID; - p->unwind_void.func = do_nothing; + record_unwind_protect_int_1 (function, arg, true); } -/* Set the unwind-protect entry COUNT so that it invokes FUNC (ARG). - It need not be at the top of the stack. Discard the entry's - previous value without invoking it. */ +static void +call_void (void *data) +{ + ((void (*) (void)) data) (); +} void -set_unwind_protect_ptr (ptrdiff_t count, void (*func) (void *), void *arg) +record_unwind_protect_void_1 (void (*function) (void), + bool wind_explicitly) { - union specbinding *p = specpdl + count; - p->unwind_ptr.kind = SPECPDL_UNWIND_PTR; - p->unwind_ptr.func = func; - p->unwind_ptr.arg = arg; + record_unwind_protect_ptr_1 (call_void, function, wind_explicitly); } -/* Pop and execute entries from the unwind-protect stack until the - depth COUNT is reached. Return VALUE. */ +void +record_unwind_protect_void (void (*function) (void)) +{ + record_unwind_protect_void_1 (function, true); +} -Lisp_Object -unbind_to (ptrdiff_t count, Lisp_Object value) +static void +unbind_once (void *ignore) { - Lisp_Object quitf = Vquit_flag; - struct gcpro gcpro1, gcpro2; + /* Decrement specpdl_ptr before we do the work to unbind it, so + that an error in unbinding won't try to unbind the same entry + again. Take care to copy any parts of the binding needed + before invoking any code that can make more bindings. */ - GCPRO2 (value, quitf); - Vquit_flag = Qnil; + specpdl_ptr--; - while (specpdl_ptr != specpdl + count) + switch (specpdl_ptr->kind) { - /* Decrement specpdl_ptr before we do the work to unbind it, so - that an error in unbinding won't try to unbind the same entry - again. Take care to copy any parts of the binding needed - before invoking any code that can make more bindings. */ - - specpdl_ptr--; - - switch (specpdl_ptr->kind) - { - case SPECPDL_UNWIND: - specpdl_ptr->unwind.func (specpdl_ptr->unwind.arg); - break; - case SPECPDL_UNWIND_PTR: - specpdl_ptr->unwind_ptr.func (specpdl_ptr->unwind_ptr.arg); - break; - case SPECPDL_UNWIND_INT: - specpdl_ptr->unwind_int.func (specpdl_ptr->unwind_int.arg); - break; - case SPECPDL_UNWIND_VOID: - specpdl_ptr->unwind_void.func (); - break; - case SPECPDL_BACKTRACE: - break; - case SPECPDL_LET: - { /* 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. */ - struct Lisp_Symbol *sym = XSYMBOL (specpdl_symbol (specpdl_ptr)); - if (sym->redirect == SYMBOL_PLAINVAL) - { - SET_SYMBOL_VAL (sym, specpdl_old_value (specpdl_ptr)); - break; - } - else - { /* FALLTHROUGH!! - NOTE: we only ever come here if make_local_foo was used for - the first time on this var within this let. */ - } - } - case SPECPDL_LET_DEFAULT: - Fset_default (specpdl_symbol (specpdl_ptr), - specpdl_old_value (specpdl_ptr)); - break; - case SPECPDL_LET_LOCAL: - { - Lisp_Object symbol = specpdl_symbol (specpdl_ptr); - Lisp_Object where = specpdl_where (specpdl_ptr); - Lisp_Object old_value = specpdl_old_value (specpdl_ptr); - eassert (BUFFERP (where)); - - /* If this was a local binding, reset the value in the appropriate - buffer, but only if that buffer's binding still exists. */ - if (!NILP (Flocal_variable_p (symbol, where))) - set_internal (symbol, old_value, where, 1); - } - break; - } + case SPECPDL_BACKTRACE: + break; + case SPECPDL_LET: + { /* 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. */ + sym_t sym = XSYMBOL (specpdl_symbol (specpdl_ptr)); + if (SYMBOL_REDIRECT (sym) == SYMBOL_PLAINVAL) + { + SET_SYMBOL_VAL (sym, specpdl_old_value (specpdl_ptr)); + break; + } + else + { /* FALLTHROUGH!! + NOTE: we only ever come here if make_local_foo was used for + the first time on this var within this let. */ + } + } + case SPECPDL_LET_DEFAULT: + Fset_default (specpdl_symbol (specpdl_ptr), + specpdl_old_value (specpdl_ptr)); + break; + case SPECPDL_LET_LOCAL: + { + Lisp_Object symbol = specpdl_symbol (specpdl_ptr); + Lisp_Object where = specpdl_where (specpdl_ptr); + Lisp_Object old_value = specpdl_old_value (specpdl_ptr); + eassert (BUFFERP (where)); + + /* If this was a local binding, reset the value in the appropriate + buffer, but only if that buffer's binding still exists. */ + if (!NILP (Flocal_variable_p (symbol, where))) + set_internal (symbol, old_value, where, 1); + } + break; } +} - if (NILP (Vquit_flag) && !NILP (quitf)) - Vquit_flag = quitf; +void +dynwind_begin (void) +{ + scm_dynwind_begin (0); +} - UNGCPRO; - return value; +void +dynwind_end (void) +{ + scm_dynwind_end (); } DEFUN ("special-variable-p", Fspecial_variable_p, Sspecial_variable_p, 1, 1, 0, @@ -3397,7 +3248,7 @@ context where binding is lexical by default. */) (Lisp_Object symbol) { CHECK_SYMBOL (symbol); - return XSYMBOL (symbol)->declared_special ? Qt : Qnil; + return SYMBOL_DECLARED_SPECIAL (XSYMBOL (symbol)) ? Qt : Qnil; } @@ -3540,21 +3391,14 @@ backtrace_eval_unrewind (int distance) /* */ switch (tmp->kind) { - /* FIXME: Ideally we'd like to "temporarily unwind" (some of) those - unwind_protect, but the problem is that we don't know how to - rewind them afterwards. */ - case SPECPDL_UNWIND: - case SPECPDL_UNWIND_PTR: - case SPECPDL_UNWIND_INT: - case SPECPDL_UNWIND_VOID: case SPECPDL_BACKTRACE: break; case SPECPDL_LET: { /* 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. */ - struct Lisp_Symbol *sym = XSYMBOL (specpdl_symbol (tmp)); - if (sym->redirect == SYMBOL_PLAINVAL) + sym_t sym = XSYMBOL (specpdl_symbol (tmp)); + if (SYMBOL_REDIRECT (sym) == SYMBOL_PLAINVAL) { Lisp_Object old_value = specpdl_old_value (tmp); set_specpdl_old_value (tmp, SYMBOL_VAL (sym)); @@ -3602,7 +3446,7 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. (Lisp_Object exp, Lisp_Object nframes, Lisp_Object base) { union specbinding *pdl = get_backtrace_frame (nframes, base); - ptrdiff_t count = SPECPDL_INDEX (); + dynwind_begin (); ptrdiff_t distance = specpdl_ptr - pdl; eassert (distance >= 0); @@ -3615,44 +3459,78 @@ NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. /* Use eval_sub rather than Feval since the main motivation behind backtrace-eval is to be able to get/set the value of lexical variables from the debugger. */ - return unbind_to (count, eval_sub (exp)); + Lisp_Object tem1 = eval_sub (exp); + dynwind_end (); + return tem1; } - -void -mark_specpdl (void) + +DEFUN ("backtrace--locals", Fbacktrace__locals, Sbacktrace__locals, 1, 2, NULL, + doc: /* Return names and values of local variables of a stack frame. +NFRAMES and BASE specify the activation frame to use, as in `backtrace-frame'. */) + (Lisp_Object nframes, Lisp_Object base) { - union specbinding *pdl; - for (pdl = specpdl; pdl != specpdl_ptr; pdl++) - { - switch (pdl->kind) - { - case SPECPDL_UNWIND: - mark_object (specpdl_arg (pdl)); - break; + union specbinding *frame = get_backtrace_frame (nframes, base); + union specbinding *prevframe + = get_backtrace_frame (make_number (XFASTINT (nframes) - 1), base); + ptrdiff_t distance = specpdl_ptr - frame; + Lisp_Object result = Qnil; + eassert (distance >= 0); - case SPECPDL_BACKTRACE: + if (!backtrace_p (prevframe)) + error ("Activation frame not found!"); + if (!backtrace_p (frame)) + error ("Activation frame not found!"); + + /* The specpdl entries normally contain the symbol being bound along with its + `old_value', so it can be restored. The new value to which it is bound is + available in one of two places: either in the current value of the + variable (if it hasn't been rebound yet) or in the `old_value' slot of the + next specpdl entry for it. + `backtrace_eval_unrewind' happens to swap the role of `old_value' + and "new value", so we abuse it here, to fetch the new value. + It's ugly (we'd rather not modify global data) and a bit inefficient, + but it does the job for now. */ + backtrace_eval_unrewind (distance); + + /* Grab values. */ + { + union specbinding *tmp = prevframe; + for (; tmp > frame; tmp--) + { + switch (tmp->kind) { - ptrdiff_t nargs = backtrace_nargs (pdl); - mark_object (backtrace_function (pdl)); - if (nargs == UNEVALLED) - nargs = 1; - while (nargs--) - mark_object (backtrace_args (pdl)[nargs]); + case SPECPDL_LET: + case SPECPDL_LET_DEFAULT: + case SPECPDL_LET_LOCAL: + { + Lisp_Object sym = specpdl_symbol (tmp); + Lisp_Object val = specpdl_old_value (tmp); + if (EQ (sym, Qinternal_interpreter_environment)) + { + Lisp_Object env = val; + for (; CONSP (env); env = XCDR (env)) + { + Lisp_Object binding = XCAR (env); + if (CONSP (binding)) + result = Fcons (Fcons (XCAR (binding), + XCDR (binding)), + result); + } + } + else + result = Fcons (Fcons (sym, val), result); + } } - break; + } + } - case SPECPDL_LET_DEFAULT: - case SPECPDL_LET_LOCAL: - mark_object (specpdl_where (pdl)); - /* Fall through. */ - case SPECPDL_LET: - mark_object (specpdl_symbol (pdl)); - mark_object (specpdl_old_value (pdl)); - break; - } - } + /* Restore values from specpdl to original place. */ + backtrace_eval_unrewind (-distance); + + return result; } + void get_backtrace (Lisp_Object array) { @@ -3677,17 +3555,52 @@ Lisp_Object backtrace_top_function (void) union specbinding *pdl = backtrace_top (); return (backtrace_p (pdl) ? backtrace_function (pdl) : Qnil); } + +_Noreturn SCM +abort_to_prompt (SCM tag, SCM arglst) +{ + static SCM var = SCM_UNDEFINED; + if (SCM_UNBNDP (var)) + var = scm_c_public_lookup ("guile", "abort-to-prompt"); + + scm_apply_1 (scm_variable_ref (var), tag, arglst); + emacs_abort (); +} +SCM +call_with_prompt (SCM tag, SCM thunk, SCM handler) +{ + static SCM var = SCM_UNDEFINED; + if (SCM_UNBNDP (var)) + var = scm_c_public_lookup ("guile", "call-with-prompt"); + + return scm_call_3 (scm_variable_ref (var), tag, thunk, handler); +} + +SCM +make_prompt_tag (void) +{ + static SCM var = SCM_UNDEFINED; + if (SCM_UNBNDP (var)) + var = scm_c_public_lookup ("guile", "make-prompt-tag"); + + return scm_call_0 (scm_variable_ref (var)); +} + void syms_of_eval (void) { +#include "eval.x" + DEFVAR_INT ("max-specpdl-size", max_specpdl_size, doc: /* Limit on number of Lisp variable bindings and `unwind-protect's. If Lisp code tries to increase the total number past this amount, an error is signaled. You can safely use a value considerably larger than the default value, if that proves inconveniently small. However, if you increase it too far, -Emacs could run out of memory trying to make the stack bigger. */); +Emacs could run out of memory trying to make the stack bigger. +Note that this limit may be silently increased by the debugger +if `debug-on-error' or `debug-on-quit' is set. */); DEFVAR_INT ("max-lisp-eval-depth", max_lisp_eval_depth, doc: /* Limit on depth in `eval', `apply' and `funcall' before error. @@ -3823,48 +3736,4 @@ alist of active lexical bindings. */); Vsignaling_function = Qnil; inhibit_lisp_code = Qnil; - - defsubr (&Sor); - defsubr (&Sand); - defsubr (&Sif); - defsubr (&Scond); - defsubr (&Sprogn); - defsubr (&Sprog1); - defsubr (&Sprog2); - defsubr (&Ssetq); - defsubr (&Squote); - defsubr (&Sfunction); - defsubr (&Sdefault_toplevel_value); - defsubr (&Sset_default_toplevel_value); - defsubr (&Sdefvar); - defsubr (&Sdefvaralias); - defsubr (&Sdefconst); - defsubr (&Smake_var_non_special); - defsubr (&Slet); - defsubr (&SletX); - defsubr (&Swhile); - defsubr (&Smacroexpand); - defsubr (&Scatch); - defsubr (&Sthrow); - defsubr (&Sunwind_protect); - defsubr (&Scondition_case); - defsubr (&Ssignal); - defsubr (&Scommandp); - defsubr (&Sautoload); - defsubr (&Sautoload_do_load); - 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 (&Srun_hook_wrapped); - defsubr (&Sfetch_bytecode); - defsubr (&Sbacktrace_debug); - defsubr (&Sbacktrace); - defsubr (&Sbacktrace_frame); - defsubr (&Sbacktrace_eval); - defsubr (&Sspecial_variable_p); - defsubr (&Sfunctionp); }