guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-104-gf5fc7


From: Andy Wingo
Subject: [Guile-commits] GNU Guile branch, stable-2.0, updated. v2.0.0-104-gf5fc7e5
Date: Tue, 15 Mar 2011 22:54:23 +0000

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=f5fc7e5710438389b21c5c754e959a5554561868

The branch, stable-2.0 has been updated
       via  f5fc7e5710438389b21c5c754e959a5554561868 (commit)
       via  9b709b0fe1ec5a71903e07d21006441d15e0c1ed (commit)
      from  958173e489c69b2f9e3c83752713a89e3ea3e79d (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit f5fc7e5710438389b21c5c754e959a5554561868
Author: Andy Wingo <address@hidden>
Date:   Tue Mar 15 23:54:06 2011 +0100

    add more prompt/abort tests
    
    * test-suite/tests/control.test: Use c&e tests for most test blocks.
      Note that this did not catch the recent bug.
      ("reified continuations"): Add a new test for capturing partial
      continuations containing pending call frames.  Before these would
      contain dynamic links pointing out of the continuation segment, which
      would not be relocated; now, the dynamic links are only made when the
      frames are activated.
    
      Thanks to Wolfgang J Moeller for the bug report and test case.

commit 9b709b0fe1ec5a71903e07d21006441d15e0c1ed
Author: Andy Wingo <address@hidden>
Date:   Tue Mar 15 23:33:32 2011 +0100

    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.

-----------------------------------------------------------------------

Summary of changes:
 libguile/frames.c             |    6 ++--
 libguile/vm-engine.c          |    2 +-
 libguile/vm-i-system.c        |   49 ++++++++++++++++++++++++++++++-----------
 test-suite/tests/control.test |   28 ++++++++++++++++------
 4 files changed, 60 insertions(+), 25 deletions(-)

diff --git a/libguile/frames.c b/libguile/frames.c
index bc1bb82..62ba23f 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 20d9ed2..4b0ca3e 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 57712ca..980d22a 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 ();
diff --git a/test-suite/tests/control.test b/test-suite/tests/control.test
index 682c69f..ce2e1bf 100644
--- a/test-suite/tests/control.test
+++ b/test-suite/tests/control.test
@@ -1,7 +1,7 @@
 ;;;;                                                          -*- scheme -*-
 ;;;; control.test --- test suite for delimited continuations
 ;;;;
-;;;; Copyright (C) 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2011 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
@@ -27,7 +27,7 @@
 ;; For these, the compiler should be able to prove that "k" is not referenced,
 ;; so it avoids reifying the continuation. Since that's a slightly different
 ;; codepath, we test them both.
-(with-test-prefix "escape-only continuations"
+(with-test-prefix/c&e "escape-only continuations"
   (pass-if "no values, normal exit"
     (equal? '()
             (call-with-values
@@ -80,7 +80,7 @@
                  args)))))
 
 ;;; And the case in which the compiler has to reify the continuation.
-(with-test-prefix "reified continuations"
+(with-test-prefix/c&e "reified continuations"
   (pass-if "no values, normal exit"
     (equal? '()
             (call-with-values
@@ -133,10 +133,20 @@
                   (abort 'foo 'bar 'baz)
                   (error "unexpected exit"))
                 (lambda args
-                  args))))))
+                  args)))))
+
+  (pass-if "reified pending call frames, instantiated elsewhere on the stack"
+    (equal? 'foo
+            ((call-with-prompt
+              'p0
+              (lambda ()
+                (identity ((abort-to-prompt 'p0) 'foo)))
+              (lambda (c) c))
+             (lambda (x) x)))))
+
 
 ;; The variants check different cases in the compiler.
-(with-test-prefix "restarting partial continuations"
+(with-test-prefix/c&e "restarting partial continuations"
   (pass-if "in side-effect position"
     (let ((k (% (begin (abort) 'foo)
                 (lambda (k) k))))
@@ -171,6 +181,8 @@
 (define fl (make-fluid))
 (fluid-set! fl 0)
 
+;; Not c&e as it assumes this block executes once.
+;;
 (with-test-prefix "suspend/resume with fluids"
   (pass-if "normal"
     (zero? (% (fluid-ref fl)
@@ -212,7 +224,7 @@
     (pass-if "post"
       (equal? (fluid-ref fl) 0))))
 
-(with-test-prefix "rewinding prompts"
+(with-test-prefix/c&e "rewinding prompts"
   (pass-if "nested prompts"
     (let ((k (% 'a
                 (% 'b
@@ -223,11 +235,11 @@
                 (lambda (k) k))))
       (k))))
 
-(with-test-prefix "abort to unknown prompt"
+(with-test-prefix/c&e "abort to unknown prompt"
   (pass-if-exception "foo" '(misc-error . "^Abort to unknown prompt")
                      (abort-to-prompt 'does-not-exist)))
 
-(with-test-prefix "the-vm"
+(with-test-prefix/c&e "the-vm"
 
   (pass-if "unwind changes VMs"
     (let ((new-vm  (make-vm))


hooks/post-receive
-- 
GNU Guile



reply via email to

[Prev in Thread] Current Thread [Next in Thread]