From: Andy Wingo <wingo@pobox.com>
Date: Tue, 15 Mar 2011 22:33:32 +0000 (+0100)
Subject: fix frame dynamic linkage in the face of partial continuation application
X-Git-Url: https://git.hcoop.net/bpt/guile.git/commitdiff_plain/9b709b0fe1ec5a71903e07d21006441d15e0c1ed

fix frame dynamic linkage in the face of partial continuation application

* libguile/vm-i-system.c (new-frame): Though it was appealing to set the
  dynamic link here on the incomplete frame, we no longer do that, for
  the reasons mentioned in the code.
  (call, mv-call): Adapt to set the frame's dynamic link.

* libguile/vm-engine.c (vm_engine): Don't set dynamic link here, even
  for boot program.

* libguile/frames.c (scm_frame_num_locals, scm_frame_local_ref)
  (scm_frame_local_set_x): Fix up not-yet-active frame detection.
---

diff --git a/libguile/frames.c b/libguile/frames.c
index bc1bb82a8..62ba23fff 100644
--- a/libguile/frames.c
+++ b/libguile/frames.c
@@ -124,7 +124,7 @@ SCM_DEFINE (scm_frame_num_locals, "frame-num-locals", 1, 0, 0,
   p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame));
   while (p <= sp)
     {
-      if (p + 1 < sp && p[1] == (SCM)0)
+      if (p[0] == (SCM)0)
         /* skip over not-yet-active frame */
         p += 3;
       else
@@ -154,7 +154,7 @@ SCM_DEFINE (scm_frame_local_ref, "frame-local-ref", 2, 0, 0,
   p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame));
   while (p <= sp)
     {
-      if (p + 1 < sp && p[1] == (SCM)0)
+      if (p[0] == (SCM)0)
         /* skip over not-yet-active frame */
         p += 3;
       else if (n == i)
@@ -186,7 +186,7 @@ SCM_DEFINE (scm_frame_local_set_x, "frame-local-set!", 3, 0, 0,
   p = SCM_FRAME_STACK_ADDRESS (SCM_VM_FRAME_FP (frame));
   while (p <= sp)
     {
-      if (p + 1 < sp && p[1] == (SCM)0)
+      if (p[0] == (SCM)0)
         /* skip over not-yet-active frame */
         p += 3;
       else if (n == i)
diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 20d9ed2c8..4b0ca3ec3 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -93,7 +93,7 @@ VM_NAME (SCM vm, SCM program, SCM *argv, int nargs)
     fp = sp + 1;
     ip = SCM_C_OBJCODE_BASE (bp);
     /* MV-call frame, function & arguments */
-    PUSH ((SCM)fp); /* dynamic link */
+    PUSH (0); /* dynamic link */
     PUSH (0); /* mvra */
     PUSH (0); /* ra */
     PUSH (prog);
diff --git a/libguile/vm-i-system.c b/libguile/vm-i-system.c
index 57712cabd..980d22afe 100644
--- a/libguile/vm-i-system.c
+++ b/libguile/vm-i-system.c
@@ -756,9 +756,14 @@ VM_DEFINE_INSTRUCTION (52, new_frame, "new-frame", 0, 0, 3)
 {
   /* NB: if you change this, see frames.c:vm-frame-num-locals */
   /* and frames.h, vm-engine.c, etc of course */
-  PUSH ((SCM)fp); /* dynamic link */
-  PUSH (0);  /* mvra */
-  PUSH (0);  /* ra */
+
+  /* We don't initialize the dynamic link here because we don't actually
+     know that this frame will point to the current fp: it could be
+     placed elsewhere on the stack if captured in a partial
+     continuation, and invoked from some other context.  */
+  PUSH (0); /* dynamic link */
+  PUSH (0); /* mvra */
+  PUSH (0); /* ra */
   NEXT;
 }
 
@@ -790,11 +795,20 @@ VM_DEFINE_INSTRUCTION (53, call, "call", 1, -1, 1)
     }
 
   CACHE_PROGRAM ();
-  fp = sp - nargs + 1;
-  ASSERT (SCM_FRAME_RETURN_ADDRESS (fp) == 0);
-  ASSERT (SCM_FRAME_MV_RETURN_ADDRESS (fp) == 0);
-  SCM_FRAME_SET_RETURN_ADDRESS (fp, ip);
-  SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, 0);
+
+  {
+    SCM *old_fp = fp;
+
+    fp = sp - nargs + 1;
+  
+    ASSERT (SCM_FRAME_DYNAMIC_LINK (fp) == 0);
+    ASSERT (SCM_FRAME_RETURN_ADDRESS (fp) == 0);
+    ASSERT (SCM_FRAME_MV_RETURN_ADDRESS (fp) == 0);
+    SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp);
+    SCM_FRAME_SET_RETURN_ADDRESS (fp, ip);
+    SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, 0);
+  }
+  
   ip = SCM_C_OBJCODE_BASE (bp);
   PUSH_CONTINUATION_HOOK ();
   APPLY_HOOK ();
@@ -1091,11 +1105,20 @@ VM_DEFINE_INSTRUCTION (62, mv_call, "mv-call", 4, -1, 1)
     }
 
   CACHE_PROGRAM ();
-  fp = sp - nargs + 1;
-  ASSERT (SCM_FRAME_RETURN_ADDRESS (fp) == 0);
-  ASSERT (SCM_FRAME_MV_RETURN_ADDRESS (fp) == 0);
-  SCM_FRAME_SET_RETURN_ADDRESS (fp, ip);
-  SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, mvra);
+
+  {
+    SCM *old_fp = fp;
+
+    fp = sp - nargs + 1;
+  
+    ASSERT (SCM_FRAME_DYNAMIC_LINK (fp) == 0);
+    ASSERT (SCM_FRAME_RETURN_ADDRESS (fp) == 0);
+    ASSERT (SCM_FRAME_MV_RETURN_ADDRESS (fp) == 0);
+    SCM_FRAME_SET_DYNAMIC_LINK (fp, old_fp);
+    SCM_FRAME_SET_RETURN_ADDRESS (fp, ip);
+    SCM_FRAME_SET_MV_RETURN_ADDRESS (fp, mvra);
+  }
+  
   ip = SCM_C_OBJCODE_BASE (bp);
   PUSH_CONTINUATION_HOOK ();
   APPLY_HOOK ();