[Guile-commits] 09/27: Always emit return-values

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 696339a603b08d2b6a8f87482f63ef41358988e7
Author: Andy Wingo <address@hidden>
Date:   Wed Oct 28 11:20:00 2015 +0000

    Always emit return-values
    
    * module/language/cps/compile-bytecode.scm (compile-function): Remove
      special cases for nullary and unary returns; instead always use
      return-values and rely on hinting to try to place values in the right
      slot already.
    
    * module/system/vm/assembler.scm (emit-init-constants): Use
      return-values.
    
    * module/system/vm/disassembler.scm (code-annotation): Add annotation
      for return-values.
---
 module/language/cps/compile-bytecode.scm |   10 ----------
 module/system/vm/assembler.scm           |    4 ++--
 module/system/vm/disassembler.scm        |    4 ++++
 3 files changed, 6 insertions(+), 12 deletions(-)

diff --git a/module/language/cps/compile-bytecode.scm 
b/module/language/cps/compile-bytecode.scm
index 22af821..1f7c664 100644
--- a/module/language/cps/compile-bytecode.scm
+++ b/module/language/cps/compile-bytecode.scm
@@ -122,16 +122,6 @@
                     ((src . dst) (emit-mov asm (from-sp dst) (from-sp src))))
                    (lookup-parallel-moves label allocation))
          (emit-tail-call-label asm (1+ (length args)) k))
-        (($ $values ())
-         (emit-return-values asm 1))
-        (($ $values (arg))
-         (if (maybe-slot arg)
-             (emit-return asm (from-sp (slot arg)))
-             (begin
-               (when (< frame-size 2)
-                 (emit-alloc-frame asm 2))
-               (emit-load-constant asm (from-sp 1) (constant arg))
-               (emit-return asm (from-sp 1)))))
         (($ $values args)
          (for-each (match-lambda
                     ((src . dst) (emit-mov asm (from-sp dst) (from-sp src))))
diff --git a/module/system/vm/assembler.scm b/module/system/vm/assembler.scm
index d50ab13..c989ec6 100644
--- a/module/system/vm/assembler.scm
+++ b/module/system/vm/assembler.scm
@@ -1243,8 +1243,8 @@ a procedure to do that and return its label.  Otherwise 
return
                       `((begin-program ,label ())
                         (assert-nargs-ee/locals 1 1)
                         ,@(reverse inits)
-                        (load-constant 1 ,*unspecified*)
-                        (return 1)
+                        (load-constant 0 ,*unspecified*)
+                        (return-values 2)
                         (end-program)))
            label))))
 
diff --git a/module/system/vm/disassembler.scm 
b/module/system/vm/disassembler.scm
index 233ba75..5e8b020 100644
--- a/module/system/vm/disassembler.scm
+++ b/module/system/vm/disassembler.scm
@@ -224,6 +224,10 @@ address of that offset."
      (list "~a slot~:p" nlocals))
     (('reset-frame nlocals)
      (list "~a slot~:p" nlocals))
+    (('return-values nlocals)
+     (if (zero? nlocals)
+         (list "all values")
+         (list "~a value~:p" (1- nlocals))))
     (('bind-rest dst)
      (list "~a slot~:p" (1+ dst)))
     (('tail-call nargs proc)