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

continuing to eliminate no-op instructions from the instruction stream.

Browse Source
This commit is contained in:
Danny Yoo 2011-03-27 00:14:32 -04:00
parent 2c887255d8
commit b372a154b1
1 changed files with 32 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
compile.rkt
View File

@ -462,7 +462,9 @@
(end-with-linkage (end-with-linkage
linkage cenv linkage cenv
(append-instruction-sequences (append-instruction-sequences
(if (not (empty? (App-operands exp)))
(make-instruction-sequence `(,(make-PushEnvironment (length (App-operands exp)) #f))) (make-instruction-sequence `(,(make-PushEnvironment (length (App-operands exp)) #f)))
empty-instruction-sequence)
(apply append-instruction-sequences operand-codes) (apply append-instruction-sequences operand-codes)
(make-instruction-sequence (make-instruction-sequence
`(,(make-AssignPrimOpStatement `(,(make-AssignPrimOpStatement
@ -470,8 +472,10 @@
;; the appropriate spot on the stack. This takes into account the popenviroment ;; the appropriate spot on the stack. This takes into account the popenviroment
;; that happens right afterwards. ;; that happens right afterwards.
(adjust-target-depth target n) (adjust-target-depth target n)
(make-CallKernelPrimitiveProcedure kernel-op operand-poss)) (make-CallKernelPrimitiveProcedure kernel-op operand-poss))))
,(make-PopEnvironment n 0))))))) (if (> n 0)
(make-instruction-sequence `(,(make-PopEnvironment n 0)))
empty-instruction-sequence)))))
@ -504,7 +508,9 @@
(make-EnvLexicalReference i #f) (make-EnvLexicalReference i #f)
'val))))]) 'val))))])
(append-instruction-sequences (append-instruction-sequences
(if (not (empty? (App-operands exp)))
(make-instruction-sequence `(,(make-PushEnvironment (length (App-operands exp)) #f))) (make-instruction-sequence `(,(make-PushEnvironment (length (App-operands exp)) #f)))
empty-instruction-sequence)
proc-code proc-code
(juggle-operands operand-codes) (juggle-operands operand-codes)
(compile-procedure-call/statically-known-lam static-knowledge (compile-procedure-call/statically-known-lam static-knowledge
@ -640,12 +646,16 @@
;; This case happens when we're in tail position. ;; This case happens when we're in tail position.
;; We clean up the stack right before the jump, and do not add ;; We clean up the stack right before the jump, and do not add
;; to the control stack. ;; to the control stack.
(let: ([num-slots-to-delete : Natural (ensure-natural (- (length cenv-with-args) n))])
(append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-AssignPrimOpStatement 'val `(,(make-AssignPrimOpStatement 'val
(make-GetCompiledProcedureEntry)) (make-GetCompiledProcedureEntry))))
,(make-PopEnvironment (ensure-natural (- (length cenv-with-args) n)) (if (> num-slots-to-delete 0)
n) (make-instruction-sequence `(,(make-PopEnvironment num-slots-to-delete n)))
,(make-GotoStatement entry-point)))] empty-instruction-sequence)
(make-instruction-sequence
`(,(make-GotoStatement entry-point)))))]
[(and (not (eq? target 'val)) [(and (not (eq? target 'val))
(eq? linkage 'return)) (eq? linkage 'return))
@ -745,10 +755,14 @@
linkage linkage
extended-cenv extended-cenv
(append-instruction-sequences (append-instruction-sequences
(if (> n 0)
(make-instruction-sequence `(,(make-PushEnvironment n (LetVoid-boxes? exp)))) (make-instruction-sequence `(,(make-PushEnvironment n (LetVoid-boxes? exp))))
empty-instruction-sequence)
body-code body-code
after-body-code after-body-code
(if (> n 0)
(make-instruction-sequence `(,(make-PopEnvironment n 0))) (make-instruction-sequence `(,(make-PopEnvironment n 0)))
empty-instruction-sequence)
after-let)))) after-let))))
@ -778,7 +792,9 @@
linkage linkage
extended-cenv extended-cenv
(append-instruction-sequences (append-instruction-sequences
(if (> n 0)
(make-instruction-sequence `(,(make-PushEnvironment n #f))) (make-instruction-sequence `(,(make-PushEnvironment n #f)))
empty-instruction-sequence)
;; Install each of the closure shells ;; Install each of the closure shells
(apply append-instruction-sequences (apply append-instruction-sequences
@ -805,7 +821,9 @@
;; Compile the body ;; Compile the body
(compile (LetRec-body exp) extended-cenv (adjust-target-depth target n) letrec-linkage) (compile (LetRec-body exp) extended-cenv (adjust-target-depth target n) letrec-linkage)
after-body-code after-body-code
(make-instruction-sequence `(,(make-PopEnvironment n 0))))))) (if (> n 0)
(make-instruction-sequence `(,(make-PopEnvironment n 0)))
empty-instruction-sequence)))))