diff options
-rw-r--r-- | libguile/eval.c | 126 | ||||
-rw-r--r-- | libguile/print.c | 19 | ||||
-rw-r--r-- | libguile/print.h | 7 | ||||
-rw-r--r-- | libguile/read.c | 28 | ||||
-rw-r--r-- | libguile/read.h | 8 |
5 files changed, 103 insertions, 85 deletions
diff --git a/libguile/eval.c b/libguile/eval.c index a8de9945d..900423628 100644 --- a/libguile/eval.c +++ b/libguile/eval.c @@ -801,7 +801,7 @@ scm_m_define (x, env) { x = evalcar (x, env); #ifdef DEBUG_EXTENSIONS - if (RECORD_PROCNAMES && SCM_NIMP (x) && SCM_CLOSUREP (x)) + if (SCM_REC_PROCNAMES_P && SCM_NIMP (x) && SCM_CLOSUREP (x)) scm_set_procedure_property_x (x, scm_i_name, proc); #endif arg1 = scm_sym2vcell (proc, env_top_level (env), SCM_BOOL_T); @@ -1240,10 +1240,10 @@ scm_eval_args (l, env) #define PREP_APPLY(proc, args) #define ENTER_APPLY #define RETURN(x) return x; -#ifdef NO_CEVAL_STACK_CHECK -# ifdef STACK_CHECK -# undef STACK_CHECK -# endif +#ifdef STACK_CHECKING +#ifndef NO_CEVAL_STACK_CHECKING +#define EVAL_STACK_CHECKING +#endif #endif #else /* !DEVAL */ @@ -1258,13 +1258,13 @@ scm_eval_args (l, env) #undef ENTER_APPLY #define ENTER_APPLY \ {\ - SETARGSREADY (debug);\ + SCM_SET_ARGSREADY (debug);\ if (CHECK_APPLY)\ - if (APPLY_FRAME || (TRACE && PROCTRACEP (proc)))\ + if (SCM_APPLY_FRAME_P || (SCM_TRACE_P && PROCTRACEP (proc)))\ {\ - SCM tmp, tail = TRACEDFRAMEP (debug) ? SCM_BOOL_T : SCM_BOOL_F;\ - SETTRACEDFRAME (debug);\ - if (CHEAPTRAPS)\ + SCM tmp, tail = SCM_TRACED_FRAME_P (debug) ? SCM_BOOL_T : SCM_BOOL_F;\ + SCM_SET_TRACED_FRAME (debug);\ + if (SCM_CHEAPTRAPS_P)\ {\ tmp = scm_make_debugobj ((scm_debug_frame *) &debug);\ scm_ithrow (scm_i_apply_frame, scm_cons2 (tmp, tail, SCM_EOL), 0);\ @@ -1279,8 +1279,10 @@ scm_eval_args (l, env) } #undef RETURN #define RETURN(e) {proc = (e); goto exit;} -#ifdef STACK_LIMIT -# define STACK_CHECK +#ifdef STACK_CHECKING +#ifndef EVAL_STACK_CHECKING +#define EVAL_STACK_CHECKING +#endif #endif /* scm_ceval_ptr points to the currently selected evaluator. @@ -1310,23 +1312,30 @@ scm_debug_frame *last_debug_info_frame; int scm_debug_eframe_size; -int debug_mode, check_entry, check_apply, check_exit; +int scm_debug_mode, scm_check_entry_p, scm_check_apply_p, scm_check_exit_p; scm_option scm_debug_opts[] = { - { SCM_OPTION_BOOLEAN, "procnames", 1 }, - { SCM_OPTION_BOOLEAN, "deval", 0 }, - { SCM_OPTION_BOOLEAN, "breakpoints", 0 }, - { SCM_OPTION_BOOLEAN, "trace", 0 }, - { SCM_OPTION_BOOLEAN, "backtrace", 0 }, - { SCM_OPTION_INTEGER, "depth", 80 }, - { SCM_OPTION_INTEGER, "frames", 4 }, - { SCM_OPTION_BOOLEAN, "cheap", 1 } + { SCM_OPTION_BOOLEAN, "cheap", 1, + "*Flyweight representation of the stack at traps." }, + { SCM_OPTION_BOOLEAN, "breakpoints", 0, "*Check for breakpoints." }, + { SCM_OPTION_BOOLEAN, "trace", 0, "*Trace mode." }, + { SCM_OPTION_BOOLEAN, "procnames", 1, + "Record procedure names at definition." }, + { SCM_OPTION_BOOLEAN, "backwards", 0, + "Display backtrace in anti-chronological order." }, + { SCM_OPTION_INTEGER, "frames", 2, + "Maximum number of tail-recursive frames in backtrace." }, + { SCM_OPTION_INTEGER, "depth", 80, "Maximal length of backtrace." }, + { SCM_OPTION_BOOLEAN, "backtrace", 0, + "Show backtrace on error (use debugging evaluator)." }, + { SCM_OPTION_BOOLEAN, "deval", 0, "Use the debugging evaluator." }, + { SCM_OPTION_INTEGER, "stack", 20000, "Stack size limit (0 = no check)." } }; scm_option scm_evaluator_trap_table[] = { - { SCM_OPTION_BOOLEAN, "enter-frame", 0 }, - { SCM_OPTION_BOOLEAN, "apply-frame", 0 }, - { SCM_OPTION_BOOLEAN, "exit-frame", 0 } + { 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 @@ -1416,11 +1425,14 @@ SCM_CEVAL (x, env) debug.info = &debug.vect[0]; last_debug_info_frame = (scm_debug_frame *) &debug; #endif -#ifdef STACK_CHECK - if (STACK_OVERFLOW_P ((STACKITEM *) &debug) && scm_check_stack_p) +#ifdef EVAL_STACK_CHECKING + if (SCM_STACK_OVERFLOW_P ((SCM_STACKITEM *) &proc) + && scm_stack_checking_enabled_p) { +#ifdef DEVAL debug.info->e.exp = x; debug.info->e.env = env; +#endif scm_report_stack_overflow (); } #endif @@ -1434,11 +1446,11 @@ loop: #if 0 /* This will probably never have any practical use ... */ if (CHECK_EXIT) { - if (SINGLE_STEP || (TRACE && TRACEDFRAMEP (debug))) + if (SINGLE_STEP || (SCM_TRACE_P && SCM_TRACED_FRAME_P (debug))) { SINGLE_STEP = 0; - RESET_DEBUG_MODE; - CLEARTRACEDFRAME (debug); + SCM_RESET_DEBUG_MODE; + SCM_CLEAR_TRACED_FRAME (debug); scm_make_cont (&t.arg1); if (!setjmp (SCM_JMPBUF (t.arg1))) scm_ithrow (scm_i_exit_tail, scm_cons (t.arg1, SCM_EOL), 0); @@ -1446,25 +1458,25 @@ loop: } nextframe: #endif - CLEARARGSREADY (debug); - if (OVERFLOWP (debug)) + SCM_CLEAR_ARGSREADY (debug); + if (SCM_OVERFLOWP (debug)) --debug.info; else if (++debug.info == (scm_debug_info *) &debug.info) { - SETOVERFLOW (debug); + SCM_SET_OVERFLOW (debug); debug.info -= 2; } start: debug.info->e.exp = x; debug.info->e.env = env; if (CHECK_ENTRY) - if (ENTER_FRAME || (BREAKPOINTS && SRCBRKP (x))) + if (SCM_ENTER_FRAME_P || (SCM_BREAKPOINTS_P && SRCBRKP (x))) { - SCM tail = TAILRECP (debug) ? SCM_BOOL_T : SCM_BOOL_F; - SETTAILREC (debug); - ENTER_FRAME = 0; - RESET_DEBUG_MODE; - if (CHEAPTRAPS) + SCM tail = SCM_TAILRECP (debug) ? SCM_BOOL_T : SCM_BOOL_F; + SCM_SET_TAILREC (debug); + SCM_ENTER_FRAME_P = 0; + SCM_RESET_DEBUG_MODE; + if (SCM_CHEAPTRAPS_P) t.arg1 = scm_make_debugobj ((scm_debug_frame *) &debug); else { @@ -1740,7 +1752,7 @@ dispatch: x = SCM_CDR (x); x = evalcar (x, env); #ifdef DEBUG_EXTENSIONS - if (RECORD_PROCNAMES && SCM_NIMP (x) && SCM_CLOSUREP (x)) + if (SCM_REC_PROCNAMES_P && SCM_NIMP (x) && SCM_CLOSUREP (x)) scm_set_procedure_property_x (x, scm_i_name, proc); #endif env = SCM_CAR (env); @@ -2190,7 +2202,7 @@ evapply: goto cclon; #endif case scm_tcs_closures: - SETARGSREADY (debug); + SCM_SET_ARGSREADY (debug); env = EXTEND_SCM_ENV (SCM_CAR (SCM_CODE (proc)), debug.info->a.args, SCM_ENV (proc)); @@ -2219,7 +2231,7 @@ evapply: #endif case scm_tcs_closures: #ifdef DEVAL - SETARGSREADY (debug); + SCM_SET_ARGSREADY (debug); #endif env = EXTEND_SCM_ENV (SCM_CAR (SCM_CODE (proc)), scm_cons2 (t.arg1, arg2, scm_eval_args (x, env)), @@ -2242,12 +2254,12 @@ evapply: #ifdef DEVAL exit: if (CHECK_EXIT) - if (EXIT_FRAME || (TRACE && TRACEDFRAMEP (debug))) + if (SCM_EXIT_FRAME_P || (SCM_TRACE_P && SCM_TRACED_FRAME_P (debug))) { - EXIT_FRAME = 0; - RESET_DEBUG_MODE; - CLEARTRACEDFRAME (debug); - if (CHEAPTRAPS) + SCM_EXIT_FRAME_P = 0; + SCM_RESET_DEBUG_MODE; + SCM_CLEAR_TRACED_FRAME (debug); + if (SCM_CHEAPTRAPS_P) t.arg1 = scm_make_debugobj ((scm_debug_frame *) &debug); else { @@ -2384,12 +2396,12 @@ SCM_APPLY (proc, arg1, args) #ifdef DEVAL scm_debug_frame debug; debug.prev = last_debug_info_frame; - debug.status = APPLYFRAME; + debug.status = SCM_APPLYFRAME; debug.vect[0].a.proc = proc; debug.vect[0].a.args = SCM_EOL; last_debug_info_frame = &debug; #else - if (DEBUGGINGP) + if (SCM_DEBUGGINGP) return scm_dapply (proc, arg1, args); #endif #endif @@ -2412,12 +2424,12 @@ SCM_APPLY (proc, arg1, args) } #ifdef DEVAL debug.vect[0].a.args = scm_cons (arg1, args); - if (ENTER_FRAME) + if (SCM_ENTER_FRAME_P) { SCM tmp; - ENTER_FRAME = 0; - RESET_DEBUG_MODE; - if (CHEAPTRAPS) + SCM_ENTER_FRAME_P = 0; + SCM_RESET_DEBUG_MODE; + if (SCM_CHEAPTRAPS_P) tmp = scm_make_debugobj ((scm_debug_frame *) &debug); else { @@ -2559,12 +2571,12 @@ tail: #ifdef DEVAL exit: if (CHECK_EXIT) - if (EXIT_FRAME || (TRACE && TRACEDFRAMEP (debug))) + if (SCM_EXIT_FRAME_P || (SCM_TRACE_P && SCM_TRACED_FRAME_P (debug))) { - EXIT_FRAME = 0; - RESET_DEBUG_MODE; - CLEARTRACEDFRAME (debug); - if (CHEAPTRAPS) + SCM_EXIT_FRAME_P = 0; + SCM_RESET_DEBUG_MODE; + SCM_CLEAR_TRACED_FRAME (debug); + if (SCM_CHEAPTRAPS_P) arg1 = scm_make_debugobj ((scm_debug_frame *) &debug); else { diff --git a/libguile/print.c b/libguile/print.c index b13ba285e..7f0afa370 100644 --- a/libguile/print.c +++ b/libguile/print.c @@ -90,10 +90,13 @@ char *scm_isymnames[] = #ifdef DEBUG_EXTENSIONS scm_option scm_print_opts[] = { - { SCM_OPTION_BOOLEAN, "procnames", 0 }, + { SCM_OPTION_BOOLEAN, "procnames", 0, + "Print names instead of closures." }, + { SCM_OPTION_SCM, "closure-hook", SCM_BOOL_F, + "Procedure used to print closures." } }; -SCM_PROC (s_print_options, "print-options", 0, 1, 0, scm_print_options); +SCM_PROC (s_print_options, "print-options-interface", 0, 1, 0, scm_print_options); #ifdef __STDC__ SCM scm_print_options (SCM new_values) @@ -103,10 +106,10 @@ scm_print_options (new_values) SCM new_values; #endif { - SCM ans = scm_change_options (new_values, - scm_print_opts, - N_PRINT_OPTIONS, - s_print_options); + SCM ans = scm_options (new_values, + scm_print_opts, + SCM_N_PRINT_OPTIONS, + s_print_options); return ans; } #endif @@ -184,7 +187,7 @@ taloop: break; case scm_tcs_closures: #ifdef DEBUG_EXTENSIONS - if (PRINT_PROCNAMES) + if (SCM_PRINT_PROCNAMES_P) { SCM name; name = scm_procedure_property (exp, scm_i_name); @@ -589,7 +592,7 @@ scm_init_print () #endif { #ifdef DEBUG_EXTENSIONS - scm_init_opts (scm_print_options, scm_print_opts, N_PRINT_OPTIONS); + scm_init_opts (scm_print_options, scm_print_opts, SCM_N_PRINT_OPTIONS); #endif #include "print.x" } diff --git a/libguile/print.h b/libguile/print.h index 97138a6ff..5660fc18b 100644 --- a/libguile/print.h +++ b/libguile/print.h @@ -49,11 +49,12 @@ extern scm_option scm_print_opts[]; -#define PRINT_PROCNAMES scm_print_opts[0].val -#define N_PRINT_OPTIONS 1 +#define SCM_PRINT_PROCNAMES_P ((int) scm_print_opts[0].val) +#define SCM_PRINT_CLOSURE ((SCM) scm_print_opts[1].val) +#define SCM_N_PRINT_OPTIONS 2 #ifdef __STDC__ -extern SCM scm_print_options (SCM new_values); +extern SCM scm_print_options (SCM setting); extern void scm_intprint (long n, int radix, SCM port); extern void scm_ipruk (char *hdr, SCM ptr, SCM port); extern void scm_iprlist (char *hdr, SCM exp, char tlr, SCM port, int writing); diff --git a/libguile/read.c b/libguile/read.c index 20017b161..828e7bc76 100644 --- a/libguile/read.c +++ b/libguile/read.c @@ -53,26 +53,28 @@ #ifdef READER_EXTENSIONS scm_option scm_read_opts[] = { - { SCM_OPTION_BOOLEAN, "positions", 0 }, - { SCM_OPTION_BOOLEAN, "copy", 0 } + { SCM_OPTION_BOOLEAN, "copy", 0, + "Copy source code expressions." }, + { SCM_OPTION_BOOLEAN, "positions", 0, + "Record positions of source code expressions." } }; -SCM_PROC (s_read_options, "read-options", 0, 1, 0, scm_read_options); +SCM_PROC (s_read_options, "read-options-interface", 0, 1, 0, scm_read_options); #ifdef __STDC__ SCM -scm_read_options (SCM new_values) +scm_read_options (SCM setting) #else SCM -scm_read_options (new_values) - SCM new_values; +scm_read_options (setting) + SCM setting; #endif { - SCM ans = scm_change_options (new_values, - scm_read_opts, - N_READ_OPTIONS, - s_read_options); - if (COPY_SOURCE) - RECORD_POSITIONS = 1; + SCM ans = scm_options (setting, + scm_read_opts, + SCM_N_READ_OPTIONS, + s_read_options); + if (SCM_COPY_SOURCE_P) + SCM_RECORD_POSITIONS_P = 1; return ans; } #endif @@ -619,7 +621,7 @@ scm_init_read () #endif { #ifdef READER_EXTENSIONS - scm_init_opts (scm_read_options, scm_read_opts, N_READ_OPTIONS); + scm_init_opts (scm_read_options, scm_read_opts, SCM_N_READ_OPTIONS); #endif #include "read.x" } diff --git a/libguile/read.h b/libguile/read.h index 193096484..326108e92 100644 --- a/libguile/read.h +++ b/libguile/read.h @@ -69,15 +69,15 @@ #ifdef READER_EXTENSIONS extern scm_option scm_read_opts[]; -#define RECORD_POSITIONS scm_read_opts[0].val -#define COPY_SOURCE scm_read_opts[1].val -#define N_READ_OPTIONS 2 +#define SCM_COPY_SOURCE_P scm_read_opts[0].val +#define SCM_RECORD_POSITIONS_P scm_read_opts[1].val +#define SCM_N_READ_OPTIONS 2 #endif #ifdef __STDC__ -extern SCM scm_read_options (SCM new_values); +extern SCM scm_read_options (SCM setting); extern SCM scm_read (SCM port, SCM casep, SCM sharp); extern char * scm_grow_tok_buf (SCM * tok_buf); extern int scm_flush_ws (SCM port, char *eoferr); |