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

6
compiler/il-structs.rkt
View File

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

2
compiler/optimize-il.rkt
View File

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

8
js-assembler/assemble.rkt
View File

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

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

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

8
simulator/simulator.rkt
View File

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

20
tests/test-assemble.rkt
View File

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

20
tests/test-simulator.rkt
View File

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