diff options
author | Neil Jerram <neil@ossau.uklinux.net> | 2001-06-26 21:55:45 +0000 |
---|---|---|
committer | Neil Jerram <neil@ossau.uklinux.net> | 2001-06-26 21:55:45 +0000 |
commit | d95c0b76d6f139d59660bdc7b20fae5a15947bcd (patch) | |
tree | cb719979fbd8f0b2996aafda0b922fdf88a823f7 | |
parent | 17383b7c773eaca6e5ab488c9edd1fa313c33248 (diff) | |
download | guile-d95c0b76d6f139d59660bdc7b20fae5a15947bcd.tar.gz |
* Handle evaluator traps by calling trap handlers directly rather than
by scm_ithrow and a lazy catch handler.
-rw-r--r-- | doc/ChangeLog | 5 | ||||
-rw-r--r-- | doc/gh.texi | 4 | ||||
-rw-r--r-- | ice-9/ChangeLog | 9 | ||||
-rw-r--r-- | ice-9/boot-9.scm | 14 | ||||
-rw-r--r-- | ice-9/debug.scm | 9 | ||||
-rw-r--r-- | libguile/ChangeLog | 15 | ||||
-rw-r--r-- | libguile/debug.h | 10 | ||||
-rw-r--r-- | libguile/eval.c | 43 | ||||
-rw-r--r-- | libguile/eval.h | 6 |
9 files changed, 80 insertions, 35 deletions
diff --git a/doc/ChangeLog b/doc/ChangeLog index 5e0f0848a..0544d0bb8 100644 --- 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 4d2896ae8..552e2a69d 100644 --- 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 ffdef9570..855ed945d 100644 --- 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 5969244a3..ac2e48681 100644 --- 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 f01676ba4..d2fe61324 100644 --- 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 5be7c4100..7d0f808c2 100644 --- 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 16d09510a..0954e3329 100644 --- 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 5d07e2434..ffd195ca5 100644 --- 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 35de8a6b2..418844c0a 100644 --- 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 @@ -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); |