9:16 a.m.
User: ben
Date: 05/01/29 10:16:14
Modified: xemacs/src ChangeLog alloc.c backtrace.h bytecode.c
cmdloop.c eval.c lisp.h macros.c
Log:
Add backtrace when throwing past call_trapping_problems()
alloc.c, backtrace.h, bytecode.c, cmdloop.c, eval.c, lisp.h, macros.c: Also include a
backtrace when we catch an attempt to throw outside
of a function where call_trapping_problems() has been used.
Revision Changes Path
1.781 +24 -0 XEmacs/xemacs/src/ChangeLog
(In the diff below, changes in quantity of whitespace are not shown.)
Index: ChangeLog
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/ChangeLog,v
retrieving revision 1.780
retrieving revision 1.781
diff -u -b -r1.780 -r1.781
--- ChangeLog 2005/01/29 09:06:37 1.780
+++ ChangeLog 2005/01/29 09:15:55 1.781
＠＠ -1,5 +1,29 ＠＠
2005-01-29 Ben Wing <ben(a)xemacs.org>
+ * alloc.c (garbage_collect_1):
+ * backtrace.h:
+ * bytecode.c (execute_rare_opcode):
+ * cmdloop.c:
+ * cmdloop.c (initial_command_loop):
+ * cmdloop.c (Frecursive_edit):
+ * cmdloop.c (call_command_loop):
+ * eval.c:
+ * eval.c (call_debugger):
+ * eval.c (Fcatch):
+ * eval.c (internal_catch):
+ * eval.c (throw_or_bomb_out):
+ * eval.c (condition_case_1):
+ * eval.c (maybe_get_trapping_problems_backtrace):
+ * eval.c (flagged_a_squirmer):
+ * eval.c (issue_call_trapping_problems_warning):
+ * eval.c (call_trapping_problems):
+ * lisp.h:
+ * macros.c (Fexecute_kbd_macro):
+ Also include a backtrace when we catch an attempt to throw outside
+ of a function where call_trapping_problems() has been used.
+
+2005-01-29 Ben Wing <ben(a)xemacs.org>
+
* file-coding.c (snarf_coding_system):
Use UExtbyte for semantic correctness.
* file-coding.c (look_for_coding_system_magic_cookie):
1.105 +1 -0 XEmacs/xemacs/src/alloc.c
(In the diff below, changes in quantity of whitespace are not shown.)
Index: alloc.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/alloc.c,v
retrieving revision 1.104
retrieving revision 1.105
diff -u -b -r1.104 -r1.105
--- alloc.c 2005/01/24 23:33:46 1.104
+++ alloc.c 2005/01/29 09:15:58 1.105
＠＠ -4775,6 +4775,7 ＠＠
mark_object (catch->tag);
mark_object (catch->val);
mark_object (catch->actual_tag);
+ mark_object (catch->backtrace);
}
}
1.11 +2 -0 XEmacs/xemacs/src/backtrace.h
(In the diff below, changes in quantity of whitespace are not shown.)
Index: backtrace.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/backtrace.h,v
retrieving revision 1.10
retrieving revision 1.11
diff -u -b -r1.10 -r1.11
--- backtrace.h 2003/02/13 09:57:05 1.10
+++ backtrace.h 2005/01/29 09:15:58 1.11
＠＠ -141,6 +141,8 ＠＠
/* Stores the actual tag used in `throw'; the same as TAG, unless
TAG is Vcatch_everything_tag. */
Lisp_Object actual_tag;
+ /* A backtrace prior to the throw, used with Vcatch_everything_tag. */
+ Lisp_Object backtrace;
Lisp_Object val;
struct catchtag *next;
struct gcpro *gcpro;
1.45 +1 -1 XEmacs/xemacs/src/bytecode.c
(In the diff below, changes in quantity of whitespace are not shown.)
Index: bytecode.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/bytecode.c,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -b -r1.44 -r1.45
--- bytecode.c 2005/01/24 23:33:47 1.44
+++ bytecode.c 2005/01/29 09:15:59 1.45
＠＠ -1377,7 +1377,7 ＠＠
case Bcatch:
{
Lisp_Object arg = POP;
- TOP = internal_catch (TOP, Feval, arg, 0, 0);
+ TOP = internal_catch (TOP, Feval, arg, 0, 0, 0);
break;
}
1.23 +5 -6 XEmacs/xemacs/src/cmdloop.c
(In the diff below, changes in quantity of whitespace are not shown.)
Index: cmdloop.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/cmdloop.c,v
retrieving revision 1.22
retrieving revision 1.23
diff -u -b -r1.22 -r1.23
--- cmdloop.c 2004/09/20 19:19:35 1.22
+++ cmdloop.c 2005/01/29 09:15:59 1.23
＠＠ -1,6 +1,6 ＠＠
/* Editor command loop.
Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
- Copyright (C) 1995, 1996, 2001, 2002 Ben Wing.
+ Copyright (C) 1995, 1996, 2001, 2002, 2003 Ben Wing.
This file is part of XEmacs.
＠＠ -290,7 +290,7 ＠＠
Otherwise, this function will return normally when all command-
line arguments have been processed, the user's initialization
file has been read in, and the first frame has been created. */
- internal_catch (Qtop_level, top_level_1, Qnil, 0, 0);
+ internal_catch (Qtop_level, top_level_1, Qnil, 0, 0, 0);
/* If an error occurred during startup and the initial console
wasn't created, then die now (the error was already printed out
＠＠ -310,7 +310,7 ＠＠
MARK_MODELINE_CHANGED;
/* Now invoke the command loop. It never returns; however, a
throw to 'top-level will place us at the end of this loop. */
- internal_catch (Qtop_level, command_loop_2, Qnil, 0, 0);
+ internal_catch (Qtop_level, command_loop_2, Qnil, 0, 0, 0);
/* #### wrong with selected-console? */
/* We don't actually call clear_echo_area() here, partially
at least because that runs Lisp code and it may be unsafe
＠＠ -373,7 +373,7 ＠＠
specbind (Qstandard_output, Qt);
specbind (Qstandard_input, Qt);
- val = internal_catch (Qexit, command_loop_2, Qnil, 0, 0);
+ val = internal_catch (Qexit, command_loop_2, Qnil, 0, 0, 0);
if (EQ (val, Qt))
/* Turn abort-recursive-edit into a quit. */
＠＠ -440,8 +440,7 ＠＠
if (NILP (catch_errors))
Fcommand_loop_1 ();
else
- internal_catch (Qtop_level,
- cold_load_command_loop, Qnil, 0, 0);
+ internal_catch (Qtop_level, cold_load_command_loop, Qnil, 0, 0, 0);
goto loop;
RETURN_NOT_REACHED (Qnil);
}
1.86 +40 -22 XEmacs/xemacs/src/eval.c
(In the diff below, changes in quantity of whitespace are not shown.)
Index: eval.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/eval.c,v
retrieving revision 1.85
retrieving revision 1.86
diff -u -b -r1.85 -r1.86
--- eval.c 2005/01/24 23:33:51 1.85
+++ eval.c 2005/01/29 09:15:59 1.86
＠＠ -404,6 +404,7 ＠＠
#endif
static int warning_will_be_discarded (Lisp_Object level);
+static Lisp_Object maybe_get_trapping_problems_backtrace (void);
/************************************************************************/
＠＠ -526,7 +527,7 ＠＠
max_specpdl_size = specpdl_size + 40;
speccount = internal_bind_int (&entering_debugger, 1);
- val = internal_catch (Qdebugger, call_debugger_259, arg, &threw, 0);
+ val = internal_catch (Qdebugger, call_debugger_259, arg, &threw, 0, 0);
return unbind_to_1 (speccount, ((threw)
? Qunbound /* Not returning a value */
＠＠ -1480,7 +1481,7 ＠＠
/* This function can GC */
Lisp_Object tag = Feval (XCAR (args));
Lisp_Object body = XCDR (args);
- return internal_catch (tag, Fprogn, body, 0, 0);
+ return internal_catch (tag, Fprogn, body, 0, 0, 0);
}
/* Set up a catch, then call C function FUNC on argument ARG.
＠＠ -1492,7 +1493,8 ＠＠
Lisp_Object (*func) (Lisp_Object arg),
Lisp_Object arg,
int * volatile threw,
- Lisp_Object * volatile thrown_tag)
+ Lisp_Object * volatile thrown_tag,
+ Lisp_Object * volatile backtrace_before_throw)
{
/* This structure is made part of the chain `catchlist'. */
struct catchtag c;
＠＠ -1501,6 +1503,7 ＠＠
c.next = catchlist;
c.tag = tag;
c.actual_tag = Qnil;
+ c.backtrace = Qnil;
c.val = Qnil;
c.backlist = backtrace_list;
#if 0 /* FSFmacs */
＠＠ -1521,6 +1524,7 ＠＠
/* Throw works by a longjmp that comes right here. */
if (threw) *threw = 1;
if (thrown_tag) *thrown_tag = c.actual_tag;
+ if (backtrace_before_throw) *backtrace_before_throw = c.backtrace;
return c.val;
}
c.val = (*func) (arg);
＠＠ -1677,6 +1681,8 ＠＠
#endif
for (c = catchlist; c; c = c->next)
{
+ if (EQ (c->tag, Vcatch_everything_tag))
+ c->backtrace = maybe_get_trapping_problems_backtrace ();
if (EQ (c->tag, tag) || EQ (c->tag, Vcatch_everything_tag))
unwind_to_catch (c, val, tag);
}
＠＠ -1881,6 +1887,7 ＠＠
#endif
c.val = Qnil;
c.actual_tag = Qnil;
+ c.backtrace = Qnil;
c.backlist = backtrace_list;
#if 0 /* FSFmacs */
/* #### */
＠＠ -4813,19 +4820,13 ＠＠
void *arg;
};
-static DECLARE_DOESNT_RETURN_TYPE
- (Lisp_Object, flagged_a_squirmer (Lisp_Object, Lisp_Object, Lisp_Object));
-
-static DOESNT_RETURN_TYPE (Lisp_Object)
-flagged_a_squirmer (Lisp_Object error_conditions, Lisp_Object data,
- Lisp_Object opaque)
+static Lisp_Object
+maybe_get_trapping_problems_backtrace (void)
{
- struct call_trapping_problems *p =
- (struct call_trapping_problems *) get_opaque_ptr (opaque);
+ Lisp_Object backtrace;
if (!(inhibit_flags & INHIBIT_WARNING_ISSUE)
- && !warning_will_be_discarded (current_warning_level ())
- && !EQ (error_conditions, Qquit))
+ && !warning_will_be_discarded (current_warning_level ()))
{
struct gcpro gcpro1;
Lisp_Object lstream = Qnil;
＠＠ -4842,15 +4843,32 ＠＠
lstream = make_resizing_buffer_output_stream ();
Fbacktrace (lstream, Qt);
Lstream_flush (XLSTREAM (lstream));
- p->backtrace = resizing_buffer_to_lisp_string (XLSTREAM (lstream));
+ backtrace = resizing_buffer_to_lisp_string (XLSTREAM (lstream));
Lstream_delete (XLSTREAM (lstream));
UNGCPRO;
unbind_to (speccount);
}
else
- p->backtrace = Qnil;
+ backtrace = Qnil;
+
+ return backtrace;
+}
+static DECLARE_DOESNT_RETURN_TYPE
+ (Lisp_Object, flagged_a_squirmer (Lisp_Object, Lisp_Object, Lisp_Object));
+
+static DOESNT_RETURN_TYPE (Lisp_Object)
+flagged_a_squirmer (Lisp_Object error_conditions, Lisp_Object data,
+ Lisp_Object opaque)
+{
+ struct call_trapping_problems *p =
+ (struct call_trapping_problems *) get_opaque_ptr (opaque);
+
+ if (!EQ (error_conditions, Qquit))
+ p->backtrace = maybe_get_trapping_problems_backtrace ();
+ else
+ p->backtrace = Qnil;
p->error_conditions = error_conditions;
p->data = data;
＠＠ -4891,11 +4909,11 ＠＠
{
Lisp_Object errstr =
emacs_sprintf_string_lisp
- ("%s: Attempt to throw outside of function "
- "to catch `%s' with value `%s'",
+ ("%s: Attempt to throw outside of function:"
+ "To catch `%s' with value `%s'\n\nBacktrace follows:\n\n%s",
Qnil, 3,
build_msg_string (warning_string ? warning_string : "error"),
- p->thrown_tag, p->thrown_value);
+ p->thrown_tag, p->thrown_value, p->backtrace);
warn_when_safe_lispobj (Qerror, current_warning_level (), errstr);
}
else if (p->caught_error && !EQ (p->error_conditions, Qquit))
＠＠ -5109,7 +5127,7 ＠＠
struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
struct call_trapping_problems package;
struct call_trapping_problems_result real_problem;
- Lisp_Object opaque, thrown_tag, tem;
+ Lisp_Object opaque, thrown_tag, tem, thrown_backtrace;
int thrown = 0;
assert (SYMBOLP (warning_class)); /* sanity-check */
＠＠ -5144,11 +5162,11 ＠＠
after printing the warning. (We print the warning in the stack
context of the error, so we can get a backtrace.) */
tem = internal_catch (package.catchtag, call_trapping_problems_1, opaque,
- &thrown, &thrown_tag);
+ &thrown, &thrown_tag, &thrown_backtrace);
else if (flags & INTERNAL_INHIBIT_THROWS)
/* We skip over the first wrapper, which traps errors. */
tem = internal_catch (package.catchtag, call_trapping_problems_2, opaque,
- &thrown, &thrown_tag);
+ &thrown, &thrown_tag, &thrown_backtrace);
else
/* Nothing special. */
tem = (fun) (arg);
＠＠ -5182,7 +5200,7 ＠＠
problem->caught_throw = 1;
problem->error_conditions = Qnil;
problem->data = Qnil;
- problem->backtrace = Qnil;
+ problem->backtrace = thrown_backtrace;
problem->thrown_tag = thrown_tag;
problem->thrown_value = tem;
}
1.121 +1 -0 XEmacs/xemacs/src/lisp.h
(In the diff below, changes in quantity of whitespace are not shown.)
Index: lisp.h
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/lisp.h,v
retrieving revision 1.120
retrieving revision 1.121
diff -u -b -r1.120 -r1.121
--- lisp.h 2005/01/28 02:36:25 1.120
+++ lisp.h 2005/01/29 09:15:59 1.121
＠＠ -4158,6 +4158,7 ＠＠
int proper_redisplay_wrapping_in_place (void);
Lisp_Object internal_catch (Lisp_Object, Lisp_Object (*) (Lisp_Object),
Lisp_Object, int * volatile,
+ Lisp_Object * volatile,
Lisp_Object * volatile);
Lisp_Object condition_case_1 (Lisp_Object,
Lisp_Object (*) (Lisp_Object),
1.14 +1 -1 XEmacs/xemacs/src/macros.c
(In the diff below, changes in quantity of whitespace are not shown.)
Index: macros.c
===================================================================
RCS file: /pack/xemacscvs/XEmacs/xemacs/src/macros.c,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -b -r1.13 -r1.14
--- macros.c 2005/01/24 23:34:03 1.13
+++ macros.c 2005/01/29 09:16:00 1.14
＠＠ -278,7 +278,7 ＠＠
executing_macro_index = 0;
con->prefix_arg = Qnil;
internal_catch (Qexecute_kbd_macro, call_command_loop,
- Qnil, 0, 0);
+ Qnil, 0, 0, 0);
}
while (--repeat != 0
&& (STRINGP (Vexecuting_macro) ||