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&gt; + * 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&gt; + * 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) ||