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);
}
static const struct lrecord_description subr_description[] = {
- { XD_DOC_STRING, offsetof(Lisp_Subr, doc) },
+ { XD_DOC_STRING, offsetof (Lisp_Subr, doc) },
{ XD_END }
};
DEFINE_BASIC_LRECORD_IMPLEMENTATION ("subr", subr,
- this_one_is_unmarkable, print_subr, 0, 0, 0,
+ 0, print_subr, 0, 0, 0,
subr_description,
Lisp_Subr);
\f
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)
{
/* Attempt to avoid consing identical (string=) pure strings. */
file = Fsymbol_name (Fintern (file, Qnil));
}
-
+
return Ffset (function, Fcons (Qautoload, list4 (file,
docstring,
interactive,
/************************************************************************/
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
else
{
wrong_number_of_arguments:
- val = signal_wrong_number_of_arguments_error (fun, nargs);
+ val = signal_wrong_number_of_arguments_error (original_fun, nargs);
}
}
else if (COMPILED_FUNCTIONP (fun))
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();
}
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;
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)
{
}
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;
}
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();
}
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();
{
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;
{
/* 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");
/* XEmacs change: increase these values. */
max_specpdl_size = 3000;
max_lisp_eval_depth = 500;
-#if 0 /* no longer used */
+#ifdef DEFEND_AGAINST_THROW_RECURSION
throw_level = 0;
#endif
}
projects / chise / xemacs-chise.git.1 / blobdiff