debugger: eval frames.

We introduce evaluation tracking frames. The backtrace
function can use these to deduce the line from which
a function is called (if called from interpreted code).
Eventually we will have analogous virtual machine
frames to do this for compiled code.

* eval.c (do_eval): If backtraces are enabled, then push
and pop an eval frame, which holds the two key pieces: the
form and environment.

* share/txr/stdlib/debug.tl ((fcall-frame loc), (fcall-frame
print-trace), (eval-frame loc), (eval-frame print-trace)):
New methods.
(print-backtrace): Loop reduced to just dispatching
frame-specific print-trace methods. It gives the previous and
next frame to each method.
The (fcall-frame print-trace) method prints function frames,
using the previous form to deduce the location from which
the function is called. The (eval-frame print-trace) method
mostly suppresses the printing of eval frames. We print
an eval frame if it is the parent of an internal function
frame, and if it is the topmost frame (to identify the
toplevel form at the root of the backtrace).

* unwind.c (form_s): New symbol variable.
(eval_frame_type): New static variable.
(uw_find_frames_by_mask): Handle UW_EVAL case, producing
eval-frame struct.
(uw_push_eval): New function.
(uw_late_init): Allocate eval-frame struct type, storing it in
eval_frame_type, and gc-protect that new variable.
Register uw-eval variable evaluating to a one bit mask
with the UW_EVAL-th bit set.

* unwind.h (enum uw_frtype): New enum constant UW_EVAL.
(struct uw_eval): New struct type.
(union uw_frame): New member, el.
(uw_push_eval): Declared.

1 files changed, 24 insertions, 14 deletions

diff --git a/eval.c b/eval.c
index bf575c9c..df6b23e1 100644
--- a/eval.c
+++ b/eval.c
@@ -1497,19 +1497,27 @@ val eval_intrinsic_noerr(val form, val env, val *error_p)
 static val do_eval(val form, val env, val ctx,
                    val (*lookup)(val env, val sym))
 {
+  uw_frame_t *ev = 0;
+  val ret = nil;
+
+  if (dbg_backtrace) {
+    ev = coerce(uw_frame_t *, alloca(sizeof *ev));
+    uw_push_eval(ev, form, env);
+  }
+
   sig_check_fast();
 
-  if (nilp(form)) {
-    return nil;
-  } else if (symbolp(form)) {
+  if (form && symbolp(form)) {
     if (!bindable(form)) {
-      return form;
+      ret = form;
     } else {
       val binding = lookup(env, form);
-      if (binding)
-        return cdr(binding);
-      eval_error(ctx, lit("unbound variable ~s"), form, nao);
-      abort();
+      if (binding) {
+        ret = cdr(binding);
+      } else {
+        eval_error(ctx, lit("unbound variable ~s"), form, nao);
+        abort();
+      }
     }
   } else if (consp(form)) {
     val oper = car(form);
@@ -1517,11 +1525,10 @@ static val do_eval(val form, val env, val ctx,
 
     if (entry) {
       opfun_t fp = coerce(opfun_t, cptr_get(entry));
-      val ret, lfe_save = last_form_evaled;
+      val lfe_save = last_form_evaled;
       last_form_evaled = form;
       ret = fp(form, env);
       last_form_evaled = lfe_save;
-      return ret;
     } else {
       val fbinding = lookup_fun(env, oper);
 
@@ -1536,7 +1543,7 @@ static val do_eval(val form, val env, val ctx,
         val arglist = rest(form);
         cnum alen = if3(consp(arglist), c_num(length(arglist)), 0);
         cnum argc = max(alen, ARGS_MIN);
-        val ret, lfe_save = last_form_evaled;
+        val lfe_save = last_form_evaled;
         args_decl(args, argc);
 
         last_form_evaled = form;
@@ -1545,13 +1552,16 @@ static val do_eval(val form, val env, val ctx,
         ret = generic_funcall(cdr(fbinding), args);
 
         last_form_evaled = lfe_save;
-
-        return ret;
       }
     }
   } else {
-    return form;
+    ret = form;
   }
+
+  if (ev != 0)
+    uw_pop_frame(ev);
+
+  return ret;
 }
 
 val eval(val form, val env, val ctx)