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

renaming PushControlFrame to more specific PushControlFrame/Call, since control frames can be of several types

Browse Source
This commit is contained in:
Danny Yoo 2011-04-14 13:05:05 -04:00
parent d43f1100e3
commit 0c8cd9234c
5 changed files with 25 additions and 24 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
assemble.rkt
View File

@ -139,7 +139,7 @@ EOF
(next)] (next)]
[(PushImmediateOntoEnvironment? stmt) [(PushImmediateOntoEnvironment? stmt)
(next)] (next)]
[(PushControlFrame? stmt) [(PushControlFrame/Call? stmt)
(next)] (next)]
[(PushControlFrame/Prompt? stmt) [(PushControlFrame/Prompt? stmt)
(next)] (next)]
@ -259,8 +259,8 @@ EOF
empty] empty]
[(PushImmediateOntoEnvironment? stmt) [(PushImmediateOntoEnvironment? stmt)
(collect-input (PushImmediateOntoEnvironment-value stmt))] (collect-input (PushImmediateOntoEnvironment-value stmt))]
[(PushControlFrame? stmt) [(PushControlFrame/Call? stmt)
(label->labels (PushControlFrame-label stmt))] (label->labels (PushControlFrame/Call-label stmt))]
[(PushControlFrame/Prompt? stmt) [(PushControlFrame/Prompt? stmt)
(label->labels (PushControlFrame/Prompt-label stmt))] (label->labels (PushControlFrame/Prompt-label stmt))]
[(PopControlFrame? stmt) [(PopControlFrame? stmt)
@ -330,9 +330,9 @@ EOF
[(GotoStatement? stmt) [(GotoStatement? stmt)
(assemble-jump (GotoStatement-target stmt))] (assemble-jump (GotoStatement-target stmt))]
[(PushControlFrame? stmt) [(PushControlFrame/Call? stmt)
(format "MACHINE.control.push(new RUNTIME.CallFrame(~a, MACHINE.proc));" (format "MACHINE.control.push(new RUNTIME.CallFrame(~a, MACHINE.proc));"
(let ([label (PushControlFrame-label stmt)]) (let ([label (PushControlFrame/Call-label stmt)])
(cond (cond
[(symbol? label) label] [(symbol? label) label]
[(LinkedLabel? label) (LinkedLabel-label label)])))] [(LinkedLabel? label) (LinkedLabel-label label)])))]

14
compiler.rkt
View File

@ -968,7 +968,7 @@
proc-return-multiple)]) proc-return-multiple)])
(append-instruction-sequences (append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-PushControlFrame proc-return))) `(,(make-PushControlFrame/Call proc-return)))
maybe-install-jump-address maybe-install-jump-address
(make-instruction-sequence (make-instruction-sequence
`(,(make-GotoStatement entry-point-target))) `(,(make-GotoStatement entry-point-target)))
@ -985,7 +985,7 @@
proc-return-multiple)]) proc-return-multiple)])
(append-instruction-sequences (append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-PushControlFrame proc-return))) `(,(make-PushControlFrame/Call proc-return)))
maybe-install-jump-address maybe-install-jump-address
(make-instruction-sequence (make-instruction-sequence
`(,(make-GotoStatement entry-point-target))) `(,(make-GotoStatement entry-point-target)))
@ -1006,7 +1006,7 @@
proc-return-multiple)]) proc-return-multiple)])
(append-instruction-sequences (append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-PushControlFrame proc-return))) `(,(make-PushControlFrame/Call proc-return)))
maybe-install-jump-address maybe-install-jump-address
(make-instruction-sequence (make-instruction-sequence
`(,(make-GotoStatement entry-point-target))) `(,(make-GotoStatement entry-point-target)))
@ -1023,7 +1023,7 @@
proc-return-multiple)]) proc-return-multiple)])
(append-instruction-sequences (append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-PushControlFrame proc-return))) `(,(make-PushControlFrame/Call proc-return)))
maybe-install-jump-address maybe-install-jump-address
(make-instruction-sequence (make-instruction-sequence
`(,(make-GotoStatement entry-point-target))) `(,(make-GotoStatement entry-point-target)))
@ -1044,7 +1044,7 @@
proc-return-multiple)]) proc-return-multiple)])
(append-instruction-sequences (append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-PushControlFrame proc-return))) `(,(make-PushControlFrame/Call proc-return)))
maybe-install-jump-address maybe-install-jump-address
(make-instruction-sequence (make-instruction-sequence
`(,(make-GotoStatement entry-point-target))) `(,(make-GotoStatement entry-point-target)))
@ -1063,7 +1063,7 @@
proc-return-multiple)]) proc-return-multiple)])
(append-instruction-sequences (append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-PushControlFrame proc-return))) `(,(make-PushControlFrame/Call proc-return)))
maybe-install-jump-address maybe-install-jump-address
(make-instruction-sequence (make-instruction-sequence
`(,(make-GotoStatement entry-point-target))) `(,(make-GotoStatement entry-point-target)))
@ -1297,7 +1297,7 @@
;; FIXME: create separate frame structure here, and don't try to reuse. ;; FIXME: create separate frame structure here, and don't try to reuse.
(make-instruction-sequence (make-instruction-sequence
`(,(make-AssignImmediateStatement 'proc (make-Const #f)) `(,(make-AssignImmediateStatement 'proc (make-Const #f))
,(make-PushControlFrame after-body))) ,(make-PushControlFrame/Call after-body)))
;(make-instruction-sequence ;(make-instruction-sequence
; `(,(make-AssignImmediateStatement 'proc (make-Const #f)) ; `(,(make-AssignImmediateStatement 'proc (make-Const #f))

5
il-structs.rkt
View File

@ -80,7 +80,7 @@
PushImmediateOntoEnvironment PushImmediateOntoEnvironment
PushControlFrame PushControlFrame/Call
PushControlFrame/Prompt PushControlFrame/Prompt
PopControlFrame)) PopControlFrame))
@ -123,10 +123,11 @@
(define-struct: PopControlFrame () (define-struct: PopControlFrame ()
#:transparent) #:transparent)
;; Adding a frame for getting back after procedure application. ;; Adding a frame for getting back after procedure application.
;; The 'proc register must hold either #f or a closure at the time of ;; The 'proc register must hold either #f or a closure at the time of
;; this call, as the control frame will hold onto the called procedure record. ;; this call, as the control frame will hold onto the called procedure record.
(define-struct: PushControlFrame ([label : (U Symbol LinkedLabel)]) (define-struct: PushControlFrame/Call ([label : (U Symbol LinkedLabel)])
#:transparent) #:transparent)
(define-struct: PushControlFrame/Prompt ([tag : (U OpArg DefaultContinuationPromptTag)] (define-struct: PushControlFrame/Prompt ([tag : (U OpArg DefaultContinuationPromptTag)]

6
simulator.rkt
View File

@ -109,7 +109,7 @@
(step-push-environment! m i)] (step-push-environment! m i)]
[(PushImmediateOntoEnvironment? i) [(PushImmediateOntoEnvironment? i)
(step-push-immediate-onto-environment! m i)] (step-push-immediate-onto-environment! m i)]
[(PushControlFrame? i) [(PushControlFrame/Call? i)
(step-push-control-frame! m i)] (step-push-control-frame! m i)]
[(PushControlFrame/Prompt? i) [(PushControlFrame/Prompt? i)
(step-push-control-frame/prompt! m i)] (step-push-control-frame/prompt! m i)]
@ -168,9 +168,9 @@
(step-push-environment! m (make-PushEnvironment 1 (PushImmediateOntoEnvironment-box? stmt))) (step-push-environment! m (make-PushEnvironment 1 (PushImmediateOntoEnvironment-box? stmt)))
((get-target-updater t) m v))) ((get-target-updater t) m v)))
(: step-push-control-frame! (machine PushControlFrame -> 'ok)) (: step-push-control-frame! (machine PushControlFrame/Call -> 'ok))
(define (step-push-control-frame! m stmt) (define (step-push-control-frame! m stmt)
(control-push! m (make-CallFrame (PushControlFrame-label stmt) (control-push! m (make-CallFrame (PushControlFrame/Call-label stmt)
(ensure-closure-or-false (machine-proc m)) (ensure-closure-or-false (machine-proc m))
(make-hasheq) (make-hasheq)
(make-hasheq)))) (make-hasheq))))

14
test-simulator.rkt
View File

@ -167,9 +167,9 @@
;; PushControl ;; PushControl
(let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const #f)) (let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const #f))
foo foo
,(make-PushControlFrame 'foo) ,(make-PushControlFrame/Call 'foo)
bar bar
,(make-PushControlFrame 'bar) ,(make-PushControlFrame/Call 'bar)
baz baz
))]) ))])
(test (machine-control (run! m)) (test (machine-control (run! m))
@ -181,9 +181,9 @@
;; PopControl ;; PopControl
(let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const #f)) (let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const #f))
foo foo
,(make-PushControlFrame 'foo) ,(make-PushControlFrame/Call 'foo)
bar bar
,(make-PushControlFrame 'bar) ,(make-PushControlFrame/Call 'bar)
baz baz
,(make-PopControlFrame) ,(make-PopControlFrame)
))]) ))])
@ -192,9 +192,9 @@
(let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const #f)) (let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const #f))
foo foo
,(make-PushControlFrame 'foo) ,(make-PushControlFrame/Call 'foo)
bar bar
,(make-PushControlFrame 'bar) ,(make-PushControlFrame/Call 'bar)
baz baz
,(make-PopControlFrame) ,(make-PopControlFrame)
,(make-PopControlFrame)))]) ,(make-PopControlFrame)))])
@ -488,7 +488,7 @@
;; GetControlStackLabel ;; GetControlStackLabel
(let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const #f)) (let ([m (new-machine `(,(make-AssignImmediateStatement 'proc (make-Const #f))
foo foo
,(make-PushControlFrame 'foo) ,(make-PushControlFrame/Call 'foo)
,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel))))]) ,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel))))])
(test (machine-proc (run! m)) (test (machine-proc (run! m))
'foo)) 'foo))