In the spirit of the previous hack, here is another hack to

alleviate a long-standing pain: when an exception happens in
TXR's library somewhere, the program dies without leaving
a clue about what code was being evaluated when that happened.
What we can do is have the evaluator publish the most recent
compound form it has processed by stashing it in a variable.
Then when an unhandled exception occurs, we can peek at that
and try to pull out source location info.

* eval.c (last_form_evaled): New variable.
(do_eval): When evaluating a compound form, stash it in
last_form_evaled.
(eval_init): Protect last_form_evaled from gc.

* eval.h (last_form_evaled): Declared.
(eval_error_s): Existing variable declared.

* unwind.c: Has to include "eval.h" for the above variable
and "parser.h" for the source_loc function.
(uw_throw): When an exception is unhandled, if
last_form_evaled has source info, add it to the diagnostic.
But not if the exception is eval-error; because errors from
the evaluators already have the info.

4 files changed, 43 insertions, 1 deletions

diff --git a/ChangeLog b/ChangeLog
index 791936d3..a362c6c9 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,31 @@
 2014-02-16  Kaz Kylheku  <kaz@kylheku.com>
 
+	In the spirit of the previous hack, here is another hack to
+	alleviate a long-standing pain: when an exception happens in
+	TXR's library somewhere, the program dies without leaving
+	a clue about what code was being evaluated when that happened.
+	What we can do is have the evaluator publish the most recent
+	compound form it has processed by stashing it in a variable.
+	Then when an unhandled exception occurs, we can peek at that
+	and try to pull out source location info.
+
+	* eval.c (last_form_evaled): New variable.
+	(do_eval): When evaluating a compound form, stash it in
+	last_form_evaled.
+	(eval_init): Protect last_form_evaled from gc.
+
+	* eval.h (last_form_evaled): Declared.
+	(eval_error_s): Existing variable declared.
+
+	* unwind.c: Has to include "eval.h" for the above variable
+	and "parser.h" for the source_loc function.
+	(uw_throw): When an exception is unhandled, if 
+	last_form_evaled has source info, add it to the diagnostic.
+	But not if the exception is eval-error; because errors from
+	the evaluators already have the info.
+
+2014-02-16  Kaz Kylheku  <kaz@kylheku.com>
+
 	Nice idea: how about a function which walks the tree structure and
 	back-fills some missing source code location info.  We apply this to
 	macro expansions.  If some error occurs in expanded code, this way it
diff --git a/eval.c b/eval.c
index 0be885d3..5e9e2f5f 100644
--- a/eval.c
+++ b/eval.c
@@ -91,6 +91,8 @@ val macro_time_s;
 
 val whole_k, env_k;
 
+val last_form_evaled;
+
 val make_env(val vbindings, val fbindings, val up_env)
 {
   val env = make_obj();
@@ -717,6 +719,8 @@ static val do_eval(val form, val env, val ctx_form,
   } else if (consp(form)) {
     val oper = car(form);
 
+    last_form_evaled = form;
+
     if (regexp(oper))
       debug_return (oper);
 
@@ -2502,7 +2506,7 @@ static val and_fun(val vals)
 
 void eval_init(void)
 {
-  protect(&top_vb, &top_fb, &top_mb, &op_table, (val *) 0);
+  protect(&top_vb, &top_fb, &top_mb, &op_table, &last_form_evaled, (val *) 0);
   top_fb = make_hash(t, nil, nil);
   top_vb = make_hash(t, nil, nil);
   top_mb = make_hash(t, nil, nil);
diff --git a/eval.h b/eval.h
index 03bfea23..713f50b8 100644
--- a/eval.h
+++ b/eval.h
@@ -26,6 +26,8 @@
 
 extern val dwim_s, vector_lit_s, vector_list_s;
 extern val hash_lit_s, hash_construct_s;
+extern val eval_error_s;
+extern val last_form_evaled;
 
 val make_env(val fbindings, val vbindings, val up_env);
 val env_fbind(val env, val sym, val fun);
diff --git a/unwind.c b/unwind.c
index f447bb07..fc703fc3 100644
--- a/unwind.c
+++ b/unwind.c
@@ -38,6 +38,8 @@
 #include "stream.h"
 #include "txr.h"
 #include "signal.h"
+#include "eval.h"
+#include "parser.h"
 #include "unwind.h"
 
 static uw_frame_t *uw_stack;
@@ -275,10 +277,18 @@ val uw_throw(val sym, val exception)
 
     if (opt_loglevel >= 1) {
       val s = stringp(exception);
+      val info = if2(source_loc(last_form_evaled),
+                     source_loc_str(last_form_evaled));
       format(std_error, lit("~a: unhandled exception of type ~a:\n"),
              prog_string, sym, nao);
+
+      if (info && sym != eval_error_s)
+        format(std_error, lit("~a: possibly triggered by ~a\n"),
+               prog_string, info, nao);
+
       format(std_error, s ? lit("~a: ~a\n") : lit("~a: ~s\n"),
              prog_string, exception, nao);
+      
     }
     if (uw_exception_subtype_p(sym, query_error_s) ||
         uw_exception_subtype_p(sym, file_error_s)) {