* eval.c, print.h, print.c, read.h, read.c: Modifications to

run-time options.

diff --git a/libguile/eval.c b/libguile/eval.c
index a8de994..9004236 100644 (file)
--- 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 b13ba28..7f0afa3 100644 (file)
--- 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 97138a6..5660fc1 100644 (file)
--- a/libguile/print.h
+++ b/libguile/print.h
@@ -49,11 +49,12 @@
 \f
 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 20017b1..828e7bc 100644 (file)
--- 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 1930964..326108e 100644 (file)
--- 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
 
 \f
 
 #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);