* Handle evaluator traps by calling trap handlers directly rather than

  by scm_ithrow and a lazy catch handler.

diff --git a/doc/ChangeLog b/doc/ChangeLog
index 5e0f084..0544d0b 100644 (file)
--- a/doc/ChangeLog
+++ b/doc/ChangeLog
@@ -1,3 +1,8 @@
+2001-06-26  Neil Jerram  <neil@ossau.uklinux.net>
+
+       * gh.texi (scm transition summary): Refer to scm_mem2string
+       instead of scm_makfromstr.
+
 2001-06-26  Dirk Herrmann  <D.Herrmann@tu-bs.de>
 
        * oldfmt.c (scm_oldfmt):  Use scm_mem2string instead of

diff --git a/doc/gh.texi b/doc/gh.texi
index 4d2896a..552e2a6 100644 (file)
--- a/doc/gh.texi
+++ b/doc/gh.texi
@@ -901,9 +901,7 @@ Use @code{scm_make_real} instead.
 Use @code{SCM_MAKE_CHAR} instead.
 
 @item @code{gh_str2scm}
-Use @code{scm_makfromstr} instead.  Note that @code{scm_makfromstr}
-currently has an additional, third parameter, but it's unused and will
-hopefully disappear soon.  If it's still there, set it to 0.
+Use @code{scm_mem2string} instead.
 
 @item @code{gh_str02scm}
 Use @code{scm_makfrom0str} instead.

diff --git a/ice-9/ChangeLog b/ice-9/ChangeLog
index ffdef95..855ed94 100644 (file)
--- a/ice-9/ChangeLog
+++ b/ice-9/ChangeLog
@@ -1,3 +1,12 @@
+2001-06-26  Neil Jerram  <neil@ossau.uklinux.net>
+
+       * debug.scm (trace): Set evaluator trap options to handle tracing.
+       Don't reset trace-level to 0.
+       
+       * boot-9.scm (lazy-handler-dispatch): Remove enter-frame-handler,
+       apply-frame-handler and exit-frame-handler.  (They're replaced by
+       evaluator trap options.)
+
 2001-06-25  Michael Livshin  <mlivshin@bigfoot.com>
 
        * streams.scm (stream-for-each-many): typo fix.

diff --git a/ice-9/boot-9.scm b/ice-9/boot-9.scm
index 5969244..ac2e486 100644 (file)
--- a/ice-9/boot-9.scm
+++ b/ice-9/boot-9.scm
@@ -2237,20 +2237,8 @@
   (save-stack lazy-handler-dispatch)
   (apply throw key args))
 
-(define enter-frame-handler default-lazy-handler)
-(define apply-frame-handler default-lazy-handler)
-(define exit-frame-handler default-lazy-handler)
-
 (define (lazy-handler-dispatch key . args)
-  (case key
-    ((apply-frame)
-     (apply apply-frame-handler key args))
-    ((exit-frame)
-     (apply exit-frame-handler key args))
-    ((enter-frame)
-     (apply enter-frame-handler key args))
-    (else
-     (apply default-lazy-handler key args))))
+  (apply default-lazy-handler key args))
 
 (define abort-hook (make-hook))
 

diff --git a/ice-9/debug.scm b/ice-9/debug.scm
index f01676b..d2fe613 100644 (file)
--- a/ice-9/debug.scm
+++ b/ice-9/debug.scm
@@ -78,9 +78,12 @@
                        (set! traced-procedures
                              (cons proc traced-procedures))))
                  args)
-       (set! apply-frame-handler trace-entry)
-       (set! exit-frame-handler trace-exit)
-       (set! trace-level 0)
+       (trap-set! apply-frame-handler trace-entry)
+       (trap-set! exit-frame-handler trace-exit)
+       ;; We used to reset `trace-level' here to 0, but this is wrong
+       ;; if `trace' itself is being traced, since `trace-exit' will
+       ;; then decrement `trace-level' to -1!  It shouldn't actually
+       ;; be necessary to set `trace-level' here at all.
        (debug-enable 'trace)
        (nameify args))))
 

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index 5be7c41..7d0f808 100644 (file)
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -1,3 +1,18 @@
+2001-06-26  Neil Jerram  <neil@ossau.uklinux.net>
+
+       * eval.h, eval.c (scm_call_4): New function.
+
+       * eval.c (SCM_APPLY, SCM_CEVAL, ENTER_APPLY): Call trap handlers
+       directly rather than dispatching to them via scm_ithrow and a lazy
+       catch.
+       
+       * eval.c (scm_evaluator_trap_table), eval.h (SCM_ENTER_FRAME_HDLR,
+       SCM_APPLY_FRAME_HDLR, SCM_EXIT_FRAME_HDLR): Add three new options
+       for trap handler procedures.
+
+       * debug.h (SCM_RESET_DEBUG_MODE): Add checks for trap handler
+       procedures not being #f.
+
 2001-06-27  Michael Livshin  <mlivshin@bigfoot.com>
 
        * Makefile.am (c-tokenize.c): add rule to generate it.

diff --git a/libguile/debug.h b/libguile/debug.h
index 16d0951..0954e33 100644 (file)
--- a/libguile/debug.h
+++ b/libguile/debug.h
@@ -98,14 +98,16 @@ extern int scm_check_entry_p, scm_check_apply_p, scm_check_exit_p;
 
 #define SCM_RESET_DEBUG_MODE \
 do {\
-  CHECK_ENTRY = SCM_ENTER_FRAME_P || SCM_BREAKPOINTS_P;\
-  CHECK_APPLY = SCM_APPLY_FRAME_P || SCM_TRACE_P;\
-  CHECK_EXIT = SCM_EXIT_FRAME_P || SCM_TRACE_P;\
+  CHECK_ENTRY = (SCM_ENTER_FRAME_P || SCM_BREAKPOINTS_P)\
+    && SCM_NFALSEP (SCM_ENTER_FRAME_HDLR);\
+  CHECK_APPLY = (SCM_APPLY_FRAME_P || SCM_TRACE_P)\
+    && SCM_NFALSEP (SCM_APPLY_FRAME_HDLR);\
+  CHECK_EXIT = (SCM_EXIT_FRAME_P || SCM_TRACE_P)\
+    && SCM_NFALSEP (SCM_EXIT_FRAME_HDLR);\
   scm_debug_mode = SCM_DEVAL_P || CHECK_ENTRY || CHECK_APPLY || CHECK_EXIT;\
   scm_ceval_ptr = scm_debug_mode ? scm_deval : scm_ceval;\
 } while (0)
 
-
 /* {Evaluator}
  */
 

diff --git a/libguile/eval.c b/libguile/eval.c
index 5d07e24..ffd195c 100644 (file)
--- a/libguile/eval.c
+++ b/libguile/eval.c
@@ -1620,18 +1620,20 @@ do { \
       {\
        SCM tmp, tail = SCM_BOOL(SCM_TRACED_FRAME_P (debug)); \
        SCM_SET_TRACED_FRAME (debug); \
+       SCM_TRAPS_P = 0;\
        if (SCM_CHEAPTRAPS_P)\
          {\
            tmp = scm_make_debugobj (&debug);\
-           scm_ithrow (scm_sym_apply_frame, scm_cons2 (tmp, tail, SCM_EOL), 0);\
+           scm_call_3 (SCM_APPLY_FRAME_HDLR, scm_sym_apply_frame, tmp, tail);\
          }\
        else\
          {\
             int first;\
            tmp = scm_make_continuation (&first);\
            if (first)\
-             scm_ithrow (scm_sym_apply_frame, scm_cons2 (tmp, tail, SCM_EOL), 0);\
+             scm_call_3 (SCM_APPLY_FRAME_HDLR, scm_sym_apply_frame, tmp, tail);\
          }\
+       SCM_TRAPS_P = 1;\
       }\
 } while (0)
 #undef RETURN
@@ -1695,14 +1697,17 @@ scm_t_option scm_debug_opts[] = {
   { SCM_OPTION_BOOLEAN, "backtrace", 0, "Show backtrace on error." },
   { SCM_OPTION_BOOLEAN, "debug", 0, "Use the debugging evaluator." },
   { SCM_OPTION_INTEGER, "stack", 20000, "Stack size limit (measured in words; 0 = no check)." },
-  { SCM_OPTION_SCM, "show-file-name", SCM_BOOL_T, "Show file names and line numbers in backtraces when not `#f'.  A value of `base' displays only base names, while `#t' displays full names."}
+  { SCM_OPTION_SCM, "show-file-name", (unsigned long)SCM_BOOL_T, "Show file names and line numbers in backtraces when not `#f'.  A value of `base' displays only base names, while `#t' displays full names."}
 };
 
 scm_t_option scm_evaluator_trap_table[] = {
   { SCM_OPTION_BOOLEAN, "traps", 0, "Enable evaluator traps." },
   { SCM_OPTION_BOOLEAN, "enter-frame", 0, "Trap when eval enters new frame." },
   { SCM_OPTION_BOOLEAN, "apply-frame", 0, "Trap when entering apply." },
-  { SCM_OPTION_BOOLEAN, "exit-frame", 0, "Trap when exiting eval or apply." }
+  { SCM_OPTION_BOOLEAN, "exit-frame", 0, "Trap when exiting eval or apply." },
+  { SCM_OPTION_SCM, "enter-frame-handler", (unsigned long)SCM_BOOL_F, "Handler for enter-frame traps." },
+  { SCM_OPTION_SCM, "apply-frame-handler", (unsigned long)SCM_BOOL_F, "Handler for apply-frame traps." },
+  { SCM_OPTION_SCM, "exit-frame-handler", (unsigned long)SCM_BOOL_F, "Handler for exit-frame traps." }
 };
 
 SCM_DEFINE (scm_eval_options_interface, "eval-options-interface", 0, 1, 0, 
@@ -1914,10 +1919,13 @@ start:
                  goto dispatch;
              }
          }
-       scm_ithrow (scm_sym_enter_frame,
-                   scm_cons2 (t.arg1, tail,
-                              scm_cons (scm_unmemocopy (x, env), SCM_EOL)),
-                   0);
+       SCM_TRAPS_P = 0;
+       scm_call_4 (SCM_ENTER_FRAME_HDLR,
+                   scm_sym_enter_frame,
+                   t.arg1,
+                   tail,
+                   scm_unmemocopy (x, env));
+       SCM_TRAPS_P = 1;
       }
 #endif
 #if defined (USE_THREADS) || defined (DEVAL)
@@ -3231,7 +3239,9 @@ exit:
                goto ret;
              }
          }
-       scm_ithrow (scm_sym_exit_frame, scm_cons2 (t.arg1, proc, SCM_EOL), 0);
+       SCM_TRAPS_P = 0;
+       scm_call_3 (SCM_EXIT_FRAME_HDLR, scm_sym_exit_frame, t.arg1, proc);
+       SCM_TRAPS_P = 1;
       }
 ret:
   scm_last_debug_frame = debug.prev;
@@ -3273,6 +3283,13 @@ scm_call_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3)
   return scm_apply (proc, arg1, scm_cons2 (arg2, arg3, scm_listofnull));
 }
 
+SCM
+scm_call_4 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4)
+{
+  return scm_apply (proc, arg1, scm_cons2 (arg2, arg3,
+                                          scm_cons (arg4, scm_listofnull)));
+}
+
 /* Simple procedure applies
  */
 
@@ -3446,7 +3463,9 @@ SCM_APPLY (SCM proc, SCM arg1, SCM args)
          if (!first)
            goto entap;
        }
-      scm_ithrow (scm_sym_enter_frame, scm_cons (tmp, SCM_EOL), 0);
+      SCM_TRAPS_P = 0;
+      scm_call_2 (SCM_ENTER_FRAME_HDLR, scm_sym_enter_frame, tmp);
+      SCM_TRAPS_P = 1;
     }
 entap:
   ENTER_APPLY;
@@ -3676,7 +3695,9 @@ exit:
                goto ret;
              }
          }
-       scm_ithrow (scm_sym_exit_frame, scm_cons2 (arg1, proc, SCM_EOL), 0);
+       SCM_TRAPS_P = 0;
+       scm_call_3 (SCM_EXIT_FRAME_HDLR, scm_sym_exit_frame, arg1, proc);
+       SCM_TRAPS_P = 1;
       }
 ret:
   scm_last_debug_frame = debug.prev;

diff --git a/libguile/eval.h b/libguile/eval.h
index 35de8a6..418844c 100644 (file)
--- a/libguile/eval.h
+++ b/libguile/eval.h
@@ -68,7 +68,10 @@ extern SCM scm_eval_options_interface (SCM setting);
 #define SCM_ENTER_FRAME_P      scm_evaluator_trap_table[1].val
 #define SCM_APPLY_FRAME_P      scm_evaluator_trap_table[2].val
 #define SCM_EXIT_FRAME_P       scm_evaluator_trap_table[3].val
-#define SCM_N_EVALUATOR_TRAPS 4
+#define SCM_ENTER_FRAME_HDLR   (SCM)(scm_evaluator_trap_table[4].val)
+#define SCM_APPLY_FRAME_HDLR   (SCM)(scm_evaluator_trap_table[5].val)
+#define SCM_EXIT_FRAME_HDLR    (SCM)(scm_evaluator_trap_table[6].val)
+#define SCM_N_EVALUATOR_TRAPS 7
 
 \f
 
@@ -235,6 +238,7 @@ extern SCM scm_call_0 (SCM proc);
 extern SCM scm_call_1 (SCM proc, SCM arg1);
 extern SCM scm_call_2 (SCM proc, SCM arg1, SCM arg2);
 extern SCM scm_call_3 (SCM proc, SCM arg1, SCM arg2, SCM arg3);
+extern SCM scm_call_4 (SCM proc, SCM arg1, SCM arg2, SCM arg3, SCM arg4);
 extern SCM scm_apply_0 (SCM proc, SCM args);
 extern SCM scm_apply_1 (SCM proc, SCM arg1, SCM args);
 extern SCM scm_apply_2 (SCM proc, SCM arg1, SCM arg2, SCM args);