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

in the middle of moving getControlStackLabel as an oparg, so we don't need to write into val register before jumping

Browse Source
This commit is contained in:
Danny Yoo 2011-04-17 13:11:49 -04:00
parent c444c3568e
commit d7648c4ae7
6 changed files with 61 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
assemble-helpers.rkt
View File

@ -31,7 +31,11 @@
[(EnvWholePrefixReference? v)
(assemble-whole-prefix-reference v)]
[(SubtractArg? v)
(assemble-subtractarg v)]))
(assemble-subtractarg v)]
[(ControlStackLabel? v)
(assemble-control-stack-label v)]
[(ControlStackLabel/MultipleValueReturn? v)
(assemble-control-stack-label/multiple-value-return v)]))
@ -125,3 +129,14 @@
(format "(~a - ~a)"
(assemble-oparg (SubtractArg-lhs s))
(assemble-oparg (SubtractArg-rhs s))))
(: assemble-control-stack-label (ControlStackLabel -> String))
(define (assemble-control-stack-label a-csl)
"MACHINE.control[MACHINE.control.length-1].label")
(: assemble-control-stack-label/multiple-value-return (ControlStackLabel/MultipleValueReturn -> String))
(define (assemble-control-stack-label/multiple-value-return a-csl)
"MACHINE.control[MACHINE.control.length-1].label.multipleValueReturn")

15
assemble-structs.rkt Normal file
View File

@ -0,0 +1,15 @@
#lang typed/racket/base
(provide (all-defined-out))
(require "il-structs.rkt")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Assembly
(define-struct: BasicBlock ([name : Symbol]
[stmts : (Listof UnlabeledStatement)])
#:transparent)

17
assemble.rkt
View File

@ -2,6 +2,7 @@
(require "il-structs.rkt"
"lexical-structs.rkt"
"helpers.rkt"
"assemble-structs.rkt"
"assemble-helpers.rkt"
"assemble-open-coded.rkt"
racket/string
@ -170,7 +171,11 @@ EOF
empty]
[(SubtractArg? an-input)
(append (collect-input (SubtractArg-lhs an-input))
(collect-input (SubtractArg-rhs an-input)))]))
(collect-input (SubtractArg-rhs an-input)))]
[(ControlStackLabel? an-input)
empty]
[(ControlStackLabel/MultipleValueReturn? an-input)
empty]))
(: collect-location ((U Reg Label) -> (Listof Symbol)))
(define (collect-location a-location)
@ -191,10 +196,6 @@ EOF
(list (MakeCompiledProcedureShell-label op))]
[(ApplyPrimitiveProcedure? op)
empty]
[(GetControlStackLabel? op)
empty]
[(GetControlStackLabel/MultipleValueReturn? op)
empty]
[(CaptureEnvironment? op)
empty]
[(CaptureControl? op)
@ -457,12 +458,6 @@ EOF
[(ApplyPrimitiveProcedure? op)
(format "MACHINE.proc(MACHINE)")]
[(GetControlStackLabel? op)
(format "MACHINE.control[MACHINE.control.length-1].label")]
[(GetControlStackLabel/MultipleValueReturn? op)
(format "MACHINE.control[MACHINE.control.length-1].label.multipleValueReturn")]
[(CaptureEnvironment? op)
(format "MACHINE.env.slice(0, MACHINE.env.length - ~a)"
(CaptureEnvironment-skip op))]

4
compiler.rkt
View File

@ -205,13 +205,13 @@
(define (compile-linkage cenv linkage)
(cond
[(ReturnLinkage? linkage)
(make-instruction-sequence `(,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel))
(make-instruction-sequence `(,(make-AssignImmediateStatement 'proc (make-ControlStackLabel))
,(make-PopEnvironment (make-Const (length cenv))
(make-Const 0))
,(make-PopControlFrame)
,(make-GotoStatement (make-Reg 'proc))))]
[(ReturnLinkage/NonTail? linkage)
(make-instruction-sequence `(,(make-AssignPrimOpStatement 'proc (make-GetControlStackLabel))
(make-instruction-sequence `(,(make-AssignImmediateStatement 'proc (make-ControlStackLabel))
,(make-PopControlFrame)
,(make-GotoStatement (make-Reg 'proc))))]
[(NextLinkage? linkage)

38
il-structs.rkt
View File

@ -27,6 +27,8 @@
EnvPrefixReference ;; a reference into an element in the toplevel.
EnvWholePrefixReference ;; a reference into a toplevel prefix in the stack.
SubtractArg
ControlStackLabel
ControlStackLabel/MultipleValueReturn
))
@ -57,6 +59,21 @@
#:transparent)
;; Gets the return address embedded at the top of the control stack.
(define-struct: ControlStackLabel ()
#:transparent)
;; Gets the secondary (mulitple-value-return) return address embedded
;; at the top of the control stack.
(define-struct: ControlStackLabel/MultipleValueReturn ()
#:transparent)
(define-struct: PrimitivesReference ([name : Symbol])
#:transparent)
@ -172,11 +189,6 @@
MakeCompiledProcedureShell
ApplyPrimitiveProcedure
;; Gets at the single-value-return address.
GetControlStackLabel
;; Gets at the multiple-value-return address.
GetControlStackLabel/MultipleValueReturn
MakeBoxedEnvironmentValue
CaptureEnvironment
@ -227,12 +239,6 @@
;; Gets the return address embedded at the top of the control stack.
(define-struct: GetControlStackLabel ()
#:transparent)
(define-struct: GetControlStackLabel/MultipleValueReturn ()
#:transparent)
(define-struct: MakeBoxedEnvironmentValue ([depth : Natural])
#:transparent)
@ -437,16 +443,6 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Assembly
(define-struct: BasicBlock ([name : Symbol]
[stmts : (Listof UnlabeledStatement)])
#:transparent)
(define-type Arity (U Natural ArityAtLeast (Listof (U Natural ArityAtLeast))))
(define-struct: ArityAtLeast ([value : Natural])
#:transparent)

6
optimize-il.rkt
View File

@ -65,7 +65,11 @@
(make-EnvWholePrefixReference (ensure-natural (+ n (EnvWholePrefixReference-depth oparg))))]
[(SubtractArg? oparg)
(make-SubtractArg (adjust-oparg-depth (SubtractArg-lhs oparg) n)
(adjust-oparg-depth (SubtractArg-rhs oparg) n))]))
(adjust-oparg-depth (SubtractArg-rhs oparg) n))]
[(ControlStackLabel? oparg)
oparg]
[(ControlStackLabel/MultipleValueReturn? oparg)
oparg]))
(define-predicate natural? Natural)