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; \
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;
static Lisp_Object Vcondition_handlers;
-#if 0 /* no longer used */
+#define DEFEND_AGAINST_THROW_RECURSION
+
+#ifdef DEFEND_AGAINST_THROW_RECURSION
/* Used for error catching purposes by throw_or_bomb_out */
static int throw_level;
-#endif /* unused */
+#endif
+
+#ifdef ERROR_CHECK_TYPECHECK
+void check_error_state_sanity (void);
+#endif
\f
/************************************************************************/
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);
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,
+ 0, print_subr, 0, 0, 0,
+ subr_description,
+ Lisp_Subr);
\f
/************************************************************************/
/* Entering the debugger */
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;
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);
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);
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. */
c.val = (*func) (arg);
if (threw) *threw = 0;
catchlist = c.next;
+#ifdef ERROR_CHECK_TYPECHECK
+ check_error_state_sanity ();
+#endif
return c.val;
}
unbind_to (catchlist->pdlcount, Qnil);
handlerlist = catchlist->handlerlist;
catchlist = catchlist->next;
+#ifdef ERROR_CHECK_TYPECHECK
+ check_error_state_sanity ();
+#endif
}
while (! last_time);
#else /* Actual XEmacs code */
/* Unwind the specpdl stack */
unbind_to (c->pdlcount, Qnil);
catchlist = c->next;
+#ifdef ERROR_CHECK_TYPECHECK
+ check_error_state_sanity ();
+#endif
#endif
gcprolist = c->gcpro;
backtrace_list = c->backlist;
lisp_eval_depth = c->lisp_eval_depth;
-#if 0 /* no longer used */
+#ifdef DEFEND_AGAINST_THROW_RECURSION
throw_level = 0;
#endif
LONGJMP (c->jmp, 1);
throw_or_bomb_out (Lisp_Object tag, Lisp_Object val, int bomb_out_p,
Lisp_Object sig, Lisp_Object data)
{
-#if 0
+#ifdef DEFEND_AGAINST_THROW_RECURSION
/* die if we recurse more than is reasonable */
if (++throw_level > 20)
abort();
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);
static Lisp_Object
condition_case_unwind (Lisp_Object loser)
{
- struct Lisp_Cons *victim;
+ Lisp_Cons *victim;
/* ((<unbound> . clauses) ... other handlers */
victim = XCONS (XCAR (loser));
have this code here, and it doesn't cost anything, so I'm leaving it.*/
UNGCPRO;
catchlist = c.next;
+#ifdef ERROR_CHECK_TYPECHECK
+ check_error_state_sanity ();
+#endif
Vcondition_handlers = XCDR (c.tag);
return unbind_to (speccount, c.val);
{
/* who knows how much has been initialized? Safest bet is
just to bomb out immediately. */
+ /* let's not use stderr_out() here, because that does a bunch of
+ things that might not be safe yet. */
fprintf (stderr, "Error before initialization is complete!\n");
abort ();
}
for (;;)
Fsignal (sig, data);
}
-
-static Lisp_Object
-call_with_suspended_errors_1 (Lisp_Object opaque_arg)
+#ifdef ERROR_CHECK_TYPECHECK
+void
+check_error_state_sanity (void)
{
- Lisp_Object val;
- Lisp_Object *kludgy_args = (Lisp_Object *) get_opaque_ptr (opaque_arg);
- PRIMITIVE_FUNCALL (val, get_opaque_ptr (kludgy_args[0]),
- kludgy_args + 2, XINT (kludgy_args[1]));
- return val;
+ struct catchtag *c;
+ int found_error_tag = 0;
+
+ for (c = catchlist; c; c = c->next)
+ {
+ if (EQ (c->tag, Qunbound_suspended_errors_tag))
+ {
+ found_error_tag = 1;
+ break;
+ }
+ }
+
+ assert (found_error_tag || NILP (Vcurrent_error_state));
}
+#endif
static Lisp_Object
restore_current_warning_class (Lisp_Object warning_class)
return Qnil;
}
+static Lisp_Object
+call_with_suspended_errors_1 (Lisp_Object opaque_arg)
+{
+ Lisp_Object val;
+ Lisp_Object *kludgy_args = (Lisp_Object *) get_opaque_ptr (opaque_arg);
+ Lisp_Object no_error = kludgy_args[2];
+ int speccount = specpdl_depth ();
+
+ if (!EQ (Vcurrent_error_state, no_error))
+ {
+ record_unwind_protect (restore_current_error_state,
+ Vcurrent_error_state);
+ Vcurrent_error_state = no_error;
+ }
+ PRIMITIVE_FUNCALL (val, get_opaque_ptr (kludgy_args[0]),
+ kludgy_args + 3, XINT (kludgy_args[1]));
+ return unbind_to (speccount, val);
+}
+
/* Many functions would like to do one of three things if an error
occurs:
{
va_list vargs;
int speccount;
- Lisp_Object kludgy_args[22];
- Lisp_Object *args = kludgy_args + 2;
+ Lisp_Object kludgy_args[23];
+ Lisp_Object *args = kludgy_args + 3;
int i;
Lisp_Object no_error;
return val;
}
- speccount = specpdl_depth();
+ speccount = specpdl_depth ();
if (NILP (class) || NILP (Vcurrent_warning_class))
{
/* If we're currently calling for no warnings, then make it so.
Vcurrent_warning_class);
Vcurrent_warning_class = class;
}
- if (!EQ (Vcurrent_error_state, no_error))
- {
- record_unwind_protect (restore_current_error_state,
- Vcurrent_error_state);
- Vcurrent_error_state = no_error;
- }
{
int threw;
GCPRO2 (opaque1, opaque2);
kludgy_args[0] = opaque2;
kludgy_args[1] = make_int (nargs);
+ kludgy_args[2] = no_error;
the_retval = internal_catch (Qunbound_suspended_errors_tag,
call_with_suspended_errors_1,
opaque1, &threw);
/* 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);
}
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;
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);
}
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);
Lisp_Object
maybe_continuable_error (Lisp_Object class, Error_behavior errb,
- CONST char *fmt, ...)
+ const char *fmt, ...)
{
Lisp_Object obj;
va_list args;
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);
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: */
}
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: */
*/
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);
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;
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);
}
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);
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;
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);
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,
}
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)
{
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,
}
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)
{
\f
/* 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));
}
\f
/************************************************************************/
{
Fsignal (Qwrong_type_argument,
Fcons (Qcommandp,
- ((EQ (cmd, final))
+ (EQ (cmd, final)
? list1 (cmd)
: list2 (cmd, final))));
return Qnil;
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
/************************************************************************/
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
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)
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;
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))
else /* ! (SUBRP (fun) || COMPILED_FUNCTIONP (fun) || CONSP (fun)) */
{
invalid_function:
- signal_invalid_function_error (fun);
+ val = signal_invalid_function_error (fun);
}
lisp_eval_depth--;
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;
}
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 */
{
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))
}
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--;
else
{
invalid_function:
- return Fsignal (Qinvalid_function, list1 (function));
+ return signal_invalid_function_error (function);
}
{
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);
}
\f
}
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)
{
/* 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))
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;
}
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();
/* 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;
}
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;
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;
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)
{
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 */
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;
}
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;
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;
}
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();
/* 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;
}
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();
/* 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;
{
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;
{
int quitf;
+ ++specpdl_ptr;
+ ++specpdl_depth_counter;
+
check_quit (); /* make Vquit_flag accurate */
quitf = !NILP (Vquit_flag);
Vquit_flag = Qnil;
- ++specpdl_ptr;
- ++specpdl_depth_counter;
-
while (specpdl_depth_counter != count)
{
--specpdl_ptr;
{
/* 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
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
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;
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);
void
syms_of_eval (void)
{
+ INIT_LRECORD_IMPLEMENTATION (subr);
+
defsymbol (&Qinhibit_quit, "inhibit-quit");
defsymbol (&Qautoload, "autoload");
defsymbol (&Qdebug_on_error, "debug-on-error");
}
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;
+#ifdef DEFEND_AGAINST_THROW_RECURSION
+ 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.
*/ );
*/ );
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;
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 ();
}