From 3134de4d87deff0c6bfe6def1ffa69bf8a67acf8 Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Sat, 16 Jul 2011 17:59:15 -0400 Subject: [PATCH] Renaming TestAndBranch to TestAndJump, since I want to have a dedicated branch statement that reuses JavaScript's native if --- compiler/bootstrapped-primitives.rkt | 4 ++-- compiler/compiler.rkt | 18 +++++++++--------- compiler/il-structs.rkt | 6 +++--- compiler/optimize-il.rkt | 2 +- js-assembler/assemble.rkt | 8 ++++---- js-assembler/collect-jump-targets.rkt | 4 ++-- simulator/simulator.rkt | 8 ++++---- tests/test-assemble.rkt | 20 ++++++++++---------- tests/test-simulator.rkt | 20 ++++++++++---------- 9 files changed, 45 insertions(+), 45 deletions(-) diff --git a/compiler/bootstrapped-primitives.rkt b/compiler/bootstrapped-primitives.rkt index 6e555ea..a796a5f 100644 --- a/compiler/bootstrapped-primitives.rkt +++ b/compiler/bootstrapped-primitives.rkt @@ -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. diff --git a/compiler/compiler.rkt b/compiler/compiler.rkt index d4d6d75..e31633a 100644 --- a/compiler/compiler.rkt +++ b/compiler/compiler.rkt @@ -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))) diff --git a/compiler/il-structs.rkt b/compiler/il-structs.rkt index 515da30..75b03ea 100644 --- a/compiler/il-structs.rkt +++ b/compiler/il-structs.rkt @@ -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) diff --git a/compiler/optimize-il.rkt b/compiler/optimize-il.rkt index c793607..36c37a4 100644 --- a/compiler/optimize-il.rkt +++ b/compiler/optimize-il.rkt @@ -80,7 +80,7 @@ [(GotoStatement? stmt) #f] - [(TestAndBranchStatement? stmt) + [(TestAndJumpStatement? stmt) #f] [(PopEnvironment? stmt) diff --git a/js-assembler/assemble.rkt b/js-assembler/assemble.rkt index 52681ba..da69908 100644 --- a/js-assembler/assemble.rkt +++ b/js-assembler/assemble.rkt @@ -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) diff --git a/js-assembler/collect-jump-targets.rkt b/js-assembler/collect-jump-targets.rkt index 17c5e4c..2d63ab7 100644 --- a/js-assembler/collect-jump-targets.rkt +++ b/js-assembler/collect-jump-targets.rkt @@ -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) diff --git a/simulator/simulator.rkt b/simulator/simulator.rkt index c3997ae..40e5bf0 100644 --- a/simulator/simulator.rkt +++ b/simulator/simulator.rkt @@ -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))) diff --git a/tests/test-assemble.rkt b/tests/test-assemble.rkt index 42a6354..c080982 100644 --- a/tests/test-assemble.rkt +++ b/tests/test-assemble.rkt @@ -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)) diff --git a/tests/test-simulator.rkt b/tests/test-simulator.rkt index f06343c..1f51bd4 100644 --- a/tests/test-simulator.rkt +++ b/tests/test-simulator.rkt @@ -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))