Mercurial > hg > xemacs-beta
diff src/eval.c @ 398:74fd4e045ea6 r21-2-29
Import from CVS: tag r21-2-29
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:13:30 +0200 |
parents | 8626e4521993 |
children | a86b2b5e0111 |
line wrap: on
line diff
--- a/src/eval.c Mon Aug 13 11:12:06 2007 +0200 +++ b/src/eval.c Mon Aug 13 11:13:30 2007 +0200 @@ -73,12 +73,11 @@ a SUBR with more than 8 arguments, use max_args == MANY. See the DEFUN macro in lisp.h) */ #define PRIMITIVE_FUNCALL(rv, fn, av, ac) do { \ - void (*PF_fn)() = (void (*)()) (fn); \ + void (*PF_fn)(void) = (void (*)(void)) fn; \ Lisp_Object *PF_av = (av); \ switch (ac) \ { \ - default: abort(); \ - case 0: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 0); break; \ + default:rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 0); break; \ case 1: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 1); break; \ case 2: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 2); break; \ case 3: rv = PRIMITIVE_FUNCALL_1(PF_fn, PF_av, 3); break; \ @@ -170,7 +169,7 @@ int max_specpdl_size; /* Depth in Lisp evaluations and function calls. */ -int lisp_eval_depth; +static int lisp_eval_depth; /* Maximum allowed depth in Lisp evaluations and function calls. */ int max_lisp_eval_depth; @@ -282,10 +281,10 @@ print_subr (Lisp_Object obj, Lisp_Object printcharfun, int escapeflag) { Lisp_Subr *subr = XSUBR (obj); - CONST char *header = + const char *header = (subr->max_args == UNEVALLED) ? "#<special-form " : "#<subr "; - CONST char *name = subr_name (subr); - CONST char *trailer = subr->prompt ? " (interactive)>" : ">"; + const char *name = subr_name (subr); + const char *trailer = subr->prompt ? " (interactive)>" : ">"; if (print_readably) error ("printing unreadable object %s%s%s", header, name, trailer); @@ -295,9 +294,15 @@ write_c_string (trailer, printcharfun); } -DEFINE_LRECORD_IMPLEMENTATION ("subr", subr, - this_one_is_unmarkable, print_subr, 0, 0, 0, - Lisp_Subr); +static const struct lrecord_description subr_description[] = { + { XD_DOC_STRING, offsetof (Lisp_Subr, doc) }, + { XD_END } +}; + +DEFINE_BASIC_LRECORD_IMPLEMENTATION ("subr", subr, + this_one_is_unmarkable, print_subr, 0, 0, 0, + subr_description, + Lisp_Subr); /************************************************************************/ /* Entering the debugger */ @@ -1004,8 +1009,6 @@ static Lisp_Object define_function (Lisp_Object name, Lisp_Object defn) { - if (purify_flag) - defn = Fpurecopy (defn); Ffset (name, defn); LOADHIST_ATTACH (name); return name; @@ -1078,14 +1081,7 @@ if (!NILP (args = XCDR (args))) { Lisp_Object doc = XCAR (args); -#if 0 /* FSFmacs */ - /* #### We should probably do this but it might be dangerous */ - if (purify_flag) - doc = Fpurecopy (doc); Fput (sym, Qvariable_documentation, doc); -#else - pure_put (sym, Qvariable_documentation, doc); -#endif if (!NILP (args = XCDR (args))) error ("too many arguments"); } @@ -1093,7 +1089,7 @@ #ifdef I18N3 if (!NILP (Vfile_domain)) - pure_put (sym, Qvariable_domain, Vfile_domain); + Fput (sym, Qvariable_domain, Vfile_domain); #endif LOADHIST_ATTACH (sym); @@ -1133,21 +1129,14 @@ if (!NILP (args = XCDR (args))) { Lisp_Object doc = XCAR (args); -#if 0 /* FSFmacs */ - /* #### We should probably do this but it might be dangerous */ - if (purify_flag) - doc = Fpurecopy (doc); Fput (sym, Qvariable_documentation, doc); -#else - pure_put (sym, Qvariable_documentation, doc); -#endif if (!NILP (args = XCDR (args))) error ("too many arguments"); } #ifdef I18N3 if (!NILP (Vfile_domain)) - pure_put (sym, Qvariable_domain, Vfile_domain); + Fput (sym, Qvariable_domain, Vfile_domain); #endif LOADHIST_ATTACH (sym); @@ -1167,7 +1156,7 @@ return ((INTP (documentation) && XINT (documentation) < 0) || - ((STRINGP (documentation)) && + (STRINGP (documentation) && (string_byte (XSTRING (documentation), 0) == '*')) || /* If (STRING . INTEGER), a negative integer means a user variable. */ @@ -1493,7 +1482,7 @@ static Lisp_Object condition_bind_unwind (Lisp_Object loser) { - struct Lisp_Cons *victim; + Lisp_Cons *victim; /* ((handler-fun . handler-args) ... other handlers) */ Lisp_Object tem = XCAR (loser); @@ -1515,7 +1504,7 @@ static Lisp_Object condition_case_unwind (Lisp_Object loser) { - struct Lisp_Cons *victim; + Lisp_Cons *victim; /* ((<unbound> . clauses) ... other handlers */ victim = XCONS (XCAR (loser)); @@ -2225,13 +2214,13 @@ /* dump an error message; called like printf */ DOESNT_RETURN -error (CONST char *fmt, ...) +error (const char *fmt, ...) { Lisp_Object obj; va_list args; va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, + obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1, args); va_end (args); @@ -2240,7 +2229,7 @@ } void -maybe_error (Lisp_Object class, Error_behavior errb, CONST char *fmt, ...) +maybe_error (Lisp_Object class, Error_behavior errb, const char *fmt, ...) { Lisp_Object obj; va_list args; @@ -2250,7 +2239,7 @@ return; va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, + obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1, args); va_end (args); @@ -2259,13 +2248,13 @@ } Lisp_Object -continuable_error (CONST char *fmt, ...) +continuable_error (const char *fmt, ...) { Lisp_Object obj; va_list args; va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, + obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1, args); va_end (args); @@ -2275,7 +2264,7 @@ Lisp_Object maybe_continuable_error (Lisp_Object class, Error_behavior errb, - CONST char *fmt, ...) + const char *fmt, ...) { Lisp_Object obj; va_list args; @@ -2285,7 +2274,7 @@ return Qnil; va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, + obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1, args); va_end (args); @@ -2302,13 +2291,13 @@ where the error is occurring). */ DOESNT_RETURN -signal_simple_error (CONST char *reason, Lisp_Object frob) +signal_simple_error (const char *reason, Lisp_Object frob) { signal_error (Qerror, list2 (build_translated_string (reason), frob)); } void -maybe_signal_simple_error (CONST char *reason, Lisp_Object frob, +maybe_signal_simple_error (const char *reason, Lisp_Object frob, Lisp_Object class, Error_behavior errb) { /* Optimization: */ @@ -2319,13 +2308,13 @@ } Lisp_Object -signal_simple_continuable_error (CONST char *reason, Lisp_Object frob) +signal_simple_continuable_error (const char *reason, Lisp_Object frob) { return Fsignal (Qerror, list2 (build_translated_string (reason), frob)); } Lisp_Object -maybe_signal_simple_continuable_error (CONST char *reason, Lisp_Object frob, +maybe_signal_simple_continuable_error (const char *reason, Lisp_Object frob, Lisp_Object class, Error_behavior errb) { /* Optimization: */ @@ -2346,13 +2335,13 @@ */ DOESNT_RETURN -error_with_frob (Lisp_Object frob, CONST char *fmt, ...) +error_with_frob (Lisp_Object frob, const char *fmt, ...) { Lisp_Object obj; va_list args; va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, + obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1, args); va_end (args); @@ -2362,7 +2351,7 @@ void maybe_error_with_frob (Lisp_Object frob, Lisp_Object class, - Error_behavior errb, CONST char *fmt, ...) + Error_behavior errb, const char *fmt, ...) { Lisp_Object obj; va_list args; @@ -2372,7 +2361,7 @@ return; va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, + obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1, args); va_end (args); @@ -2381,13 +2370,13 @@ } Lisp_Object -continuable_error_with_frob (Lisp_Object frob, CONST char *fmt, ...) +continuable_error_with_frob (Lisp_Object frob, const char *fmt, ...) { Lisp_Object obj; va_list args; va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, + obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1, args); va_end (args); @@ -2397,7 +2386,7 @@ Lisp_Object maybe_continuable_error_with_frob (Lisp_Object frob, Lisp_Object class, - Error_behavior errb, CONST char *fmt, ...) + Error_behavior errb, const char *fmt, ...) { Lisp_Object obj; va_list args; @@ -2407,7 +2396,7 @@ return Qnil; va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), Qnil, -1, + obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1, args); va_end (args); @@ -2424,7 +2413,7 @@ is three objects, a string and two related Lisp objects. */ DOESNT_RETURN -signal_simple_error_2 (CONST char *reason, +signal_simple_error_2 (const char *reason, Lisp_Object frob0, Lisp_Object frob1) { signal_error (Qerror, list3 (build_translated_string (reason), frob0, @@ -2432,7 +2421,7 @@ } void -maybe_signal_simple_error_2 (CONST char *reason, Lisp_Object frob0, +maybe_signal_simple_error_2 (const char *reason, Lisp_Object frob0, Lisp_Object frob1, Lisp_Object class, Error_behavior errb) { @@ -2445,7 +2434,7 @@ Lisp_Object -signal_simple_continuable_error_2 (CONST char *reason, Lisp_Object frob0, +signal_simple_continuable_error_2 (const char *reason, Lisp_Object frob0, Lisp_Object frob1) { return Fsignal (Qerror, list3 (build_translated_string (reason), frob0, @@ -2453,7 +2442,7 @@ } Lisp_Object -maybe_signal_simple_continuable_error_2 (CONST char *reason, Lisp_Object frob0, +maybe_signal_simple_continuable_error_2 (const char *reason, Lisp_Object frob0, Lisp_Object frob1, Lisp_Object class, Error_behavior errb) { @@ -2481,47 +2470,48 @@ /* Used in core lisp functions for efficiency */ -void +Lisp_Object signal_void_function_error (Lisp_Object function) { - Fsignal (Qvoid_function, list1 (function)); + return Fsignal (Qvoid_function, list1 (function)); } -static void +Lisp_Object signal_invalid_function_error (Lisp_Object function) { - Fsignal (Qinvalid_function, list1 (function)); + return Fsignal (Qinvalid_function, list1 (function)); } -static void +Lisp_Object signal_wrong_number_of_arguments_error (Lisp_Object function, int nargs) { - Fsignal (Qwrong_number_of_arguments, list2 (function, make_int (nargs))); + return Fsignal (Qwrong_number_of_arguments, + list2 (function, make_int (nargs))); } /* Used in list traversal macros for efficiency. */ -void +DOESNT_RETURN signal_malformed_list_error (Lisp_Object list) { - Fsignal (Qmalformed_list, list1 (list)); + signal_error (Qmalformed_list, list1 (list)); } -void +DOESNT_RETURN signal_malformed_property_list_error (Lisp_Object list) { - Fsignal (Qmalformed_property_list, list1 (list)); + signal_error (Qmalformed_property_list, list1 (list)); } -void +DOESNT_RETURN signal_circular_list_error (Lisp_Object list) { - Fsignal (Qcircular_list, list1 (list)); + signal_error (Qcircular_list, list1 (list)); } -void +DOESNT_RETURN signal_circular_property_list_error (Lisp_Object list) { - Fsignal (Qcircular_property_list, list1 (list)); + signal_error (Qcircular_property_list, list1 (list)); } /************************************************************************/ @@ -2633,7 +2623,7 @@ { Fsignal (Qwrong_type_argument, Fcons (Qcommandp, - ((EQ (cmd, final)) + (EQ (cmd, final) ? list1 (cmd) : list2 (cmd, final)))); return Qnil; @@ -2751,11 +2741,10 @@ file = Fsymbol_name (Fintern (file, Qnil)); } - return Ffset (function, - Fpurecopy (Fcons (Qautoload, list4 (file, - docstring, - interactive, - type)))); + return Ffset (function, Fcons (Qautoload, list4 (file, + docstring, + interactive, + type))); } Lisp_Object @@ -2842,7 +2831,7 @@ /************************************************************************/ static Lisp_Object funcall_lambda (Lisp_Object fun, - int nargs, Lisp_Object args[]); + int nargs, Lisp_Object args[]); static int in_warnings; static Lisp_Object @@ -2955,7 +2944,7 @@ if (max_args == UNEVALLED) /* Optimize for the common case */ { backtrace.evalargs = 0; - val = (((Lisp_Object (*) (Lisp_Object)) (subr_function (subr))) + val = (((Lisp_Object (*) (Lisp_Object)) subr_function (subr)) (original_args)); } else if (nargs <= max_args) @@ -3009,7 +2998,7 @@ backtrace.args = args; backtrace.nargs = nargs; - val = (((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr))) + val = (((Lisp_Object (*) (int, Lisp_Object *)) subr_function (subr)) (nargs, args)); UNGCPRO; @@ -3017,7 +3006,7 @@ else { wrong_number_of_arguments: - signal_wrong_number_of_arguments_error (fun, nargs); + val = signal_wrong_number_of_arguments_error (original_fun, nargs); } } else if (COMPILED_FUNCTIONP (fun)) @@ -3105,7 +3094,7 @@ else /* ! (SUBRP (fun) || COMPILED_FUNCTIONP (fun) || CONSP (fun)) */ { invalid_function: - signal_invalid_function_error (fun); + val = signal_invalid_function_error (fun); } lisp_eval_depth--; @@ -3180,14 +3169,15 @@ int max_args = subr->max_args; Lisp_Object spacious_args[SUBR_MAX_ARGS]; - if (fun_nargs < subr->min_args) - goto wrong_number_of_arguments; - if (fun_nargs == max_args) /* Optimize for the common case */ { funcall_subr: FUNCALL_SUBR (val, subr, fun_args, max_args); } + else if (fun_nargs < subr->min_args) + { + goto wrong_number_of_arguments; + } else if (fun_nargs < max_args) { Lisp_Object *p = spacious_args; @@ -3203,8 +3193,7 @@ } else if (max_args == MANY) { - val = ((Lisp_Object (*) (int, Lisp_Object *)) (subr_function (subr))) - (fun_nargs, fun_args); + val = SUBR_FUNCTION (subr, MANY) (fun_nargs, fun_args); } else if (max_args == UNEVALLED) /* Can't funcall a special form */ { @@ -3213,7 +3202,7 @@ else { wrong_number_of_arguments: - signal_wrong_number_of_arguments_error (fun, fun_nargs); + val = signal_wrong_number_of_arguments_error (fun, fun_nargs); } } else if (COMPILED_FUNCTIONP (fun)) @@ -3240,12 +3229,12 @@ } else if (UNBOUNDP (fun)) { - signal_void_function_error (args[0]); + val = signal_void_function_error (args[0]); } else { invalid_function: - signal_invalid_function_error (fun); + val = signal_invalid_function_error (fun); } lisp_eval_depth--; @@ -3321,7 +3310,7 @@ else { invalid_function: - return Fsignal (Qinvalid_function, list1 (function)); + return signal_invalid_function_error (function); } { @@ -3508,10 +3497,10 @@ return unbind_to (speccount, Fprogn (body)); wrong_number_of_arguments: - return Fsignal (Qwrong_number_of_arguments, list2 (fun, make_int (nargs))); + return signal_wrong_number_of_arguments_error (fun, nargs); invalid_function: - return Fsignal (Qinvalid_function, list1 (fun)); + return signal_invalid_function_error (fun); } @@ -3627,8 +3616,9 @@ } else { - struct gcpro gcpro1, gcpro2; - GCPRO2 (sym, val); + struct gcpro gcpro1, gcpro2, gcpro3; + Lisp_Object globals = Qnil; + GCPRO3 (sym, val, globals); for (; CONSP (val) && ((cond == RUN_HOOKS_TO_COMPLETION) @@ -3640,7 +3630,7 @@ { /* t indicates this hook has a local binding; it means to run the global binding too. */ - Lisp_Object globals = Fdefault_value (sym); + globals = Fdefault_value (sym); if ((! CONSP (globals) || EQ (XCAR (globals), Qlambda)) && ! NILP (globals)) @@ -4148,7 +4138,7 @@ args[1] = errordata; warn_when_safe_lispobj (Qerror, Qwarning, - emacs_doprnt_string_lisp ((CONST Bufbyte *) "%s: %s", + emacs_doprnt_string_lisp ((const Bufbyte *) "%s: %s", Qnil, -1, 2, args)); } return Qunbound; @@ -4191,7 +4181,7 @@ } Lisp_Object -eval_in_buffer_trapping_errors (CONST char *warning_string, +eval_in_buffer_trapping_errors (const char *warning_string, struct buffer *buf, Lisp_Object form) { int speccount = specpdl_depth(); @@ -4207,14 +4197,14 @@ /* gc_currently_forbidden = 1; Currently no reason to do this; */ cons = noseeum_cons (buffer, form); - opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); + opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil); GCPRO2 (cons, opaque); /* Qerror not Qt, so you can get a backtrace */ tem = condition_case_1 (Qerror, catch_them_squirmers_eval_in_buffer, cons, caught_a_squirmer, opaque); free_cons (XCONS (cons)); - if (OPAQUEP (opaque)) + if (OPAQUE_PTRP (opaque)) free_opaque_ptr (opaque); UNGCPRO; @@ -4231,7 +4221,7 @@ } Lisp_Object -run_hook_trapping_errors (CONST char *warning_string, Lisp_Object hook_symbol) +run_hook_trapping_errors (const char *warning_string, Lisp_Object hook_symbol) { int speccount; Lisp_Object tem; @@ -4247,13 +4237,13 @@ speccount = specpdl_depth(); specbind (Qinhibit_quit, Qt); - opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); + opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil); GCPRO1 (opaque); /* Qerror not Qt, so you can get a backtrace */ tem = condition_case_1 (Qerror, catch_them_squirmers_run_hook, hook_symbol, caught_a_squirmer, opaque); - if (OPAQUEP (opaque)) + if (OPAQUE_PTRP (opaque)) free_opaque_ptr (opaque); UNGCPRO; @@ -4264,7 +4254,7 @@ if an error occurs. */ Lisp_Object -safe_run_hook_trapping_errors (CONST char *warning_string, +safe_run_hook_trapping_errors (const char *warning_string, Lisp_Object hook_symbol, int allow_quit) { @@ -4283,7 +4273,7 @@ specbind (Qinhibit_quit, Qt); cons = noseeum_cons (hook_symbol, - warning_string ? make_opaque_ptr (warning_string) + warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil); GCPRO1 (cons); /* Qerror not Qt, so you can get a backtrace */ @@ -4294,7 +4284,7 @@ allow_quit_safe_run_hook_caught_a_squirmer : safe_run_hook_caught_a_squirmer, cons); - if (OPAQUEP (XCDR (cons))) + if (OPAQUE_PTRP (XCDR (cons))) free_opaque_ptr (XCDR (cons)); free_cons (XCONS (cons)); UNGCPRO; @@ -4310,7 +4300,7 @@ } Lisp_Object -call0_trapping_errors (CONST char *warning_string, Lisp_Object function) +call0_trapping_errors (const char *warning_string, Lisp_Object function) { int speccount; Lisp_Object tem; @@ -4329,12 +4319,12 @@ specbind (Qinhibit_quit, Qt); /* gc_currently_forbidden = 1; Currently no reason to do this; */ - opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); + opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil); /* Qerror not Qt, so you can get a backtrace */ tem = condition_case_1 (Qerror, catch_them_squirmers_call0, function, caught_a_squirmer, opaque); - if (OPAQUEP (opaque)) + if (OPAQUE_PTRP (opaque)) free_opaque_ptr (opaque); UNGCPRO; @@ -4357,7 +4347,7 @@ } Lisp_Object -call1_trapping_errors (CONST char *warning_string, Lisp_Object function, +call1_trapping_errors (const char *warning_string, Lisp_Object function, Lisp_Object object) { int speccount = specpdl_depth(); @@ -4379,12 +4369,12 @@ /* gc_currently_forbidden = 1; Currently no reason to do this; */ cons = noseeum_cons (function, object); - opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); + opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil); /* Qerror not Qt, so you can get a backtrace */ tem = condition_case_1 (Qerror, catch_them_squirmers_call1, cons, caught_a_squirmer, opaque); - if (OPAQUEP (opaque)) + if (OPAQUE_PTRP (opaque)) free_opaque_ptr (opaque); free_cons (XCONS (cons)); UNGCPRO; @@ -4394,7 +4384,7 @@ } Lisp_Object -call2_trapping_errors (CONST char *warning_string, Lisp_Object function, +call2_trapping_errors (const char *warning_string, Lisp_Object function, Lisp_Object object1, Lisp_Object object2) { int speccount = specpdl_depth(); @@ -4415,12 +4405,12 @@ /* gc_currently_forbidden = 1; Currently no reason to do this; */ cons = list3 (function, object1, object2); - opaque = (warning_string ? make_opaque_ptr (warning_string) : Qnil); + opaque = (warning_string ? make_opaque_ptr ((void *)warning_string) : Qnil); /* Qerror not Qt, so you can get a backtrace */ tem = condition_case_1 (Qerror, catch_them_squirmers_call2, cons, caught_a_squirmer, opaque); - if (OPAQUEP (opaque)) + if (OPAQUE_PTRP (opaque)) free_opaque_ptr (opaque); free_list (cons); UNGCPRO; @@ -4473,7 +4463,7 @@ { Lisp_Object current = Fcurrent_buffer (); Lisp_Object symbol = specpdl_ptr->symbol; - struct Lisp_Cons *victim = XCONS (ovalue); + Lisp_Cons *victim = XCONS (ovalue); Lisp_Object buf = get_buffer (victim->car, 0); ovalue = victim->cdr; @@ -4627,7 +4617,7 @@ { /* We checked symbol for validity when we specbound it, so only need to call Fset if symbol has magic value. */ - struct Lisp_Symbol *sym = XSYMBOL (specpdl_ptr->symbol); + Lisp_Symbol *sym = XSYMBOL (specpdl_ptr->symbol); if (!SYMBOL_VALUE_MAGIC_P (sym->value)) sym->value = specpdl_ptr->old_value; else @@ -4753,7 +4743,7 @@ DEFUN ("backtrace", Fbacktrace, 0, 2, "", /* Print a trace of Lisp function calls currently active. -Option arg STREAM specifies the output stream to send the backtrace to, +Optional arg STREAM specifies the output stream to send the backtrace to, and defaults to the value of `standard-output'. Optional second arg DETAILED means show places where currently active variable bindings, catches, condition-cases, and unwind-protects were made as well as @@ -4796,8 +4786,8 @@ if (!NILP (detailed) && catches && catches->backlist == backlist) { int catchpdl = catches->pdlcount; - if (specpdl[catchpdl].func == condition_case_unwind - && speccount > catchpdl) + if (speccount > catchpdl + && specpdl[catchpdl].func == condition_case_unwind) /* This is a condition-case catchpoint */ catchpdl = catchpdl + 1; @@ -4947,13 +4937,13 @@ automatically be called when it is safe to do so. */ void -warn_when_safe (Lisp_Object class, Lisp_Object level, CONST char *fmt, ...) +warn_when_safe (Lisp_Object class, Lisp_Object level, const char *fmt, ...) { Lisp_Object obj; va_list args; va_start (args, fmt); - obj = emacs_doprnt_string_va ((CONST Bufbyte *) GETTEXT (fmt), + obj = emacs_doprnt_string_va ((const Bufbyte *) GETTEXT (fmt), Qnil, -1, args); va_end (args); @@ -5053,8 +5043,28 @@ } void +reinit_vars_of_eval (void) +{ + preparing_for_armageddon = 0; + in_warnings = 0; + Qunbound_suspended_errors_tag = make_opaque_ptr (&Qunbound_suspended_errors_tag); + staticpro_nodump (&Qunbound_suspended_errors_tag); + + specpdl_size = 50; + specpdl = xnew_array (struct specbinding, specpdl_size); + /* XEmacs change: increase these values. */ + max_specpdl_size = 3000; + max_lisp_eval_depth = 500; +#if 0 /* no longer used */ + throw_level = 0; +#endif +} + +void vars_of_eval (void) { + reinit_vars_of_eval (); + DEFVAR_INT ("max-specpdl-size", &max_specpdl_size /* Limit on number of Lisp variable bindings & unwind-protects before error. */ ); @@ -5156,13 +5166,10 @@ */ ); Vdebugger = Qnil; - preparing_for_armageddon = 0; - staticpro (&Vpending_warnings); Vpending_warnings = Qnil; - Vpending_warnings_tail = Qnil; /* no need to protect this */ - - in_warnings = 0; + pdump_wire (&Vpending_warnings_tail); + Vpending_warnings_tail = Qnil; staticpro (&Vautoload_queue); Vautoload_queue = Qnil; @@ -5175,18 +5182,5 @@ staticpro (&Vcurrent_error_state); Vcurrent_error_state = Qnil; /* errors as normal */ - Qunbound_suspended_errors_tag = make_opaque_long (0); - staticpro (&Qunbound_suspended_errors_tag); - - specpdl_size = 50; - specpdl_depth_counter = 0; - specpdl = xnew_array (struct specbinding, specpdl_size); - /* XEmacs change: increase these values. */ - max_specpdl_size = 3000; - max_lisp_eval_depth = 500; -#if 0 /* no longer used */ - throw_level = 0; -#endif - reinit_eval (); }