From c78f6018be41b57da16532867f593891529c22a1 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Tue, 12 Apr 2011 16:53:50 -0400 Subject: [PATCH] adding test cases for values. need to add binding forms for multiple values next --- NOTES | 79 +++++++++++++++++++++++++++++++++++++ assemble.rkt | 4 ++ bootstrapped-primitives.rkt | 18 +++++++-- il-structs.rkt | 2 + simulator.rkt | 13 +++--- test-compiler.rkt | 3 ++ 6 files changed, 110 insertions(+), 9 deletions(-) diff --git a/NOTES b/NOTES index e305a90..bc47c83 100644 --- a/NOTES +++ b/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. + + +\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ + + + + + + ---------------------------------------------------------------------- diff --git a/assemble.rkt b/assemble.rkt index 48bf450..81fb2b6 100644 --- a/assemble.rkt +++ b/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))) diff --git a/bootstrapped-primitives.rkt b/bootstrapped-primitives.rkt index 8fc9aa0..19eb239 100644 --- a/bootstrapped-primitives.rkt +++ b/bootstrapped-primitives.rkt @@ -161,16 +161,26 @@ ;; values - (let ([after-values (make-label 'afterValues)] - [values-entry (make-label 'valuesEntry)]) - `(,(make-GotoStatement (make-Label after-values)) + (let ([after-values-body-defn (make-label 'afterValues)] + [values-entry (make-label 'valuesEntry)] + [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) diff --git a/il-structs.rkt b/il-structs.rkt index 239fcea..bdf0200 100644 --- a/il-structs.rkt +++ b/il-structs.rkt @@ -245,6 +245,8 @@ ;; register -> boolean ;; Meant to branch when the register value is false. 'false? + + 'one? ;; register -> boolean ;; Meant to branch when the register value is a primitive diff --git a/simulator.rkt b/simulator.rkt index 8e8ae3b..0c3139c 100644 --- a/simulator.rkt +++ b/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 - [(eq? test 'false?) - (not argval)] - [(eq? test 'primitive-procedure?) - (primitive-proc? argval)]) + (if (let: ([v : Boolean (cond + [(eq? test 'false?) + (not argval)] + [(eq? test 'one?) + (= (ensure-natural argval) 1)] + [(eq? test 'primitive-procedure?) + (primitive-proc? argval)])]) + v) (jump! m (TestAndBranchStatement-label stmt)) 'ok))) diff --git a/test-compiler.rkt b/test-compiler.rkt index 0365088..ec9e1c6 100644 --- a/test-compiler.rkt +++ b/test-compiler.rkt @@ -1076,6 +1076,9 @@ #:with-bootstrapping? #t) +(test '(values 3) + 3 + #:with-bootstrapping? #t)