suzanne.soy/whalesong
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Renaming TestAndBranch to TestAndJump, since I want to have a dedicated branch statement that reuses JavaScript's native if

Browse Source
This commit is contained in:
Danny Yoo 2011-07-16 17:59:15 -04:00
parent dc14753a73
commit 3134de4d87
9 changed files with 45 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
compiler/bootstrapped-primitives.rkt
View File

@ -194,8 +194,8 @@
[on-single-value (make-label 'onSingleValue)])
`(,(make-GotoStatement (make-Label after-values-body-defn))
,values-entry
,(make-TestAndBranchStatement (make-TestOne (make-Reg 'argcount)) on-single-value)
,(make-TestAndBranchStatement (make-TestZero (make-Reg 'argcount)) on-zero-values)
,(make-TestAndJumpStatement (make-TestOne (make-Reg 'argcount)) on-single-value)
,(make-TestAndJumpStatement (make-TestZero (make-Reg 'argcount)) on-zero-values)
;; Common case: we're running multiple values. Put the first in the val register
;; and go to the multiple value return.

18
compiler/compiler.rkt
View File

@ -388,7 +388,7 @@
[on-return (make-LinkedLabel (make-label 'onReturn)
on-return-multiple)])
(make-instruction-sequence
`(,(make-TestAndBranchStatement (make-TestTrue
`(,(make-TestAndJumpStatement (make-TestTrue
(make-IsModuleLinked a-module-name))
linked)
;; TODO: raise an exception here that says that the module hasn't been
@ -398,7 +398,7 @@
(ModuleLocator-name a-module-name))))
,(make-GotoStatement (make-Label already-loaded))
,linked
,(make-TestAndBranchStatement (make-TestTrue
,(make-TestAndJumpStatement (make-TestTrue
(make-IsModuleInvoked a-module-name))
already-loaded)
,(make-PushControlFrame/Call on-return)
@ -559,7 +559,7 @@
p-code
(append-instruction-sequences
(make-instruction-sequence
`(,(make-TestAndBranchStatement (make-TestFalse (make-Reg 'val))
`(,(make-TestAndJumpStatement (make-TestFalse (make-Reg 'val))
f-branch)))
t-branch
c-code
@ -643,7 +643,7 @@
;; Evaluate the first expression in a multiple-value context, and get the values on the stack.
(compile (first seq) cenv 'val next-linkage/keep-multiple-on-stack)
(make-instruction-sequence
`(,(make-TestAndBranchStatement (make-TestZero (make-Reg 'argcount)) after-first-seq)
`(,(make-TestAndJumpStatement (make-TestZero (make-Reg 'argcount)) after-first-seq)
,(make-PushImmediateOntoEnvironment (make-Reg 'val) #f)))
after-first-seq
;; At this time, the argcount values are on the stack.
@ -665,7 +665,7 @@
,(make-PerformStatement (make-SpliceListIntoStack! (make-Const 0)))
,(make-AssignImmediateStatement 'argcount (make-ControlFrameTemporary 'pendingBegin0Count))
,(make-PopControlFrame)
,(make-TestAndBranchStatement (make-TestZero (make-Reg 'argcount)) after-values-reinstated)
,(make-TestAndJumpStatement (make-TestZero (make-Reg 'argcount)) after-values-reinstated)
,(make-AssignImmediateStatement 'val (make-EnvLexicalReference 0 #f))
,(make-PopEnvironment (make-Const 1) (make-Const 0))
,after-values-reinstated)))])
@ -913,7 +913,7 @@
[i : Natural])
(let ([not-match (make-label 'notMatch)])
(make-instruction-sequence
`(,(make-TestAndBranchStatement
`(,(make-TestAndJumpStatement
(make-TestClosureArityMismatch
(make-CompiledProcedureClosureReference
(make-Reg 'proc)
@ -1430,7 +1430,7 @@
(make-NextLinkage (linkage-context linkage))])
(append-instruction-sequences
(make-instruction-sequence
`(,(make-TestAndBranchStatement (make-TestPrimitiveProcedure
`(,(make-TestAndJumpStatement (make-TestPrimitiveProcedure
(make-Reg 'proc))
primitive-branch)))
@ -1645,7 +1645,7 @@
(make-instruction-sequence
`(
;; if the wrong number of arguments come in, die
,(make-TestAndBranchStatement
,(make-TestAndJumpStatement
(make-TestZero (make-SubtractArg (make-Reg 'argcount)
(make-Const context)))
after-value-check)))
@ -2017,7 +2017,7 @@
next-linkage/keep-multiple-on-stack)
(make-instruction-sequence
`(,(make-TestAndBranchStatement (make-TestZero (make-Reg 'argcount)) after-args-evaluated)
`(,(make-TestAndJumpStatement (make-TestZero (make-Reg 'argcount)) after-args-evaluated)
;; In the common case where we do get values back, we push val onto the stack too,
;; so that we have n values on the stack before we jump to the procedure call.
,(make-PushImmediateOntoEnvironment (make-Reg 'val) #f)))

6
compiler/il-structs.rkt
View File

@ -125,7 +125,7 @@
PerformStatement
GotoStatement
TestAndBranchStatement
TestAndJumpStatement
PopEnvironment
PushEnvironment
@ -221,8 +221,8 @@
(define-struct: TestAndBranchStatement ([op : PrimitiveTest]
[label : Symbol])
(define-struct: TestAndJumpStatement ([op : PrimitiveTest]
[label : Symbol])
#:transparent)

2
compiler/optimize-il.rkt
View File

@ -80,7 +80,7 @@
[(GotoStatement? stmt)
#f]
[(TestAndBranchStatement? stmt)
[(TestAndJumpStatement? stmt)
#f]
[(PopEnvironment? stmt)

8
js-assembler/assemble.rkt
View File

@ -85,7 +85,7 @@ EOF
(next)]
[(PerformStatement? stmt)
(next)]
[(TestAndBranchStatement? stmt)
[(TestAndJumpStatement? stmt)
(next)]
[(GotoStatement? stmt)
(next)]
@ -150,10 +150,10 @@ EOF
[(PerformStatement? stmt)
(assemble-op-statement (PerformStatement-op stmt))]
[(TestAndBranchStatement? stmt)
(let*: ([test : PrimitiveTest (TestAndBranchStatement-op stmt)]
[(TestAndJumpStatement? stmt)
(let*: ([test : PrimitiveTest (TestAndJumpStatement-op stmt)]
[jump : String (assemble-jump
(make-Label (TestAndBranchStatement-label stmt)))])
(make-Label (TestAndJumpStatement-label stmt)))])
;; to help localize type checks, we add a type annotation here.
(ann (cond
[(TestFalse? test)

4
js-assembler/collect-jump-targets.rkt
View File

@ -43,8 +43,8 @@
(collect-primitive-operator (AssignPrimOpStatement-op stmt))]
[(PerformStatement? stmt)
(collect-primitive-command (PerformStatement-op stmt))]
[(TestAndBranchStatement? stmt)
(list (TestAndBranchStatement-label stmt))]
[(TestAndJumpStatement? stmt)
(list (TestAndJumpStatement-label stmt))]
[(GotoStatement? stmt)
(collect-input (GotoStatement-target stmt))]
[(PushEnvironment? stmt)

8
simulator/simulator.rkt
View File

@ -135,7 +135,7 @@
(step-perform! m i)]
[(GotoStatement? i)
(step-goto! m i)]
[(TestAndBranchStatement? i)
[(TestAndJumpStatement? i)
(step-test-and-branch! m i)]
[(PopEnvironment? i)
(step-pop-environment! m i)]
@ -233,9 +233,9 @@
(let: ([l : Symbol (control-pop! m)])
'ok))
(: step-test-and-branch! (machine TestAndBranchStatement -> 'ok))
(: step-test-and-branch! (machine TestAndJumpStatement -> 'ok))
(define (step-test-and-branch! m stmt)
(let: ([test : PrimitiveTest (TestAndBranchStatement-op stmt)])
(let: ([test : PrimitiveTest (TestAndJumpStatement-op stmt)])
(if (ann (cond
[(TestFalse? test)
(not (evaluate-oparg m (TestFalse-operand test)))]
@ -256,7 +256,7 @@
(evaluate-oparg m (TestClosureArityMismatch-n test)))])
(not (arity-match? (closure-arity proc) n)))])
Boolean)
(jump! m (TestAndBranchStatement-label stmt))
(jump! m (TestAndJumpStatement-label stmt))
'ok)))

20
tests/test-assemble.rkt
View File

@ -286,7 +286,7 @@
(test (E-many `(,(make-AssignImmediateStatement 'val (make-Const 42))
,(make-TestAndBranchStatement (make-TestFalse (make-Reg 'val)) 'onFalse)
,(make-TestAndJumpStatement (make-TestFalse (make-Reg 'val)) 'onFalse)
,(make-AssignImmediateStatement 'val (make-Const 'ok))
,(make-GotoStatement (make-Label 'end))
onFalse
@ -296,7 +296,7 @@
;; TestAndBranch: try the false branch
(test (E-many `(,(make-AssignImmediateStatement 'val (make-Const #f))
,(make-TestAndBranchStatement (make-TestFalse (make-Reg 'val)) 'onFalse)
,(make-TestAndJumpStatement (make-TestFalse (make-Reg 'val)) 'onFalse)
,(make-AssignImmediateStatement 'val (make-Const 'not-ok))
,(make-GotoStatement (make-Label 'end))
onFalse
@ -306,7 +306,7 @@
;; Test for primitive procedure
(test (E-many `(,(make-AssignImmediateStatement 'val (make-Const '+))
,(make-TestAndBranchStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue)
,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue)
,(make-AssignImmediateStatement 'val (make-Const 'ok))
,(make-GotoStatement (make-Label 'end))
onTrue
@ -317,7 +317,7 @@
;; Give a primitive procedure in val
(test (E-many `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(+)))
,(make-AssignImmediateStatement 'val (make-EnvPrefixReference 0 0))
,(make-TestAndBranchStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue)
,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue)
,(make-AssignImmediateStatement 'val (make-Const 'not-ok))
,(make-GotoStatement (make-Label 'end))
onTrue
@ -328,7 +328,7 @@
;; Give a primitive procedure in proc, but test val
(test (E-many `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(+)))
,(make-AssignImmediateStatement 'proc (make-EnvPrefixReference 0 0))
,(make-TestAndBranchStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue)
,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'onTrue)
,(make-AssignImmediateStatement 'val (make-Const 'not-a-procedure))
,(make-GotoStatement (make-Label 'end))
onTrue
@ -339,7 +339,7 @@
;; Give a primitive procedure in proc and test proc
(test (E-many `(,(make-PerformStatement (make-ExtendEnvironment/Prefix! '(+)))
,(make-AssignImmediateStatement 'proc (make-EnvPrefixReference 0 0))
,(make-TestAndBranchStatement (make-TestPrimitiveProcedure (make-Reg 'proc)) 'onTrue)
,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'proc)) 'onTrue)
,(make-AssignImmediateStatement 'val (make-Const 'not-a-procedure))
,(make-GotoStatement (make-Label 'end))
onTrue
@ -438,7 +438,7 @@
,(make-AssignPrimOpStatement
'proc
(make-MakeCompiledProcedure 'procedure-entry 0 (list) 'procedure-entry))
,(make-TestAndBranchStatement
,(make-TestAndJumpStatement
(make-TestClosureArityMismatch (make-Reg 'proc) (make-Const 0))
'bad)
,(make-AssignImmediateStatement 'val (make-Const 'ok))
@ -455,7 +455,7 @@
,(make-AssignPrimOpStatement
'proc
(make-MakeCompiledProcedure 'procedure-entry 0 (list) 'procedure-entry))
,(make-TestAndBranchStatement
,(make-TestAndJumpStatement
(make-TestClosureArityMismatch (make-Reg 'proc) (make-Const 1))
'ok)
,(make-AssignImmediateStatement 'val (make-Const 'bad))
@ -471,7 +471,7 @@
,(make-AssignPrimOpStatement
'proc
(make-MakeCompiledProcedure 'procedure-entry (make-ArityAtLeast 2) (list) 'procedure-entry))
,(make-TestAndBranchStatement
,(make-TestAndJumpStatement
(make-TestClosureArityMismatch (make-Reg 'proc) (make-Const 0))
'ok)
,(make-AssignImmediateStatement 'val (make-Const 'bad))
@ -487,7 +487,7 @@
,(make-AssignPrimOpStatement
'proc
(make-MakeCompiledProcedure 'procedure-entry (make-ArityAtLeast 2) (list) 'procedure-entry))
,(make-TestAndBranchStatement
,(make-TestAndJumpStatement
(make-TestClosureArityMismatch (make-Reg 'proc) (make-Const 2))
'bad)
,(make-AssignImmediateStatement 'val (make-Const 'ok))

20
tests/test-simulator.rkt
View File

@ -209,7 +209,7 @@
;; TestAndBranch: try the true branch
(let ([m (new-machine `(,(make-AssignImmediateStatement 'val (make-Const 42))
,(make-TestAndBranchStatement (make-TestFalse (make-Reg 'val)) 'on-false)
,(make-TestAndJumpStatement (make-TestFalse (make-Reg 'val)) 'on-false)
,(make-AssignImmediateStatement 'val (make-Const 'ok))
,(make-GotoStatement (make-Label 'end))
on-false
@ -219,7 +219,7 @@
'ok))
;; TestAndBranch: try the false branch
(let ([m (new-machine `(,(make-AssignImmediateStatement 'val (make-Const #f))
,(make-TestAndBranchStatement (make-TestFalse (make-Reg 'val)) 'on-false)
,(make-TestAndJumpStatement (make-TestFalse (make-Reg 'val)) 'on-false)
,(make-AssignImmediateStatement 'val (make-Const 'not-ok))
,(make-GotoStatement (make-Label 'end))
on-false
@ -229,7 +229,7 @@
'ok))
;; Test for primitive procedure
(let ([m (new-machine `(,(make-AssignImmediateStatement 'val (make-Const '+))
,(make-TestAndBranchStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'on-true)
,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'on-true)
,(make-AssignImmediateStatement 'val (make-Const 'ok))
,(make-GotoStatement (make-Label 'end))
on-true
@ -239,7 +239,7 @@
'ok))
;; Give a primitive procedure in val
(let ([m (new-machine `(,(make-AssignImmediateStatement 'val (make-Const (lookup-primitive '+)))
,(make-TestAndBranchStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'on-true)
,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'on-true)
,(make-AssignImmediateStatement 'val (make-Const 'not-ok))
,(make-GotoStatement (make-Label 'end))
on-true
@ -249,7 +249,7 @@
'ok))
;; Give a primitive procedure in proc, but test val
(let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const (lookup-primitive '+)))
,(make-TestAndBranchStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'on-true)
,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'val)) 'on-true)
,(make-AssignImmediateStatement 'val (make-Const 'not-a-procedure))
,(make-GotoStatement (make-Label 'end))
on-true
@ -259,7 +259,7 @@
'not-a-procedure))
;; Give a primitive procedure in proc and test proc
(let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const (lookup-primitive '+)))
,(make-TestAndBranchStatement (make-TestPrimitiveProcedure (make-Reg 'proc)) 'on-true)
,(make-TestAndJumpStatement (make-TestPrimitiveProcedure (make-Reg 'proc)) 'on-true)
,(make-AssignImmediateStatement 'val (make-Const 'not-a-procedure))
,(make-GotoStatement (make-Label 'end))
on-true
@ -675,7 +675,7 @@
,(make-AssignPrimOpStatement
'proc
(make-MakeCompiledProcedure 'procedure-entry 0 (list) 'procedure-entry))
,(make-TestAndBranchStatement
,(make-TestAndJumpStatement
(make-TestClosureArityMismatch (make-Reg 'proc) (make-Const 0))
'bad)
,(make-AssignImmediateStatement 'val (make-Const 'ok))
@ -691,7 +691,7 @@
,(make-AssignPrimOpStatement
'proc
(make-MakeCompiledProcedure 'procedure-entry 0 (list) 'procedure-entry))
,(make-TestAndBranchStatement
,(make-TestAndJumpStatement
(make-TestClosureArityMismatch (make-Reg 'proc) (make-Const 1))
'ok)
,(make-AssignImmediateStatement 'val (make-Const 'bad))
@ -707,7 +707,7 @@
,(make-AssignPrimOpStatement
'proc
(make-MakeCompiledProcedure 'procedure-entry (make-ArityAtLeast 2) (list) 'procedure-entry))
,(make-TestAndBranchStatement
,(make-TestAndJumpStatement
(make-TestClosureArityMismatch (make-Reg 'proc) (make-Const 0))
'ok)
,(make-AssignImmediateStatement 'val (make-Const 'bad))
@ -723,7 +723,7 @@
,(make-AssignPrimOpStatement
'proc
(make-MakeCompiledProcedure 'procedure-entry (make-ArityAtLeast 2) (list) 'procedure-entry))
,(make-TestAndBranchStatement
,(make-TestAndJumpStatement
(make-TestClosureArityMismatch (make-Reg 'proc) (make-Const 2))
'bad)
,(make-AssignImmediateStatement 'val (make-Const 'ok))