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

optimization when jump target is known.

Browse Source
This commit is contained in:
Danny Yoo 2011-04-10 20:48:03 -04:00
parent bc783824a7
commit 5952ca7cf3
2 changed files with 205 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
NOTES
View File

@ -119,3 +119,67 @@ On a tail call,
The existing call frame is reused. The existing call frame is reused.
The frame's environment consumes those elements from MACHINE.env The frame's environment consumes those elements from MACHINE.env
MACHINE.env = the new stack segment MACHINE.env = the new stack segment
Optimizations with IL
The sequence PushEnvironment ... AssignImmediateStatement (EnvLexicalAddress ...)
where we're assigning directly to a spot we just allocated, can be reduced to
a single instruction.
We can do some constant folding in operands. e.g.
MACHINE.env[MACHINE.env.length - 1 - 3] = MACHINE.env[MACHINE.env.length - 1 - 7];
=>
MACHINE.env[MACHINE.env.length - 4] = MACHINE.env[MACHINE.env.length - 8];
On tail calls, when we're reusing all of the arguments on the stack,
there's no need to splice, since we won't be popping anything off:
MACHINE.env.splice(MACHINE.env.length - (MACHINE.argcount + ((10) - MACHINE.argcount)), ((10) - MACHINE.argcount));
is a no-op.
In the case where a closure has a prefix, but all the uses of the prefix are to open-coded primitives, then we don't need to close over it after all. e.g.
(test '(begin (letrec ([f (lambda (x) (* x x))]
[g (lambda (x) (* x x x))])
(- (g (f (+ (g 3) (f 3)))) 1)))
2176782335
#:debug? #t)
since (* -) are both open-coded, there's no need to capture the
prefix, and we can reduce some allocation.
I can eliminate an instruction in the pair:
#(struct:AssignPrimOpStatement val #(struct:GetCompiledProcedureEntry))
#(struct:GotoStatement #(struct:Label lamEntry259))
since the val isn't even being used here... This is the case when we
statically know the lambda target.
- ok, done.

106
compile.rkt
View File

@ -474,7 +474,11 @@
'argcount 'argcount
(make-Const (length (App-operands exp)))))) (make-Const (length (App-operands exp))))))
(compile-general-procedure-call cenv (compile-general-procedure-call cenv
(make-Const (length extended-cenv)) (cond [(= (length extended-cenv)
(length (App-operands exp)))
(make-Reg 'argcount)]
[else
(make-Const (length extended-cenv))])
target target
linkage)))) linkage))))
@ -713,6 +717,8 @@
(StaticallyKnownLam App CompileTimeEnvironment Target Linkage (StaticallyKnownLam App CompileTimeEnvironment Target Linkage
-> InstructionSequence)) -> InstructionSequence))
(define (compile-statically-known-lam-application static-knowledge exp cenv target linkage) (define (compile-statically-known-lam-application static-knowledge exp cenv target linkage)
;; FIXME: this needs to be turned into a runtime error, not a compile-time error, to preserve
;; Racket semantics.
(unless (= (length (App-operands exp)) (unless (= (length (App-operands exp))
(StaticallyKnownLam-arity static-knowledge)) (StaticallyKnownLam-arity static-knowledge))
(error 'arity-mismatch "~s expected ~s arguments, but received ~s" (error 'arity-mismatch "~s expected ~s arguments, but received ~s"
@ -813,7 +819,7 @@
(make-instruction-sequence (make-instruction-sequence
`(,(make-PerformStatement (make-CheckClosureArity! (make-Reg 'argcount))))) `(,(make-PerformStatement (make-CheckClosureArity! (make-Reg 'argcount)))))
(compile-compiled-procedure-application extended-cenv-length (compile-compiled-procedure-application extended-cenv-length
(make-Reg 'val) 'val
target target
compiled-linkage) compiled-linkage)
@ -845,7 +851,12 @@
(make-instruction-sequence `(,(make-AssignImmediateStatement (make-instruction-sequence `(,(make-AssignImmediateStatement
'argcount 'argcount
(make-Const n)))) (make-Const n))))
(compile-compiled-procedure-application (make-Const (length extended-cenv)) (compile-compiled-procedure-application (cond
[(= (length extended-cenv)
n)
(make-Reg 'argcount)]
[else
(make-Const (length extended-cenv))])
(make-Label (StaticallyKnownLam-entry-point static-knowledge)) (make-Label (StaticallyKnownLam-entry-point static-knowledge))
target target
compiled-linkage) compiled-linkage)
@ -856,12 +867,28 @@
(: compile-compiled-procedure-application (OpArg (U Label Reg) Target Linkage -> InstructionSequence)) (: compile-compiled-procedure-application (OpArg (U Label 'val) Target Linkage -> InstructionSequence))
;; Three fundamental cases for general compiled-procedure application. ;; Three fundamental cases for general compiled-procedure application.
;; 1. Tail calls. ;; 1. Tail calls.
;; 2. Non-tail calls (next/label linkage) that write to val ;; 2. Non-tail calls (next/label linkage) that write to val
;; 3. Calls in argument position (next/label linkage) that write to the stack. ;; 3. Calls in argument position (next/label linkage) that write to the stack.
(define (compile-compiled-procedure-application cenv-length-with-args entry-point target linkage) (define (compile-compiled-procedure-application cenv-length-with-args entry-point target linkage)
(let ([maybe-install-jump-address
;; Optimization: if the entry-point is supposed to be val, then it needs to hold
;; the procedure entry here. Otherwise, it doesn't.
(cond [(Label? entry-point)
empty-instruction-sequence]
[(eq? entry-point 'val)
(make-instruction-sequence
`(,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry))))])]
[entry-point-target
(cond
[(Label? entry-point)
entry-point]
[(eq? entry-point 'val)
(make-Reg 'val)])])
(cond [(ReturnLinkage? linkage) (cond [(ReturnLinkage? linkage)
(cond (cond
[(eq? target 'val) [(eq? target 'val)
@ -869,18 +896,19 @@
;; 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.
(append-instruction-sequences (append-instruction-sequences
(make-instruction-sequence maybe-install-jump-address
`(,(make-AssignPrimOpStatement 'val (cond [(equal? cenv-length-with-args (make-Reg 'argcount))
(make-GetCompiledProcedureEntry)))) empty-instruction-sequence]
[else
(make-instruction-sequence `(,(make-PopEnvironment (make-SubtractArg cenv-length-with-args (make-instruction-sequence `(,(make-PopEnvironment (make-SubtractArg cenv-length-with-args
(make-Reg 'argcount)) (make-Reg 'argcount))
(make-Reg 'argcount)))) (make-Reg 'argcount))))])
(make-instruction-sequence (make-instruction-sequence
`(;; Assign the proc value of the existing call frame `(;; Assign the proc value of the existing call frame
,(make-PerformStatement ,(make-PerformStatement
(make-SetFrameCallee! (make-Reg 'proc))) (make-SetFrameCallee! (make-Reg 'proc)))
,(make-GotoStatement entry-point))))] ,(make-GotoStatement entry-point-target))))]
[else [else
;; This case should be impossible: return linkage should only ;; This case should be impossible: return linkage should only
@ -894,68 +922,80 @@
;; This case happens for a function call that isn't in ;; This case happens for a function call that isn't in
;; tail position. ;; tail position.
(let ([proc-return (make-label 'procReturn)]) (let ([proc-return (make-label 'procReturn)])
(append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-PushControlFrame proc-return) `(,(make-PushControlFrame proc-return)))
,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry)) maybe-install-jump-address
,(make-GotoStatement entry-point) (make-instruction-sequence
,proc-return)))] `(,(make-GotoStatement entry-point-target)
,proc-return))))]
[else [else
;; This case happens for evaluating arguments, since the ;; This case happens for evaluating arguments, since the
;; arguments are being installed into the scratch space. ;; arguments are being installed into the scratch space.
(let ([proc-return (make-label 'procReturn)]) (let ([proc-return (make-label 'procReturn)])
(append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-PushControlFrame proc-return) `(,(make-PushControlFrame proc-return)))
,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry)) maybe-install-jump-address
,(make-GotoStatement entry-point) (make-instruction-sequence
`(,(make-GotoStatement entry-point-target)
,proc-return ,proc-return
,(make-AssignImmediateStatement target (make-Reg 'val)))))])] ,(make-AssignImmediateStatement target (make-Reg 'val))))))])]
[(NextLinkage? linkage) [(NextLinkage? linkage)
(cond [(eq? target 'val) (cond [(eq? target 'val)
;; This case happens for a function call that isn't in ;; This case happens for a function call that isn't in
;; tail position. ;; tail position.
(let ([proc-return (make-label 'procReturn)]) (let ([proc-return (make-label 'procReturn)])
(append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-PushControlFrame proc-return) `(,(make-PushControlFrame proc-return)))
,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry)) maybe-install-jump-address
,(make-GotoStatement entry-point) (make-instruction-sequence
,proc-return)))] `(,(make-GotoStatement entry-point-target)
,proc-return))))]
[else [else
;; This case happens for evaluating arguments, since the ;; This case happens for evaluating arguments, since the
;; arguments are being installed into the scratch space. ;; arguments are being installed into the scratch space.
(let ([proc-return (make-label 'procReturn)]) (let ([proc-return (make-label 'procReturn)])
(append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-PushControlFrame proc-return) `(,(make-PushControlFrame proc-return)))
,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry)) maybe-install-jump-address
,(make-GotoStatement entry-point) (make-instruction-sequence
`(,(make-GotoStatement entry-point-target)
,proc-return ,proc-return
,(make-AssignImmediateStatement target (make-Reg 'val)))))])] ,(make-AssignImmediateStatement target (make-Reg 'val))))))])]
[(LabelLinkage? linkage) [(LabelLinkage? linkage)
(cond [(eq? target 'val) (cond [(eq? target 'val)
;; This case happens for a function call that isn't in ;; This case happens for a function call that isn't in
;; tail position. ;; tail position.
(let ([proc-return (make-label 'procReturn)]) (let ([proc-return (make-label 'procReturn)])
(append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-PushControlFrame proc-return) `(,(make-PushControlFrame proc-return)))
,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry)) maybe-install-jump-address
,(make-GotoStatement entry-point) (make-instruction-sequence
`(,(make-GotoStatement entry-point-target)
,proc-return ,proc-return
,(make-GotoStatement (make-Label (LabelLinkage-label linkage))))))] ,(make-GotoStatement (make-Label (LabelLinkage-label linkage)))))))]
[else [else
;; This case happens for evaluating arguments, since the ;; This case happens for evaluating arguments, since the
;; arguments are being installed into the scratch space. ;; arguments are being installed into the scratch space.
(let ([proc-return (make-label 'procReturn)]) (let ([proc-return (make-label 'procReturn)])
(append-instruction-sequences
(make-instruction-sequence (make-instruction-sequence
`(,(make-PushControlFrame proc-return) `(,(make-PushControlFrame proc-return)))
,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry)) maybe-install-jump-address
,(make-GotoStatement entry-point) (make-instruction-sequence
`(,(make-GotoStatement entry-point-target)
,proc-return ,proc-return
,(make-AssignImmediateStatement target (make-Reg 'val)) ,(make-AssignImmediateStatement target (make-Reg 'val))
,(make-GotoStatement (make-Label (LabelLinkage-label linkage))))))])])) ,(make-GotoStatement (make-Label (LabelLinkage-label linkage)))))))])])))