Make sure the whole VM stack is always scanned by the GC.

Thanks to Andy for noticing this.

* libguile/vm-engine.h (SYNC_REGISTER, CACHE_REGISTER): Add comment.

* libguile/vm-i-scheme.c (make_struct): Call `SYNC_REGISTER ()' in all
  cases since the GC is going to run.
  (struct_ref, struct_set): Call `SYNC_REGISTER ()' on the slow path.
  (BV_REF_WITH_ENDIANNESS, BV_FIXABLE_INT_REF, BV_INT_REF): Likewise.
  (BV_FLOAT_REF): Always `SYNC_REGISTER ()'.

2 files changed, 64 insertions, 46 deletions

diff --git a/libguile/vm-engine.h b/libguile/vm-engine.h
index ccc1408d9..66e03c8b1 100644
--- a/libguile/vm-engine.h
+++ b/libguile/vm-engine.h
@@ -1,4 +1,4 @@
-/* Copyright (C) 2001, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
  * 
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -102,6 +102,7 @@
 #endif
 
 
+/* Cache the VM's instruction, stack, and frame pointer in local variables.  */
 #define CACHE_REGISTER()			\
 {						\
   ip = vp->ip;					\
@@ -109,6 +110,9 @@
   fp = vp->fp;					\
 }
 
+/* Update the registers in VP, a pointer to the current VM.  This must be done
+   at least before any GC invocation so that `vp->sp' is up-to-date and the
+   whole stack gets marked.  */
 #define SYNC_REGISTER()				\
 {						\
   vp->ip = ip;					\
diff --git a/libguile/vm-i-scheme.c b/libguile/vm-i-scheme.c
index 20ec9f6af..1942a8985 100644
--- a/libguile/vm-i-scheme.c
+++ b/libguile/vm-i-scheme.c
@@ -413,6 +413,8 @@ VM_DEFINE_INSTRUCTION (166, make_struct, "make-struct", 2, -1, 1)
 
   sp -= n_args - 1;
 
+  SYNC_REGISTER ();
+
   if (SCM_LIKELY (SCM_STRUCTP (vtable)
   		  && SCM_VTABLE_FLAG_IS_SET (vtable, SCM_VTABLE_FLAG_SIMPLE)
 		  && SCM_I_INUMP (n_tail)))
@@ -433,7 +435,6 @@ VM_DEFINE_INSTRUCTION (166, make_struct, "make-struct", 2, -1, 1)
 	}
     }
 
-  SYNC_REGISTER ();
   RETURN (scm_c_make_structv (vtable, scm_to_size_t (n_tail),
 			      n_args - 2, (scm_t_bits *) inits));
 }
@@ -461,6 +462,7 @@ VM_DEFINE_FUNCTION (167, struct_ref, "struct-ref", 2)
   	}
     }
 
+  SYNC_REGISTER ();
   RETURN (scm_struct_ref (obj, pos));
 }
 
@@ -489,6 +491,7 @@ VM_DEFINE_FUNCTION (168, struct_set, "struct-set", 3)
   	}
     }
 
+  SYNC_REGISTER ();
   RETURN (scm_struct_set_x (obj, pos, val));
 }
 
@@ -540,6 +543,7 @@ VM_DEFINE_INSTRUCTION (171, slot_set, "slot-set", 0, 3, 0)
     goto VM_LABEL (bv_##stem##_native_ref);                             \
   {                                                                     \
     ARGS2 (bv, idx);                                                    \
+    SYNC_REGISTER ();							\
     RETURN (scm_bytevector_##fn_stem##_ref (bv, idx, endianness));      \
   }                                                                     \
 }
@@ -563,52 +567,62 @@ BV_REF_WITH_ENDIANNESS (f64, ieee_double)
 
 #undef BV_REF_WITH_ENDIANNESS
 
-#define BV_FIXABLE_INT_REF(stem, fn_stem, type, size)                   \
-{                                                                       \
-  long i = 0;                                                           \
-  ARGS2 (bv, idx);                                                      \
-  VM_VALIDATE_BYTEVECTOR (bv);                                          \
-  if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
-                  && ((i = SCM_I_INUM (idx)) >= 0)                        \
-                  && (i + size <= SCM_BYTEVECTOR_LENGTH (bv))           \
-                  && (i % size == 0)))                                  \
-    RETURN (SCM_I_MAKINUM (*(scm_t_##type*)                             \
-                           (SCM_BYTEVECTOR_CONTENTS (bv) + i)));        \
-  else                                                                  \
-    RETURN (scm_bytevector_##fn_stem##_ref (bv, idx));                  \
-}
-
-#define BV_INT_REF(stem, type, size)                                    \
-{                                                                       \
-  long i = 0;                                                           \
-  ARGS2 (bv, idx);                                                      \
-  VM_VALIDATE_BYTEVECTOR (bv);                                          \
-  if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
-                  && ((i = SCM_I_INUM (idx)) >= 0)                      \
-                  && (i + size <= SCM_BYTEVECTOR_LENGTH (bv))           \
-                  && (i % size == 0)))                                  \
+#define BV_FIXABLE_INT_REF(stem, fn_stem, type, size)			\
+{									\
+  long i = 0;								\
+  ARGS2 (bv, idx);							\
+  VM_VALIDATE_BYTEVECTOR (bv);						\
+  if (SCM_LIKELY (SCM_I_INUMP (idx)					\
+                  && ((i = SCM_I_INUM (idx)) >= 0)			\
+                  && (i + size <= SCM_BYTEVECTOR_LENGTH (bv))		\
+                  && (i % size == 0)))					\
+    RETURN (SCM_I_MAKINUM (*(scm_t_##type*)				\
+                           (SCM_BYTEVECTOR_CONTENTS (bv) + i)));	\
+  else									\
+    {									\
+      SYNC_REGISTER ();							\
+      RETURN (scm_bytevector_ ## fn_stem ## _ref (bv, idx));		\
+    }									\
+}
+
+#define BV_INT_REF(stem, type, size)					\
+{									\
+  long i = 0;								\
+  ARGS2 (bv, idx);							\
+  VM_VALIDATE_BYTEVECTOR (bv);						\
+  if (SCM_LIKELY (SCM_I_INUMP (idx)					\
+                  && ((i = SCM_I_INUM (idx)) >= 0)			\
+                  && (i + size <= SCM_BYTEVECTOR_LENGTH (bv))		\
+                  && (i % size == 0)))					\
     { scm_t_##type x = (*(scm_t_##type*)(SCM_BYTEVECTOR_CONTENTS (bv) + i)); \
-      if (SCM_FIXABLE (x))                                              \
-        RETURN (SCM_I_MAKINUM (x));                                     \
-      else                                                              \
-        RETURN (scm_from_##type (x));                                   \
-    }                                                                   \
-  else                                                                  \
-    RETURN (scm_bytevector_##stem##_native_ref (bv, idx));              \
-}
-
-#define BV_FLOAT_REF(stem, fn_stem, type, size)                         \
-{                                                                       \
-  long i = 0;                                                           \
-  ARGS2 (bv, idx);                                                      \
-  VM_VALIDATE_BYTEVECTOR (bv);                                          \
-  if (SCM_LIKELY (SCM_I_INUMP (idx)                                     \
-                  && ((i = SCM_I_INUM (idx)) >= 0)                        \
-                  && (i + size <= SCM_BYTEVECTOR_LENGTH (bv))           \
-                  && (i % size == 0)))                                  \
+      if (SCM_FIXABLE (x))						\
+        RETURN (SCM_I_MAKINUM (x));					\
+      else								\
+	{								\
+	  SYNC_REGISTER ();						\
+	  RETURN (scm_from_ ## type (x));				\
+	}								\
+    }									\
+  else									\
+    {									\
+      SYNC_REGISTER ();							\
+      RETURN (scm_bytevector_ ## stem ## _native_ref (bv, idx));	\
+    }									\
+}
+
+#define BV_FLOAT_REF(stem, fn_stem, type, size)				\
+{									\
+  long i = 0;								\
+  ARGS2 (bv, idx);							\
+  VM_VALIDATE_BYTEVECTOR (bv);						\
+  SYNC_REGISTER ();							\
+  if (SCM_LIKELY (SCM_I_INUMP (idx)					\
+                  && ((i = SCM_I_INUM (idx)) >= 0)			\
+                  && (i + size <= SCM_BYTEVECTOR_LENGTH (bv))		\
+                  && (i % size == 0)))					\
     RETURN (scm_from_double ((*(type*)(SCM_BYTEVECTOR_CONTENTS (bv) + i)))); \
-  else                                                                  \
-    RETURN (scm_bytevector_##fn_stem##_native_ref (bv, idx));           \
+  else									\
+    RETURN (scm_bytevector_ ## fn_stem ## _native_ref (bv, idx));	\
 }
 
 VM_DEFINE_FUNCTION (180, bv_u8_ref, "bv-u8-ref", 2)