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

This commit is contained in:
Danny Yoo 2011-04-12 16:53:50 -04:00
parent cc1c156df7
commit c78f6018be
6 changed files with 110 additions and 9 deletions

79
NOTES
View File

@ -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.
\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\
----------------------------------------------------------------------

View File

@ -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)))

View File

@ -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)

View File

@ -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

View File

@ -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)))

View File

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