* dynl-dl.c (sysdep_dynl_link): Added parenthesis around the
[bpt/guile.git] / libguile / debug.c
index ef2b2c9..f5c9f8c 100644 (file)
@@ -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
 #include <stdio.h>
 #include "_scm.h"
 #include "eval.h"
+#include "stackchk.h"
 #include "throw.h"
 #include "genio.h"
+#include "macros.h"
 #include "smob.h"
 #include "procprop.h"
 #include "srcprop.h"
@@ -57,6 +59,7 @@
 #include "read.h"
 #include "feature.h"
 #include "dynwind.h"
+#include "modules.h"
 
 #include "debug.h"
 \f
@@ -84,6 +87,7 @@ scm_debug_options (setting)
     }
 #endif
   SCM_RESET_DEBUG_MODE;
+  scm_stack_checking_enabled_p = SCM_STACK_CHECKING_P;
   scm_debug_eframe_size = 2 * SCM_N_FRAMES;
   SCM_ALLOW_INTS
   return ans;
@@ -252,6 +256,7 @@ scm_make_memoized (exp, env)
  * - constant: SCM_IM_DEFINE
  * - constant: SCM_IM_APPLY
  * - constant: SCM_IM_CONT
+ * - constant: SCM_IM_DISPATCH
  */
 
 #include "variable.h"
@@ -427,8 +432,9 @@ scm_procedure_name (proc)
             SCM_ARG1,
             s_procedure_name);
   switch (SCM_TYP7 (proc)) {
-  case scm_tcs_closures:
-  case scm_tc7_cclo:
+  case scm_tcs_subrs:
+    return SCM_SNAME (proc);
+  default:
     {
       SCM name = scm_procedure_property (proc, scm_i_name);
 #if 0
@@ -441,10 +447,6 @@ scm_procedure_name (proc)
        name = scm_procedure_property (proc, scm_i_inner_name);
       return name;
     }
-  case scm_tcs_subrs:
-    return SCM_SNAME (proc);
-  default:
-    return SCM_BOOL_F;
   }
 }
 
@@ -542,13 +544,14 @@ 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
+SCM_SYNTAX(s_start_stack, "start-stack", scm_makacro, scm_m_start_stack);
+
+static SCM
 scm_m_start_stack (exp, env)
      SCM exp;
      SCM env;
@@ -645,8 +648,6 @@ scm_init_debug ()
   scm_i_args = SCM_CAR (scm_sysintern ("args", SCM_UNDEFINED));
   scm_i_eval_args = SCM_CAR (scm_sysintern ("eval-args", SCM_UNDEFINED));
 
-  scm_make_synt (s_start_stack, scm_makacro, scm_m_start_stack);
-
 #ifdef GUILE_DEBUG
   scm_sysintern ("SCM_IM_AND", SCM_IM_AND);
   scm_sysintern ("SCM_IM_BEGIN", SCM_IM_BEGIN);
@@ -660,10 +661,11 @@ scm_init_debug ()
   scm_sysintern ("SCM_IM_LETREC", SCM_IM_LETREC);
   scm_sysintern ("SCM_IM_OR", SCM_IM_OR);
   scm_sysintern ("SCM_IM_QUOTE", SCM_IM_QUOTE);
-  scm_sysintern ("SCM_IM_SET", SCM_IM_SET);
+  scm_sysintern ("SCM_IM_SET_X", SCM_IM_SET_X);
   scm_sysintern ("SCM_IM_DEFINE", SCM_IM_DEFINE);
   scm_sysintern ("SCM_IM_APPLY", SCM_IM_APPLY);
   scm_sysintern ("SCM_IM_CONT", SCM_IM_CONT);
+  scm_sysintern ("SCM_IM_DISPATCH", SCM_IM_DISPATCH);
 #endif
   scm_add_feature ("debug-extensions");