From b8fd7f7b90dec5d5bc19cc902848f549ce7e4f11 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 12 May 2007 23:09:13 +0000
Subject: [PATCH] debugging-related tweaks that won't affect a normal build

svn: r6215
---
 src/mzscheme/gc2/compact.c |  2 +-
 src/mzscheme/src/jit.c     | 49 ++++++++++++++++++++++++++++++++++++++
 src/mzscheme/src/salloc.c  |  2 ++
 3 files changed, 52 insertions(+), 1 deletion(-)

diff --git a/src/mzscheme/gc2/compact.c b/src/mzscheme/gc2/compact.c
index 375ba65b90..553fd05fd4 100644
--- a/src/mzscheme/gc2/compact.c
+++ b/src/mzscheme/gc2/compact.c
@@ -2676,7 +2676,7 @@ static int designate_modified_maybe(void *p, int no_barrier_ok)
 
 static int designate_modified(void *p)
 {
-  designate_modified_maybe(p, 0);
+  return designate_modified_maybe(p, 0);
 }
 
 void GC_write_barrier(void *p)
diff --git a/src/mzscheme/src/jit.c b/src/mzscheme/src/jit.c
index fa694e0245..c8ef3a0728 100644
--- a/src/mzscheme/src/jit.c
+++ b/src/mzscheme/src/jit.c
@@ -6408,6 +6408,55 @@ Scheme_Object *scheme_native_stack_trace(void)
   return first;
 }
 
+#if 0
+/* Sometimes useful for debugging MzScheme: */
+void scheme_dump_stack_trace(void)
+{
+  void *p, *q;
+  unsigned long stack_end, stack_start;
+  Get_Stack_Proc gs;
+  Scheme_Object *name;
+
+  gs = (Get_Stack_Proc)get_stack_pointer_code;
+  p = gs();
+  stack_start = scheme_approx_sp();
+
+  stack_end = (unsigned long)ADJUST_STACK_START(scheme_current_thread->stack_start);
+
+  while (STK_COMP((unsigned long)p, stack_end)
+	 && STK_COMP(stack_start, (unsigned long)p)) {
+    q = ((void **)p)[RETURN_ADDRESS_OFFSET];
+
+    name = find_symbol((unsigned long)q);
+    if (SCHEME_FALSEP(name)) {
+      /* Code uses special calling convention */
+#ifdef MZ_USE_JIT_PPC
+      /* JIT_LOCAL2 has the next return address */
+      q = ((void **)p)[JIT_LOCAL2 >> JIT_LOG_WORD_SIZE];
+#endif
+#ifdef MZ_USE_JIT_I386
+      /* Push after local stack of return-address proc
+	 has the next return address */
+      q = *(void **)p;
+      q = ((void **)q)[-(3 + LOCAL_FRAME_SIZE + 1)];
+#endif
+      name = find_symbol((unsigned long)q);
+    }
+
+    if (name) {
+      printf(" scheme\n");
+    } else {
+      printf(" %p\n", q);
+    }
+
+    q = *(void **)p;
+    if (STK_COMP((unsigned long)q, (unsigned long)p))
+      break;
+    p = q;
+  }
+}
+#endif
+
 #ifdef MZ_XFORM
 START_XFORM_SKIP;
 #endif
diff --git a/src/mzscheme/src/salloc.c b/src/mzscheme/src/salloc.c
index 8977b9c14e..1ea155c4f4 100644
--- a/src/mzscheme/src/salloc.c
+++ b/src/mzscheme/src/salloc.c
@@ -1132,6 +1132,7 @@ static void print_tagged_value(const char *prefix,
       t3[len + len2 + 3] = 0;
       type = t3;
       len = len3;
+#ifdef MZTAG_REQUIRED
     } else if (SAME_TYPE(SCHEME_TYPE(v), scheme_rt_meta_cont)) {
       Scheme_Meta_Continuation *mc = (Scheme_Meta_Continuation *)v;
       Scheme_Object *pt;
@@ -1151,6 +1152,7 @@ static void print_tagged_value(const char *prefix,
       sprintf(t2, "#<meta-continuation>[%d;%s]", mc->pseudo, t3);
       type = t2;
       len = strlen(t2);
+#endif
     } else if (!scheme_strncmp(type, "#<syntax", 8)) {
       char *t2, *t3;
       long len2, len3;