adding test cases for values. need to add binding forms for multiple values next

NOTES

@@ -57,6 +57,85 @@ that just pops those values off.
 
 
 
+Before introducing the multiple-value jumps
+(172b1d9e5de823b53a6705fc87babfdd61152924), test-conform-browser
+reports the following times:
+
+fermi ~/work/js-sicp-5-5 $ racket test-conform-browser.rkt 
+running test... ok (5248 milliseconds)
+fermi ~/work/js-sicp-5-5 $ racket test-conform-browser.rkt 
+running test... ok (5478 milliseconds)
+fermi ~/work/js-sicp-5-5 $ racket test-conform-browser.rkt 
+running test... ok (5501 milliseconds)
+fermi ~/work/js-sicp-5-5 $ racket test-conform-browser.rkt 
+running test... ok (5853 milliseconds)
+fermi ~/work/js-sicp-5-5 $ racket test-conform-browser.rkt 
+running test... ok (5532 milliseconds)
+fermi ~/work/js-sicp-5-5 $ racket test-conform-browser.rkt 
+running test... ok (5498 milliseconds)
+fermi ~/work/js-sicp-5-5 $ racket test-conform-browser.rkt 
+running test... ok (5351 milliseconds)
+fermi ~/work/js-sicp-5-5 $ racket test-conform-browser.rkt 
+running test... ok (5464 milliseconds)
+fermi ~/work/js-sicp-5-5 $ racket test-conform-browser.rkt 
+running test... ok (5545 milliseconds)
+fermi ~/work/js-sicp-5-5 $ racket test-conform-browser.rkt 
+running test... ok (5405 milliseconds)
+
+
+After introducing the mutiple value jumps targets
+(cc1c156df79bab09ca37164e75ae0afe0ac1b0d0), test-conform-browser is
+reporting the following times:
+
+
+running test... ok (5281 milliseconds)
+fermi ~/work/js-sicp-5-5 $ racket test-conform-browser.rkt 
+running test... ok (5554 milliseconds)
+fermi ~/work/js-sicp-5-5 $ racket test-conform-browser.rkt 
+running test... ok (5588 milliseconds)
+fermi ~/work/js-sicp-5-5 $ racket test-conform-browser.rkt 
+running test... ok (5509 milliseconds)
+fermi ~/work/js-sicp-5-5 $ racket test-conform-browser.rkt 
+running test... ok (5428 milliseconds)
+fermi ~/work/js-sicp-5-5 $ racket test-conform-browser.rkt 
+running test... ok (5387 milliseconds)
+fermi ~/work/js-sicp-5-5 $ racket test-conform-browser.rkt 
+running test... ok (5539 milliseconds)
+fermi ~/work/js-sicp-5-5 $ racket test-conform-browser.rkt 
+running test... ok (5355 milliseconds)
+fermi ~/work/js-sicp-5-5 $ racket test-conform-browser.rkt 
+running test... ok (5551 milliseconds)
+fermi ~/work/js-sicp-5-5 $ racket test-conform-browser.rkt 
+running test... ok (5331 milliseconds)
+
+
+
+At a rough glance, I see no appreciable extra cost for this program,
+since it doesn't use multiple-value-return.  Thankfully, it looks like
+the JIT in JavaScript isn't significantly hurt when we set the
+attribute to the procedure.
+
+
+
+
+What's left to do:
+
+    forms for using the values coming from multiple value returns
+    (with-values, define-values, let-values)
+
+    runtime error traps for contexts that must not receive multiple values.
+
+    fixing apply definition so it doesn't return multiple values when
+    given a single argument.
+
+
+\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
+
+
+
+
+
+
 
 
 ----------------------------------------------------------------------

assemble.rkt

@@ -320,6 +320,10 @@ EOF
                 (format "if (! ~a) { ~a }"
                         (assemble-reg (make-Reg (TestAndBranchStatement-register stmt)))
                         (assemble-jump (make-Label (TestAndBranchStatement-label stmt))))]
+               [(eq? test 'one?)
+                (format "if (~a === 1) { ~a }"
+                        (assemble-reg (make-Reg (TestAndBranchStatement-register stmt)))
+                        (assemble-jump (make-Label (TestAndBranchStatement-label stmt))))]
                [(eq? test 'primitive-procedure?)
                 (format "if (typeof(~a) === 'function') { ~a };"
                         (assemble-reg (make-Reg (TestAndBranchStatement-register stmt)))

bootstrapped-primitives.rkt

@@ -161,16 +161,26 @@
   
    
    ;; values
-   (let ([after-values (make-label 'afterValues)]
+   (let ([after-values-body-defn (make-label 'afterValues)]
-         [values-entry (make-label 'valuesEntry)])
+         [values-entry (make-label 'valuesEntry)]
-     `(,(make-GotoStatement (make-Label after-values))
+         [on-single-value (make-label 'onSingleValue)])
+     `(,(make-GotoStatement (make-Label after-values-body-defn))
        ,values-entry
+       ,(make-TestAndBranchStatement 'one? 'argcount on-single-value)
        ;; values simply keeps the values on the stack, preserves the argcount, and does a return
        ;; to the multiple-value-return address.
        ,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel/MultipleValueReturn))
        ,(make-PopControlFrame)
        ,(make-GotoStatement (make-Reg 'proc))
-       ,after-values
+       ,on-single-value
+       ,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel))
+       ,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0 #f))
+       ,(make-PopEnvironment (make-Const 1) (make-Const 0))
+       ,(make-PopControlFrame)
+       ,(make-GotoStatement (make-Reg 'proc))
+       
+       
+       ,after-values-body-defn
        ,(make-AssignPrimOpStatement (make-PrimitivesReference 'values)
                                     (make-MakeCompiledProcedure values-entry
                                                                 (make-ArityAtLeast 0) 

il-structs.rkt

@@ -246,6 +246,8 @@
                             ;; Meant to branch when the register value is false.
                             'false?
 
+                            'one?
+                            
                             ;; register -> boolean
                             ;; Meant to branch when the register value is a primitive
                             ;; procedure

simulator.rkt

@@ -197,11 +197,14 @@
 (define (step-test-and-branch! m stmt)
   (let: ([test : PrimitiveTest (TestAndBranchStatement-op stmt)]
          [argval : SlotValue (lookup-atomic-register m (TestAndBranchStatement-register stmt))])
-        (if (cond
+        (if (let: ([v : Boolean (cond
-              [(eq? test 'false?)
+                                  [(eq? test 'false?)
-               (not argval)]
+                                   (not argval)]
-              [(eq? test 'primitive-procedure?)
+                                  [(eq? test 'one?)
-               (primitive-proc? argval)])
+                                   (= (ensure-natural argval) 1)]
+                                  [(eq? test 'primitive-procedure?)
+                                   (primitive-proc? argval)])])
+                  v)
             (jump! m (TestAndBranchStatement-label stmt))
             'ok)))
 

test-compiler.rkt

@@ -1076,6 +1076,9 @@
         #:with-bootstrapping? #t)
 
 
+(test '(values 3)
+      3
+      #:with-bootstrapping? #t)