Ligher weight debug instrumentation.

This speeds up the TXR Lisp interpreter, because do_eval
sets up a debug frame and uses debug_return.

* debug.c (debug_block_s): Symbol removed.
(debug_init): Remove initialization of debug_block_s.

* debug.h (debug_block_s): Declaration removed.
(debug_enter): Do not establish a named block or a catch block;
no time-wasting unwind stack manipulation at all.
The debug_depth variable is managed by the extended setjmp
context now.  Provide a return value variable, and a well-defined name to
branch to to exit from the debug block.
(debug_return): Do not use heavy-weight uw_block_return;
simply set the return variable and branch to debug_return_out
label.

* signal.h (EJ_DBG_MEMB, EJ_DBG_SAVE, EJ_DBG_REST,
EJ_OPT_MEMB, EJ_OPT_SAVE, EJ_OPT_REST): New macros.
(extended_jmp_buf): Define optional global state
variables using EJ_OPT_MEMB.
(extended_setjmp): Save and restore optional
globals using EJ_OPT_SAVE and EJ_OPT_RESTORE.
Now debug_depth is saved and restored if
debugging support is compiled in.

* match.c (open_data_source): Remove bogus debug_return
invocations which were uncovered here by changes to the macro.

* eval.c (do_eval, expand_macro): debug_return must now be after
debug_end, because it won't dynamically clean up frames that it doesn't
know about. The set_dyn_env is no longer unreachable in expand_macro;
it is now necessary because debug_return isn't doing the longjmp
that previously restored dyn_env.

6 files changed, 83 insertions, 26 deletions

diff --git a/ChangeLog b/ChangeLog
index 9791f74f..07bacd94 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,43 @@
 2015-05-22  Kaz Kylheku  <kaz@kylheku.com>
 
+	Ligher weight debug instrumentation.
+
+	This speeds up the TXR Lisp interpreter, because do_eval
+	sets up a debug frame and uses debug_return.
+
+	* debug.c (debug_block_s): Symbol removed.
+	(debug_init): Remove initialization of debug_block_s.
+
+	* debug.h (debug_block_s): Declaration removed.
+	(debug_enter): Do not establish a named block or a catch block;
+	no time-wasting unwind stack manipulation at all.
+	The debug_depth variable is managed by the extended setjmp
+	context now.  Provide a return value variable, and a well-defined name to
+	branch to to exit from the debug block.
+	(debug_return): Do not use heavy-weight uw_block_return;
+	simply set the return variable and branch to debug_return_out
+	label.
+
+	* signal.h (EJ_DBG_MEMB, EJ_DBG_SAVE, EJ_DBG_REST,
+	EJ_OPT_MEMB, EJ_OPT_SAVE, EJ_OPT_REST): New macros.
+	(extended_jmp_buf): Define optional global state
+	variables using EJ_OPT_MEMB.
+	(extended_setjmp): Save and restore optional
+	globals using EJ_OPT_SAVE and EJ_OPT_RESTORE.
+	Now debug_depth is saved and restored if
+	debugging support is compiled in.
+
+	* match.c (open_data_source): Remove bogus debug_return
+	invocations which were uncovered here by changes to the macro.
+
+	* eval.c (do_eval, expand_macro): debug_return must now be after
+	debug_end, because it won't dynamically clean up frames that it doesn't
+	know about. The set_dyn_env is no longer unreachable in expand_macro;
+	it is now necessary because debug_return isn't doing the longjmp
+	that previously restored dyn_env.
+
+2015-05-22  Kaz Kylheku  <kaz@kylheku.com>
+
 	* place.tl (pushnew): New macro.
 
 	* lisplib.c (set_place_dlt_entries): Add pushnew.
diff --git a/debug.c b/debug.c
index 677a9457..00117558 100644
--- a/debug.c
+++ b/debug.c
@@ -45,7 +45,6 @@
 
 int opt_debugger;
 int debug_depth;
-val debug_block_s;
 static int step_mode;
 static int next_depth = -1;
 static val breakpoints;
@@ -246,7 +245,6 @@ void debug_init(void)
 {
   step_mode = 1;
   protect(&breakpoints, &last_command, convert(val *, 0));
-  debug_block_s = intern(lit("debug-block"), system_package);
   {
     char *columns = getenv("COLUMNS");
     if (columns)
diff --git a/debug.h b/debug.h
index 88695866..c14a304c 100644
--- a/debug.h
+++ b/debug.h
@@ -26,30 +26,28 @@
 
 extern int opt_debugger;
 extern int debug_depth;
-extern val debug_block_s;
 
 val debug(val form, val bindings, val data, val line, val pos, val base);
 
 #if CONFIG_DEBUG_SUPPORT
 
-#define debug_enter                                     \
-  {                                                     \
-    int debug_depth_save = debug_depth++;               \
-    uw_block_begin(debug_block_s, debug_result);        \
-    uw_simple_catch_begin {
-
-#define debug_leave                                     \
-    }                                                   \
-    uw_unwind {                                         \
-      debug_depth = debug_depth_save;                   \
-    }                                                   \
-    uw_catch_end;                                       \
-    uw_block_end;                                       \
-    return debug_result;                                \
+#define debug_enter                             \
+  {                                             \
+    int debug_depth_save = debug_depth++;       \
+    val debug_result = nil;                     \
+    (void) 0
+
+#define debug_leave                             \
+  debug_return_out:                             \
+    debug_depth = debug_depth_save;             \
+    return debug_result;                        \
   }
 
-#define debug_return(VAL)                               \
-  uw_block_return(debug_block_s, VAL)
+#define debug_return(VAL)               \
+  do {                                  \
+    debug_result = VAL;                 \
+    goto debug_return_out;              \
+  } while (0)
 
 INLINE val debug_check(val form, val bindings, val data, val line,
                        val pos, val base)
diff --git a/eval.c b/eval.c
index 908a8b20..45962114 100644
--- a/eval.c
+++ b/eval.c
@@ -1057,8 +1057,8 @@ static val do_eval(val form, val env, val ctx_form,
         last_form_evaled = form;
         ret = apply(cdr(fbinding), z(args), form);
         last_form_evaled = lfe_save;
-        debug_return (ret);
         debug_end;
+        debug_return (ret);
       }
     }
   } else {
@@ -1461,10 +1461,12 @@ static val expand_macro(val form, val expander, val menv)
     val body = cdr(cdr(cdr(expander)));
     val saved_de = set_dyn_env(make_env(nil, nil, dyn_env));
     val exp_env = bind_macro_params(env, menv, params, args, nil, form);
+    val result;
     debug_frame(name, args, nil, env, nil, nil, nil);
-    debug_return(eval_progn(body, exp_env, body));
+    result = eval_progn(body, exp_env, body);
     debug_end;
-    set_dyn_env(saved_de); /* not reached but shuts up compiler */
+    set_dyn_env(saved_de);
+    debug_return(result);
     debug_leave;
   }
 }
diff --git a/match.c b/match.c
index e4e7b119..562e1dfd 100644
--- a/match.c
+++ b/match.c
@@ -3859,16 +3859,16 @@ static void open_data_source(match_files_ctx *c)
         debuglf(spec, lit("opening data source ~a"), name, nao);
 
         if (complex_open_failed(fp)) {
-          if (consp(source_spec) && car(source_spec) == nothrow_k) {
+          if (consp(source_spec) && car(source_spec) == nothrow_k)
             debuglf(spec, lit("could not open ~a: "
                               "treating as failed match due to nothrow"), name, nao);
-            debug_return (nil);
-          } else if (errno != 0)
+          else if (errno != 0)
             file_err(spec, lit("could not open ~a (error ~a/~a)"), name,
                      num(errno), string_utf8(strerror(errno)), nao);
           else
             file_err(spec, lit("could not open ~a"), name, nao);
-          debug_return (nil);
+          c->data = nil;
+          return;
         }
 
         c->files = cons(name, cdr(c->files)); /* Get rid of cons and nothrow */
diff --git a/signal.h b/signal.h
index 036475e7..4b942275 100644
--- a/signal.h
+++ b/signal.h
@@ -25,6 +25,21 @@
  */
 
 
+#if CONFIG_DEBUG_SUPPORT
+extern int debug_depth;
+#define EJ_DBG_MEMB int dbg_depth;
+#define EJ_DBG_SAVE(EJB) (EJB).dbg_depth = debug_depth,
+#define EJ_DBG_REST(EJB) debug_depth = (EJB).dbg_depth,
+#else
+#define EJ_DBG_MEMB
+#define EJ_DBG_SAVE(EJB)
+#define EJ_DBG_REST(EJB)
+#endif
+
+#define EJ_OPT_MEMB EJ_DBG_MEMB
+#define EJ_OPT_SAVE(EJB) EJ_DBG_SAVE(EJB)
+#define EJ_OPT_REST(EJB) EJ_DBG_REST(EJB)
+
 #if HAVE_POSIX_SIGS
 
 #define sig_save_enable                         \
@@ -62,6 +77,7 @@ typedef struct {
   val de;
   int gc;
   val **gc_pt;
+  EJ_OPT_MEMB
   int rv;
 } extended_jmp_buf;
 
@@ -72,12 +88,14 @@ typedef struct {
       gc_enabled = (EJB).gc,                    \
       gc_prot_top = (EJB).gc_pt,                \
       sig_mask(SIG_SETMASK, &(EJB).blocked, 0), \
+      EJ_OPT_REST(EJB)                          \
       (EJB).rv)                                 \
    : ((EJB).se = async_sig_enabled,             \
       (EJB).de = dyn_env,                       \
       (EJB).gc = gc_enabled,                    \
       (EJB).gc_pt = gc_prot_top,                \
       (EJB).blocked = sig_blocked_cache,        \
+      EJ_OPT_SAVE(EJB)                          \
       0))
 
 #define extended_longjmp(EJB, ARG)              \
@@ -99,6 +117,7 @@ typedef struct {
   val de;
   int gc;
   val **gc_pt;
+  EJ_OPT_MEMB
   int rv;
 } extended_jmp_buf;
 
@@ -107,10 +126,12 @@ typedef struct {
    ? (dyn_env = (EJB).de,                       \
       gc_enabled = ((EJB).gc),                  \
       gc_prot_top = (EJB).gc_pt,                \
+      EJ_OPT_REST(EJB)                          \
       (EJB).rv)                                 \
    : ((EJB).de = dyn_env,                       \
       (EJB).gc = gc_enabled,                    \
       (EJB).gc_pt = gc_prot_top,                \
+      EJ_OPT_SAVE(EJB)                          \
       0))
 
 #define extended_longjmp(EJB, ARG)              \