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

in the middle of generalizing the stack optimization

Browse Source
This commit is contained in:
Danny Yoo 2011-03-30 14:45:40 -04:00
parent 3959a0a95c
commit 588855e5ab
1 changed files with 60 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
compile.rkt
View File

@ -436,8 +436,8 @@
(: compile-kernel-primitive-application (: compile-kernel-primitive-application
(KernelPrimitiveName App CompileTimeEnvironment CompileTimeEnvironment Target Linkage -> InstructionSequence)) (KernelPrimitiveName App CompileTimeEnvironment CompileTimeEnvironment Target Linkage -> InstructionSequence))
;; Special case of application, where the operator is statically known to be in the set ;; This is a special case of application, where the operator is statically
;; of hardcoded primitives. ;; known to be in the set of hardcoded primitives.
(define (compile-kernel-primitive-application kernel-op exp cenv extended-cenv target linkage) (define (compile-kernel-primitive-application kernel-op exp cenv extended-cenv target linkage)
(let* ([n (length (App-operands exp))] (let* ([n (length (App-operands exp))]
[expected-operand-types (kernel-primitive-expected-operand-types kernel-op n)] [expected-operand-types (kernel-primitive-expected-operand-types kernel-op n)]
@ -450,7 +450,8 @@
(kernel-primitive-expected-operand-types kernel-op n) (kernel-primitive-expected-operand-types kernel-op n)
operand-knowledge)]) operand-knowledge)])
(cond (cond
;; Special case optimization: we can avoid touching the stack altogether ;; Special case optimization: we can avoid touching the stack for constant
;; arguments.
[(all-operands-are-constant-or-stack-references (App-operands exp)) [(all-operands-are-constant-or-stack-references (App-operands exp))
=> (lambda (opargs) => (lambda (opargs)
(end-with-linkage (end-with-linkage
@ -1007,3 +1008,59 @@
(EnvPrefixReference-pos arg))] (EnvPrefixReference-pos arg))]
[(EnvWholePrefixReference? arg) [(EnvWholePrefixReference? arg)
(make-EnvWholePrefixReference (ensure-natural (+ n (EnvWholePrefixReference-depth arg))))])) (make-EnvWholePrefixReference (ensure-natural (+ n (EnvWholePrefixReference-depth arg))))]))
(: adjust-expression-depth (Expression Integer -> Expression))
(define (adjust-expression-depth exp n)
(cond
[(Top? exp)
(make-Top (Top-prefix exp)
(adjust-expression-depth (Top-code exp) n))]
[(Constant? exp)
exp]
[(ToplevelRef? exp)
(make-ToplevelRef (ensure-natural (+ n (ToplevelRef-depth exp)))
(ToplevelRef-pos exp))]
[(LocalRef? exp)
(make-LocalRef (ensure-natural (+ n (LocalRef-depth exp))))]
[(ToplevelSet? exp)
(make-ToplevelSet (ensure-natural (+ n (ToplevelSet-depth exp)))
(ToplevelSet-pos exp)
(ToplevelSet-name exp)
(adjust-expression-depth (ToplevelSet-value exp) n))]
[(Branch? exp)
(make-Branch (adjust-expression-depth (Branch-predicate exp) n)
(adjust-expression-depth (Branch-consequent exp) n)
(adjust-expression-depth (Branch-alternative exp) n))]
[(Lam? exp)
(make-Lam (Lam-name exp)
(Lam-num-parameters exp)
(Lam-body exp)
(map (lambda: ([d : Natural]) (ensure-natural (+ n d)))
(Lam-closure-map exp))
(Lam-entry-label exp))]
[(Seq? exp)
(make-Seq (map (lambda: ([action : Expression])
(adjust-expression-depth action n))
(Seq-actions exp)))]
[(App? exp)
...]
[(Let1? exp)
...]
[(LetVoid? exp)
...]
[(LetRec? exp)
...]
[(InstallValue? exp)
...]
[(BoxEnv? exp)
...]))
...))