*** empty log message ***

[bpt/guile.git] / libguile / debug.c

diff --git a/libguile/debug.c b/libguile/debug.c
index 68ba4f6..507097b 100644 (file)
--- a/libguile/debug.c
+++ b/libguile/debug.c
@@ -1,5 +1,5 @@
 /* Debugging extensions for Guile
- * Copyright (C) 1995, 1996, 1997 Free Software Foundation
+ * Copyright (C) 1995, 1996, 1997, 1998 Free Software Foundation
  *
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -48,6 +48,7 @@
 #include "eval.h"
 #include "throw.h"
 #include "genio.h"
+#include "macros.h"
 #include "smob.h"
 #include "procprop.h"
 #include "srcprop.h"
@@ -56,6 +57,7 @@
 #include "strports.h"
 #include "read.h"
 #include "feature.h"
+#include "dynwind.h"
 
 #include "debug.h"
 \f
@@ -88,19 +90,43 @@ scm_debug_options (setting)
   return ans;
 }
 
-SCM_PROC (s_single_step, "single-step", 2, 0, 0, scm_single_step);
+SCM_PROC (s_with_traps, "with-traps", 1, 0, 0, scm_with_traps);
+
+static void
+with_traps_before (void *data)
+{
+  int *trap_flag = data;
+  *trap_flag = SCM_TRAPS_P;
+  SCM_TRAPS_P = 1;
+}
+
+static void
+with_traps_after (void *data)
+{
+  int *trap_flag = data;
+  SCM_TRAPS_P = *trap_flag;
+}
+
+static SCM
+with_traps_inner (void *data)
+{
+  SCM thunk = (SCM) data;
+  return scm_apply (thunk, SCM_EOL, SCM_EOL);
+}
 
 SCM
-scm_single_step (cont, val)
-     SCM cont;
-     SCM val;
+scm_with_traps (SCM thunk)
 {
-  SCM_DEFER_INTS;
-  SCM_ENTER_FRAME_P = SCM_EXIT_FRAME_P = 1;
-  SCM_RESET_DEBUG_MODE;
-  SCM_ALLOW_INTS;
-  scm_call_continuation (cont, val);
-  return SCM_BOOL_F; /* never returns */
+  int trap_flag;
+  SCM_ASSERT (SCM_NFALSEP (scm_thunk_p (thunk)),
+             thunk,
+             SCM_ARG1,
+             s_with_traps);
+  return scm_internal_dynamic_wind (with_traps_before,
+                                   with_traps_inner,
+                                   with_traps_after,
+                                   (void *) thunk,
+                                   &trap_flag);
 }
 
 \f
@@ -517,13 +543,13 @@ scm_start_stack (id, exp, env)
   vframe.vect = &vframe_vect_body;
   vframe.vect[0].id = id;
   scm_last_debug_frame = &vframe;
-  answer = scm_eval_3 (exp, 0, env);
+  answer = scm_eval_3 (exp, 1, env);
   scm_last_debug_frame = vframe.prev;
   return answer;
 }
 
 static char s_start_stack[] = "start-stack";
-SCM
+static SCM
 scm_m_start_stack (exp, env)
      SCM exp;
      SCM env;