From d7648c4ae7c870c549519f4e1e17aa965169f04e Mon Sep 17 00:00:00 2001 From: Danny Yoo Date: Sun, 17 Apr 2011 13:11:49 -0400 Subject: [PATCH] in the middle of moving getControlStackLabel as an oparg, so we don't need to write into val register before jumping --- assemble-helpers.rkt | 17 ++++++++++++++++- assemble-structs.rkt | 15 +++++++++++++++ assemble.rkt | 17 ++++++----------- compiler.rkt | 4 ++-- il-structs.rkt | 38 +++++++++++++++++--------------------- optimize-il.rkt | 6 +++++- 6 files changed, 61 insertions(+), 36 deletions(-) create mode 100644 assemble-structs.rkt diff --git a/assemble-helpers.rkt b/assemble-helpers.rkt index 651c4d5..ce18d92 100644 --- a/assemble-helpers.rkt +++ b/assemble-helpers.rkt @@ -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") + diff --git a/assemble-structs.rkt b/assemble-structs.rkt new file mode 100644 index 0000000..dca760b --- /dev/null +++ b/assemble-structs.rkt @@ -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) diff --git a/assemble.rkt b/assemble.rkt index 1ba7885..fa63f3e 100644 --- a/assemble.rkt +++ b/assemble.rkt @@ -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))] diff --git a/compiler.rkt b/compiler.rkt index 8310cc5..ef97ee0 100644 --- a/compiler.rkt +++ b/compiler.rkt @@ -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) diff --git a/il-structs.rkt b/il-structs.rkt index 95af445..1033092 100644 --- a/il-structs.rkt +++ b/il-structs.rkt @@ -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) diff --git a/optimize-il.rkt b/optimize-il.rkt index 464b046..02b881b 100644 --- a/optimize-il.rkt +++ b/optimize-il.rkt @@ -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)