[Guile-commits] GNU Guile branch, wip-cps-bis, updated. v2.1.0-206-g5c9d29e

[Mark H Weaver]

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=5c9d29ef53d9bcaa79538ba8467c6a85432b18fe

The branch, wip-cps-bis has been updated
       via  5c9d29ef53d9bcaa79538ba8467c6a85432b18fe (commit)
      from  145911fc6f661db233e8a2458605b587836e3474 (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 5c9d29ef53d9bcaa79538ba8467c6a85432b18fe
Author: Mark H Weaver <address@hidden>
Date:   Sat Aug 17 06:38:53 2013 -0400

    RTL: 'return-values' instruction assumes 'reset-frame' has been called.
    
    * libguile/vm-engine.c (return-values): Remove NVALUES operand.
      Don't reset the frame.
    
    * module/language/cps/compile-rtl.scm (emit-rtl-sequence): Adapt.
    
    * test-suite/tests/rtl-compilation.test: Add tests.

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

Summary of changes:
 libguile/vm-engine.c                  |   11 ++++-------
 module/language/cps/compile-rtl.scm   |    3 ++-
 test-suite/tests/rtl-compilation.test |   31 +++++++++++++++++++++++++++++++
 3 files changed, 37 insertions(+), 8 deletions(-)

diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 396a8d5..a422d1e 100644
--- a/libguile/vm-engine.c
+++ b/libguile/vm-engine.c
@@ -1087,22 +1087,19 @@ RTL_VM_NAME (SCM vm, SCM program, SCM *argv, size_t 
nargs_)
       RETURN_ONE_VALUE (LOCAL_REF (src));
     }
 
-  /* return-values nvalues:24
+  /* return-values _:24
    *
    * Return a number of values from a call frame.  This opcode
    * corresponds to an application of `values' in tail position.  As
    * with tail calls, we expect that the values have already been
    * shuffled down to a contiguous array starting at slot 1.
+   * We also expect the frame has already been reset.
    */
-  VM_DEFINE_OP (6, return_values, "return-values", OP1 (U8_U24))
+  VM_DEFINE_OP (6, return_values, "return-values", OP1 (U8_X24))
     {
-      scm_t_uint32 nvalues;
+      scm_t_uint32 nvalues _GL_UNUSED = FRAME_LOCALS_COUNT();
       SCM *base = fp;
 
-      SCM_UNPACK_RTL_24 (op, nvalues);
-
-      RESET_FRAME (nvalues + 1);
-
       VM_HANDLE_INTERRUPTS;
       ip = SCM_FRAME_RTL_MV_RETURN_ADDRESS (fp);
       fp = vp->fp = SCM_FRAME_DYNAMIC_LINK (fp);
diff --git a/module/language/cps/compile-rtl.scm 
b/module/language/cps/compile-rtl.scm
index 3d1a6d8..c4d4d17 100644
--- a/module/language/cps/compile-rtl.scm
+++ b/module/language/cps/compile-rtl.scm
@@ -134,7 +134,8 @@
                         ((src . dst) (emit `(mov ,dst ,src))))
                        (lookup-parallel-moves label moves))
              (for-each maybe-load-constant tail-slots args))
-           (emit `(return-values ,(length args))))
+           (emit `(reset-frame ,(1+ (length args))))
+           (emit `(return-values)))
           (($ $primcall 'return (arg))
            (emit `(return ,(slot arg))))))
 
diff --git a/test-suite/tests/rtl-compilation.test 
b/test-suite/tests/rtl-compilation.test
index ca27181..0ff7b3f 100644
--- a/test-suite/tests/rtl-compilation.test
+++ b/test-suite/tests/rtl-compilation.test
@@ -56,6 +56,37 @@
       (let ((result (run-rtl '(set! v 1) #:env mod)))
         (list result (module-ref mod 'v)))))
 
+  (pass-if-equal "top-level apply [single value]"
+      8
+    (let ((mod (make-fresh-user-module)))
+      (module-define! mod 'args '(2 3))
+      (run-rtl '(apply expt args) #:env mod)))
+
+  (pass-if-equal "top-level apply [zero values]"
+      '()
+    (let ((mod (make-fresh-user-module)))
+      (module-define! mod 'proc (lambda () (values)))
+      (module-define! mod 'args '())
+      (call-with-values
+          (lambda () (run-rtl '(apply proc args) #:env mod))
+        list)))
+
+  (pass-if-equal "top-level apply [two values]"
+      '(1 2)
+    (let ((mod (make-fresh-user-module)))
+      (module-define! mod 'proc (lambda (n d) (floor/ n d)))
+      (module-define! mod 'args '(5 3))
+      (call-with-values
+          (lambda () (run-rtl '(apply proc args) #:env mod))
+        list)))
+
+  (pass-if-equal "call-with-values"
+      '(1 2 3)
+    ((run-rtl '(lambda (n d)
+                 (call-with-values (lambda () (floor/ n d))
+                   (lambda (q r) (list q r (+ q r))))))
+     5 3))
+
   (pass-if-equal cons
       (run-rtl 'cons))
 


hooks/post-receive
-- 
GNU Guile