[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: `trace' is broken
|
From: |
Neil Jerram |
|
Subject: |
Re: `trace' is broken |
|
Date: |
21 Jun 2001 23:52:00 +0100 |
|
User-agent: |
Gnus/5.0808 (Gnus v5.8.8) Emacs/20.7 |
>>>>> "Martin" == Martin Grabmueller <address@hidden> writes:
Martin> Hello list, I was just trying out an example from the GRM,
Martin> node `Trace' ...
Martin> It would be really nice if we could get that working again
Martin> before 1.6.
Can you try the patch below? It works for me with your `rev' example,
but perhaps there are more difficult tests that you can give it.
Neil
Index: ice-9/debug.scm
===================================================================
RCS file: /cvs/guile/guile-core/ice-9/debug.scm,v
retrieving revision 1.21
diff -u -r1.21 debug.scm
--- ice-9/debug.scm 2001/06/03 23:29:45 1.21
+++ ice-9/debug.scm 2001/06/21 22:41:52
@@ -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))))
Index: libguile/eval.c
===================================================================
RCS file: /cvs/guile/guile-core/libguile/eval.c,v
retrieving revision 1.230
diff -u -r1.230 eval.c
--- libguile/eval.c 2001/06/14 20:14:09 1.230
+++ libguile/eval.c 2001/06/21 22:42:28
@@ -1620,18 +1620,26 @@
{\
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_apply (SCM_APPLY_FRAME_HDLR,\
+ scm_cons (scm_sym_apply_frame,\
+ scm_cons2 (tmp, tail, SCM_EOL)),\
+ SCM_EOL);\
}\
else\
{\
int first;\
tmp = scm_make_continuation (&first);\
if (first)\
- scm_ithrow (scm_sym_apply_frame, scm_cons2 (tmp, tail, SCM_EOL),
0);\
+ scm_apply (SCM_APPLY_FRAME_HDLR,\
+ scm_cons (scm_sym_apply_frame,\
+ scm_cons2 (tmp, tail, SCM_EOL)),\
+ SCM_EOL);\
}\
+ SCM_TRAPS_P = 1;\
}\
} while (0)
#undef RETURN
@@ -1695,14 +1703,17 @@
{ 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 +1925,14 @@
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_apply (SCM_ENTER_FRAME_HDLR,
+ scm_cons (scm_sym_enter_frame,
+ scm_cons2 (t.arg1, tail,
+ scm_cons (scm_unmemocopy (x, env),
+ SCM_EOL))),
+ SCM_EOL);
+ SCM_TRAPS_P = 1;
}
#endif
#if defined (USE_THREADS) || defined (DEVAL)
@@ -3231,7 +3246,12 @@
goto ret;
}
}
- scm_ithrow (scm_sym_exit_frame, scm_cons2 (t.arg1, proc, SCM_EOL), 0);
+ SCM_TRAPS_P = 0;
+ scm_apply (SCM_EXIT_FRAME_HDLR,
+ scm_cons (scm_sym_exit_frame,
+ scm_cons2 (t.arg1, proc, SCM_EOL)),
+ SCM_EOL);
+ SCM_TRAPS_P = 1;
}
ret:
scm_last_debug_frame = debug.prev;
@@ -3390,7 +3410,10 @@
if (!first)
goto entap;
}
- scm_ithrow (scm_sym_enter_frame, scm_cons (tmp, SCM_EOL), 0);
+ SCM_TRAPS_P = 0;
+ scm_apply (SCM_ENTER_FRAME_HDLR,
+ scm_cons2 (scm_sym_enter_frame, tmp, SCM_EOL), SCM_EOL);
+ SCM_TRAPS_P = 1;
}
entap:
ENTER_APPLY;
@@ -3620,7 +3643,12 @@
goto ret;
}
}
- scm_ithrow (scm_sym_exit_frame, scm_cons2 (arg1, proc, SCM_EOL), 0);
+ SCM_TRAPS_P = 0;
+ scm_apply (SCM_EXIT_FRAME_HDLR,
+ scm_cons (scm_sym_exit_frame,
+ scm_cons2 (arg1, proc, SCM_EOL)),
+ SCM_EOL);
+ SCM_TRAPS_P = 1;
}
ret:
scm_last_debug_frame = debug.prev;
Index: libguile/eval.h
===================================================================
RCS file: /cvs/guile/guile-core/libguile/eval.h,v
retrieving revision 1.58
diff -u -r1.58 eval.h
--- libguile/eval.h 2001/06/14 19:50:43 1.58
+++ libguile/eval.h 2001/06/21 22:42:31
@@ -68,7 +68,10 @@
#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