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.

3 files changed, 37 insertions, 8 deletions

diff --git a/libguile/vm-engine.c b/libguile/vm-engine.c
index 396a8d5d6..a422d1ef2 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 3d1a6d83e..c4d4d1736 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 ca2718192..0ff7b3fa4 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))