From b8cfd43a50091eb6d6ecc0bf3574d40a1e54013c Mon Sep 17 00:00:00 2001
From: Danny Yoo <dyoo@cs.wpi.edu>
Date: Fri, 16 Sep 2011 17:04:15 -0400
Subject: [PATCH] multiple value return optimizations

---
 js-assembler/assemble-helpers.rkt   | 38 ++++++++++++++---------------
 js-assembler/assemble.rkt           | 19 +++++++++------
 js-assembler/runtime-src/runtime.js |  4 +--
 3 files changed, 33 insertions(+), 28 deletions(-)

diff --git a/js-assembler/assemble-helpers.rkt b/js-assembler/assemble-helpers.rkt
index a501723..b99db97 100644
--- a/js-assembler/assemble-helpers.rkt
+++ b/js-assembler/assemble-helpers.rkt
@@ -19,6 +19,7 @@
          assemble-prefix-reference
          assemble-whole-prefix-reference
          assemble-reg
+         munge-label-name
          assemble-label
          assemble-listof-assembled-values
 	 assemble-default-continuation-prompt-tag
@@ -295,27 +296,26 @@
       "M.a"])))
 
 
+(: munge-label-name (Label -> String))
+(define (munge-label-name a-label)
+  (define chunks
+    (regexp-split #rx"[^a-zA-Z0-9]+"
+                  (symbol->string (Label-name a-label))))
+  (cond
+   [(empty? chunks)
+    (error "impossible: empty label ~s" a-label)]
+   [(empty? (rest chunks))
+    (string-append "_" (first chunks))]
+   [else
+    (string-append "_"
+                   (first chunks)
+                   (apply string-append (map string-titlecase (rest chunks))))]))
+
+
 
 (: assemble-label (Label Blockht -> String))
 (define (assemble-label a-label Blockht)
-  (define a-block (hash-ref Blockht (Label-name a-label)))
-  (cond
-   [(block-looks-like-context-expected-values? a-block)
-    => (lambda (expected)
-         (format "RT.si_context_expected(~a)" expected))]
-   [else
-    (define chunks
-      (regexp-split #rx"[^a-zA-Z0-9]+"
-                    (symbol->string (Label-name a-label))))
-    (cond
-     [(empty? chunks)
-      (error "impossible: empty label ~s" a-label)]
-     [(empty? (rest chunks))
-      (string-append "_" (first chunks))]
-     [else
-      (string-append "_"
-                     (first chunks)
-                     (apply string-append (map string-titlecase (rest chunks))))])]))
+  (munge-label-name a-label))
 
 
 
@@ -333,7 +333,7 @@
 
 (: assemble-control-stack-label/multiple-value-return (ControlStackLabel/MultipleValueReturn -> String))
 (define (assemble-control-stack-label/multiple-value-return a-csl)
-  "M.c[M.c.length-1].label.mvr")
+  "(M.c[M.c.length-1].label.mvr||RT.si_context_expected_1)")
 
 
 
diff --git a/js-assembler/assemble.rkt b/js-assembler/assemble.rkt
index a96bc19..888cc46 100644
--- a/js-assembler/assemble.rkt
+++ b/js-assembler/assemble.rkt
@@ -151,10 +151,12 @@ EOF
                   [(= expected 1)
                    (void)]
                   [else
-                   (fprintf op "~a.mvr=RT.si_context_expected(~a);\n" expected)]))]
+                   (fprintf op "~a.mvr=RT.si_context_expected(~a);\n"
+                            (munge-label-name (make-Label (LinkedLabel-label stmt)))
+                            expected)]))]
            [else
             (fprintf op "~a.mvr=~a;\n" 
-                     (assemble-label (make-Label (LinkedLabel-label stmt)) blockht)
+                     (munge-label-name (make-Label (LinkedLabel-label stmt)))
                      (assemble-label (make-Label (LinkedLabel-linked-to stmt)) blockht))])
           (next)]
          [(DebugPrint? stmt)
@@ -197,11 +199,14 @@ EOF
    [(block-looks-like-context-expected-values? a-basic-block)
     =>
     (lambda (expected)
-      (fprintf op "~a=RT.si_context_expected(~a);\n"
-               (assemble-label (make-Label (BasicBlock-name a-basic-block))
-                               blockht)
-               expected)
-      'ok)]
+      (cond
+       [(= expected 1)
+        'ok]
+       [else
+        (fprintf op "~a=RT.si_context_expected(~a);\n"
+                 (munge-label-name (make-Label (BasicBlock-name a-basic-block)))
+                 expected)
+        'ok]))]
    [else
     (default-assemble-basic-block a-basic-block blockht entry-points function-entry-and-exit-names op)]))
 
diff --git a/js-assembler/runtime-src/runtime.js b/js-assembler/runtime-src/runtime.js
index 1a3e8e8..2466d16 100644
--- a/js-assembler/runtime-src/runtime.js
+++ b/js-assembler/runtime-src/runtime.js
@@ -675,7 +675,8 @@
     // Superinstructions to try to reduce code size.
     var si_context_expected = function(n) {
         if (n === 1) { return si_context_expected_1; }
-        return function(M) { raiseContextExpectedValuesError(M, n); }
+        var f = function(M) { raiseContextExpectedValuesError(M, n); };
+        return f;
     };
     var si_context_expected_1 = function(M) { raiseContextExpectedValuesError(M, 1); }
 
@@ -686,7 +687,6 @@
 
 
 
-
     //////////////////////////////////////////////////////////////////////
     //////////////////////////////////////////////////////////////////////
     //////////////////////////////////////////////////////////////////////