combining test and branch together formally.

This commit is contained in:
dyoo 2011-03-02 17:42:40 -05:00
parent 2a9fe0d72a
commit 8ad291e320
2 changed files with 22 additions and 17 deletions

View File

@ -146,8 +146,10 @@
(append-instruction-sequences p-code
(append-instruction-sequences
(make-instruction-sequence
`(,(make-TestStatement 'false? 'val)
,(make-BranchLabelStatement f-branch)))
`(,(make-TestAndBranchStatement 'false?
'val
f-branch)
))
(append-instruction-sequences
(append-instruction-sequences t-branch c-code)
(append-instruction-sequences f-branch a-code))
@ -293,8 +295,10 @@
(if (eq? linkage 'next) after-call linkage)])
(append-instruction-sequences
(make-instruction-sequence `(,(make-TestStatement 'primitive-procedure? 'proc)
,(make-BranchLabelStatement primitive-branch)))
(make-instruction-sequence
`(,(make-TestAndBranchStatement 'primitive-procedure?
'proc
primitive-branch)))
compiled-branch
(compile-proc-appl n target compiled-linkage)

View File

@ -47,10 +47,11 @@
(define-type UnlabeledStatement (U
AssignImmediateStatement
AssignPrimOpStatement
GotoStatement
PerformStatement
TestStatement
BranchLabelStatement
GotoStatement
TestAndBranchStatement
PopEnv
PopControl
PushEnv
@ -79,17 +80,16 @@
(define-struct: PushControlFrame ([label : Symbol])
#:transparent)
(define-struct: GotoStatement ([target : (U Label Reg)])
#:transparent)
(define-struct: PerformStatement ([op : PrimitiveCommand]
[rands : (Listof (U Label Reg Const))]) #:transparent)
(define-struct: TestStatement ([op : PrimitiveTest]
[register-rand : RegisterSymbol]) #:transparent)
(define-struct: BranchLabelStatement ([label : Symbol]) #:transparent)
[rands : (Listof (U Label Reg Const))])
#:transparent)
(define-struct: TestAndBranchStatement ([op : PrimitiveTest]
[register-rand : RegisterSymbol]
[label : Symbol])
#:transparent)
@ -136,7 +136,8 @@
;; The following is used with TestStatement: each is passed the register-rand and
;; is expected to
(define-type PrimitiveTest (U
;; register -> boolean
@ -149,8 +150,8 @@
'primitive-procedure?
))
(define-type PrimitiveCommand (U
(define-type PrimitiveCommand (U
;; depth pos symbol
;; Assign the value in the val register into
;; the prefix installed at (depth, pos).