Mercurial > hg > xemacs-beta

comparison src/eval.c @ 2532:989a7680c221

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[xemacs-hg @ 2005-01-29 09:15:55 by ben] 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.
author ben
date Sat, 29 Jan 2005 09:16:00 +0000
parents 3d8143fc88e1
children 9f70af3ac939
comparison
equal deleted inserted replaced
2531:7de8d9ab7bbd 2532:989a7680c221
402 /* Used for error catching purposes by throw_or_bomb_out */ 402 /* Used for error catching purposes by throw_or_bomb_out */
403 static int throw_level; 403 static int throw_level;
404 #endif 404 #endif
405 405
406 static int warning_will_be_discarded (Lisp_Object level); 406 static int warning_will_be_discarded (Lisp_Object level);
407 static Lisp_Object maybe_get_trapping_problems_backtrace (void);
407 408
408 409
409 /************************************************************************/ 410 /************************************************************************/
410 /* The subr object type */ 411 /* The subr object type */
411 /************************************************************************/ 412 /************************************************************************/
524 max_lisp_eval_depth = lisp_eval_depth + 20; 525 max_lisp_eval_depth = lisp_eval_depth + 20;
525 if (specpdl_size + 40 > max_specpdl_size) 526 if (specpdl_size + 40 > max_specpdl_size)
526 max_specpdl_size = specpdl_size + 40; 527 max_specpdl_size = specpdl_size + 40;
527 528
528 speccount = internal_bind_int (&entering_debugger, 1); 529 speccount = internal_bind_int (&entering_debugger, 1);
529 val = internal_catch (Qdebugger, call_debugger_259, arg, &threw, 0); 530 val = internal_catch (Qdebugger, call_debugger_259, arg, &threw, 0, 0);
530 531
531 return unbind_to_1 (speccount, ((threw) 532 return unbind_to_1 (speccount, ((threw)
532 ? Qunbound /* Not returning a value */ 533 ? Qunbound /* Not returning a value */
533 : val)); 534 : val));
534 } 535 }
1478 (args)) 1479 (args))
1479 { 1480 {
1480 /* This function can GC */ 1481 /* This function can GC */
1481 Lisp_Object tag = Feval (XCAR (args)); 1482 Lisp_Object tag = Feval (XCAR (args));
1482 Lisp_Object body = XCDR (args); 1483 Lisp_Object body = XCDR (args);
1483 return internal_catch (tag, Fprogn, body, 0, 0); 1484 return internal_catch (tag, Fprogn, body, 0, 0, 0);
1484 } 1485 }
1485 1486
1486 /* Set up a catch, then call C function FUNC on argument ARG. 1487 /* Set up a catch, then call C function FUNC on argument ARG.
1487 FUNC should return a Lisp_Object. 1488 FUNC should return a Lisp_Object.
1488 This is how catches are done from within C code. */ 1489 This is how catches are done from within C code. */
1490 Lisp_Object 1491 Lisp_Object
1491 internal_catch (Lisp_Object tag, 1492 internal_catch (Lisp_Object tag,
1492 Lisp_Object (*func) (Lisp_Object arg), 1493 Lisp_Object (*func) (Lisp_Object arg),
1493 Lisp_Object arg, 1494 Lisp_Object arg,
1494 int * volatile threw, 1495 int * volatile threw,
1495 Lisp_Object * volatile thrown_tag) 1496 Lisp_Object * volatile thrown_tag,
1497 Lisp_Object * volatile backtrace_before_throw)
1496 { 1498 {
1497 /* This structure is made part of the chain `catchlist'. */ 1499 /* This structure is made part of the chain `catchlist'. */
1498 struct catchtag c; 1500 struct catchtag c;
1499 1501
1500 /* Fill in the components of c, and put it on the list. */ 1502 /* Fill in the components of c, and put it on the list. */
1501 c.next = catchlist; 1503 c.next = catchlist;
1502 c.tag = tag; 1504 c.tag = tag;
1503 c.actual_tag = Qnil; 1505 c.actual_tag = Qnil;
1506 c.backtrace = Qnil;
1504 c.val = Qnil; 1507 c.val = Qnil;
1505 c.backlist = backtrace_list; 1508 c.backlist = backtrace_list;
1506 #if 0 /* FSFmacs */ 1509 #if 0 /* FSFmacs */
1507 /* #### */ 1510 /* #### */
1508 c.handlerlist = handlerlist; 1511 c.handlerlist = handlerlist;
1519 if (SETJMP (c.jmp)) 1522 if (SETJMP (c.jmp))
1520 { 1523 {
1521 /* Throw works by a longjmp that comes right here. */ 1524 /* Throw works by a longjmp that comes right here. */
1522 if (threw) *threw = 1; 1525 if (threw) *threw = 1;
1523 if (thrown_tag) *thrown_tag = c.actual_tag; 1526 if (thrown_tag) *thrown_tag = c.actual_tag;
1527 if (backtrace_before_throw) *backtrace_before_throw = c.backtrace;
1524 return c.val; 1528 return c.val;
1525 } 1529 }
1526 c.val = (*func) (arg); 1530 c.val = (*func) (arg);
1527 if (threw) *threw = 0; 1531 if (threw) *threw = 0;
1528 if (thrown_tag) *thrown_tag = Qnil; 1532 if (thrown_tag) *thrown_tag = Qnil;
1675 #if 0 /* FSFmacs */ 1679 #if 0 /* FSFmacs */
1676 if (!NILP (tag)) /* #### */ 1680 if (!NILP (tag)) /* #### */
1677 #endif 1681 #endif
1678 for (c = catchlist; c; c = c->next) 1682 for (c = catchlist; c; c = c->next)
1679 { 1683 {
1684 if (EQ (c->tag, Vcatch_everything_tag))
1685 c->backtrace = maybe_get_trapping_problems_backtrace ();
1680 if (EQ (c->tag, tag) || EQ (c->tag, Vcatch_everything_tag)) 1686 if (EQ (c->tag, tag) || EQ (c->tag, Vcatch_everything_tag))
1681 unwind_to_catch (c, val, tag); 1687 unwind_to_catch (c, val, tag);
1682 } 1688 }
1683 if (!bomb_out_p) 1689 if (!bomb_out_p)
1684 tag = Fsignal (Qno_catch, list2 (tag, val)); 1690 tag = Fsignal (Qno_catch, list2 (tag, val));
1879 c.tag = noseeum_cons (noseeum_cons (Qunbound, handlers), 1885 c.tag = noseeum_cons (noseeum_cons (Qunbound, handlers),
1880 Vcondition_handlers); 1886 Vcondition_handlers);
1881 #endif 1887 #endif
1882 c.val = Qnil; 1888 c.val = Qnil;
1883 c.actual_tag = Qnil; 1889 c.actual_tag = Qnil;
1890 c.backtrace = Qnil;
1884 c.backlist = backtrace_list; 1891 c.backlist = backtrace_list;
1885 #if 0 /* FSFmacs */ 1892 #if 0 /* FSFmacs */
1886 /* #### */ 1893 /* #### */
1887 c.handlerlist = handlerlist; 1894 c.handlerlist = handlerlist;
1888 #endif 1895 #endif
4811 const CIbyte *warning_string; 4818 const CIbyte *warning_string;
4812 Lisp_Object (*fun) (void *); 4819 Lisp_Object (*fun) (void *);
4813 void *arg; 4820 void *arg;
4814 }; 4821 };
4815 4822
4816 static DECLARE_DOESNT_RETURN_TYPE 4823 static Lisp_Object
4817 (Lisp_Object, flagged_a_squirmer (Lisp_Object, Lisp_Object, Lisp_Object)); 4824 maybe_get_trapping_problems_backtrace (void)
4818 4825 {
4819 static DOESNT_RETURN_TYPE (Lisp_Object) 4826 Lisp_Object backtrace;
4820 flagged_a_squirmer (Lisp_Object error_conditions, Lisp_Object data,
4821 Lisp_Object opaque)
4822 {
4823 struct call_trapping_problems *p =
4824 (struct call_trapping_problems *) get_opaque_ptr (opaque);
4825 4827
4826 if (!(inhibit_flags & INHIBIT_WARNING_ISSUE) 4828 if (!(inhibit_flags & INHIBIT_WARNING_ISSUE)
4827 && !warning_will_be_discarded (current_warning_level ()) 4829 && !warning_will_be_discarded (current_warning_level ()))
4828 && !EQ (error_conditions, Qquit))
4829 { 4830 {
4830 struct gcpro gcpro1; 4831 struct gcpro gcpro1;
4831 Lisp_Object lstream = Qnil; 4832 Lisp_Object lstream = Qnil;
4832 int speccount = specpdl_depth (); 4833 int speccount = specpdl_depth ();
4833 4834
4840 4841
4841 GCPRO1 (lstream); 4842 GCPRO1 (lstream);
4842 lstream = make_resizing_buffer_output_stream (); 4843 lstream = make_resizing_buffer_output_stream ();
4843 Fbacktrace (lstream, Qt); 4844 Fbacktrace (lstream, Qt);
4844 Lstream_flush (XLSTREAM (lstream)); 4845 Lstream_flush (XLSTREAM (lstream));
4845 p->backtrace = resizing_buffer_to_lisp_string (XLSTREAM (lstream)); 4846 backtrace = resizing_buffer_to_lisp_string (XLSTREAM (lstream));
4846 Lstream_delete (XLSTREAM (lstream)); 4847 Lstream_delete (XLSTREAM (lstream));
4847 UNGCPRO; 4848 UNGCPRO;
4848 4849
4849 unbind_to (speccount); 4850 unbind_to (speccount);
4850 } 4851 }
4851 else 4852 else
4853 backtrace = Qnil;
4854
4855 return backtrace;
4856 }
4857
4858 static DECLARE_DOESNT_RETURN_TYPE
4859 (Lisp_Object, flagged_a_squirmer (Lisp_Object, Lisp_Object, Lisp_Object));
4860
4861 static DOESNT_RETURN_TYPE (Lisp_Object)
4862 flagged_a_squirmer (Lisp_Object error_conditions, Lisp_Object data,
4863 Lisp_Object opaque)
4864 {
4865 struct call_trapping_problems *p =
4866 (struct call_trapping_problems *) get_opaque_ptr (opaque);
4867
4868 if (!EQ (error_conditions, Qquit))
4869 p->backtrace = maybe_get_trapping_problems_backtrace ();
4870 else
4852 p->backtrace = Qnil; 4871 p->backtrace = Qnil;
4853
4854 p->error_conditions = error_conditions; 4872 p->error_conditions = error_conditions;
4855 p->data = data; 4873 p->data = data;
4856 4874
4857 Fthrow (p->catchtag, Qnil); 4875 Fthrow (p->catchtag, Qnil);
4858 RETURN_NOT_REACHED (Qnil); 4876 RETURN_NOT_REACHED (Qnil);
4889 4907
4890 if (p->caught_throw) 4908 if (p->caught_throw)
4891 { 4909 {
4892 Lisp_Object errstr = 4910 Lisp_Object errstr =
4893 emacs_sprintf_string_lisp 4911 emacs_sprintf_string_lisp
4894 ("%s: Attempt to throw outside of function " 4912 ("%s: Attempt to throw outside of function:"
4895 "to catch `%s' with value `%s'", 4913 "To catch `%s' with value `%s'\n\nBacktrace follows:\n\n%s",
4896 Qnil, 3, 4914 Qnil, 3,
4897 build_msg_string (warning_string ? warning_string : "error"), 4915 build_msg_string (warning_string ? warning_string : "error"),
4898 p->thrown_tag, p->thrown_value); 4916 p->thrown_tag, p->thrown_value, p->backtrace);
4899 warn_when_safe_lispobj (Qerror, current_warning_level (), errstr); 4917 warn_when_safe_lispobj (Qerror, current_warning_level (), errstr);
4900 } 4918 }
4901 else if (p->caught_error && !EQ (p->error_conditions, Qquit)) 4919 else if (p->caught_error && !EQ (p->error_conditions, Qquit))
4902 { 4920 {
4903 Lisp_Object errstr; 4921 Lisp_Object errstr;
5107 { 5125 {
5108 int speccount = specpdl_depth (); 5126 int speccount = specpdl_depth ();
5109 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5; 5127 struct gcpro gcpro1, gcpro2, gcpro3, gcpro4, gcpro5;
5110 struct call_trapping_problems package; 5128 struct call_trapping_problems package;
5111 struct call_trapping_problems_result real_problem; 5129 struct call_trapping_problems_result real_problem;
5112 Lisp_Object opaque, thrown_tag, tem; 5130 Lisp_Object opaque, thrown_tag, tem, thrown_backtrace;
5113 int thrown = 0; 5131 int thrown = 0;
5114 5132
5115 assert (SYMBOLP (warning_class)); /* sanity-check */ 5133 assert (SYMBOLP (warning_class)); /* sanity-check */
5116 assert (!NILP (warning_class)); 5134 assert (!NILP (warning_class));
5117 5135
5142 if (flags & INTERNAL_INHIBIT_ERRORS) 5160 if (flags & INTERNAL_INHIBIT_ERRORS)
5143 /* We need a catch so that our condition-handler can throw back here 5161 /* We need a catch so that our condition-handler can throw back here
5144 after printing the warning. (We print the warning in the stack 5162 after printing the warning. (We print the warning in the stack
5145 context of the error, so we can get a backtrace.) */ 5163 context of the error, so we can get a backtrace.) */
5146 tem = internal_catch (package.catchtag, call_trapping_problems_1, opaque, 5164 tem = internal_catch (package.catchtag, call_trapping_problems_1, opaque,
5147 &thrown, &thrown_tag); 5165 &thrown, &thrown_tag, &thrown_backtrace);
5148 else if (flags & INTERNAL_INHIBIT_THROWS) 5166 else if (flags & INTERNAL_INHIBIT_THROWS)
5149 /* We skip over the first wrapper, which traps errors. */ 5167 /* We skip over the first wrapper, which traps errors. */
5150 tem = internal_catch (package.catchtag, call_trapping_problems_2, opaque, 5168 tem = internal_catch (package.catchtag, call_trapping_problems_2, opaque,
5151 &thrown, &thrown_tag); 5169 &thrown, &thrown_tag, &thrown_backtrace);
5152 else 5170 else
5153 /* Nothing special. */ 5171 /* Nothing special. */
5154 tem = (fun) (arg); 5172 tem = (fun) (arg);
5155 5173
5156 if (!problem) 5174 if (!problem)
5180 { 5198 {
5181 problem->caught_error = 0; 5199 problem->caught_error = 0;
5182 problem->caught_throw = 1; 5200 problem->caught_throw = 1;
5183 problem->error_conditions = Qnil; 5201 problem->error_conditions = Qnil;
5184 problem->data = Qnil; 5202 problem->data = Qnil;
5185 problem->backtrace = Qnil; 5203 problem->backtrace = thrown_backtrace;
5186 problem->thrown_tag = thrown_tag; 5204 problem->thrown_tag = thrown_tag;
5187 problem->thrown_value = tem; 5205 problem->thrown_value = tem;
5188 } 5206 }
5189 5207
5190 if (!(flags & INHIBIT_WARNING_ISSUE) && !(flags & POSTPONE_WARNING_ISSUE)) 5208 if (!(flags & INHIBIT_WARNING_ISSUE) && !(flags & POSTPONE_WARNING_ISSUE))