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 frame's environment consumes those elements from MACHINE.env
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
(make-Const (length (App-operands exp))))))
(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
linkage))))
@ -713,6 +717,8 @@
(StaticallyKnownLam App CompileTimeEnvironment Target Linkage
-> InstructionSequence))
(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))
(StaticallyKnownLam-arity static-knowledge))
(error 'arity-mismatch "~s expected ~s arguments, but received ~s"
@ -813,7 +819,7 @@
(make-instruction-sequence
`(,(make-PerformStatement (make-CheckClosureArity! (make-Reg 'argcount)))))
(compile-compiled-procedure-application extended-cenv-length
(make-Reg 'val)
'val
target
compiled-linkage)
@ -845,7 +851,12 @@
(make-instruction-sequence `(,(make-AssignImmediateStatement
'argcount
(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))
target
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.
;; 1. Tail calls.
;; 2. Non-tail calls (next/label linkage) that write to val
;; 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)
(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
[(eq? target 'val)
@ -869,18 +896,19 @@
;; We clean up the stack right before the jump, and do not add
;; to the control stack.
(append-instruction-sequences
(make-instruction-sequence
`(,(make-AssignPrimOpStatement 'val
(make-GetCompiledProcedureEntry))))
maybe-install-jump-address
(cond [(equal? cenv-length-with-args (make-Reg 'argcount))
empty-instruction-sequence]
[else
(make-instruction-sequence `(,(make-PopEnvironment (make-SubtractArg cenv-length-with-args
(make-Reg 'argcount))
(make-Reg 'argcount))))
(make-Reg 'argcount))))])
(make-instruction-sequence
`(;; Assign the proc value of the existing call frame
,(make-PerformStatement
(make-SetFrameCallee! (make-Reg 'proc)))
,(make-GotoStatement entry-point))))]
,(make-GotoStatement entry-point-target))))]
[else
;; This case should be impossible: return linkage should only
@ -894,68 +922,80 @@
;; This case happens for a function call that isn't in
;; tail position.
(let ([proc-return (make-label 'procReturn)])
(append-instruction-sequences
(make-instruction-sequence
`(,(make-PushControlFrame proc-return)
,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry))
,(make-GotoStatement entry-point)
,proc-return)))]
`(,(make-PushControlFrame proc-return)))
maybe-install-jump-address
(make-instruction-sequence
`(,(make-GotoStatement entry-point-target)
,proc-return))))]
[else
;; This case happens for evaluating arguments, since the
;; arguments are being installed into the scratch space.
(let ([proc-return (make-label 'procReturn)])
(append-instruction-sequences
(make-instruction-sequence
`(,(make-PushControlFrame proc-return)
,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry))
,(make-GotoStatement entry-point)
`(,(make-PushControlFrame proc-return)))
maybe-install-jump-address
(make-instruction-sequence
`(,(make-GotoStatement entry-point-target)
,proc-return
,(make-AssignImmediateStatement target (make-Reg 'val)))))])]
,(make-AssignImmediateStatement target (make-Reg 'val))))))])]
[(NextLinkage? linkage)
(cond [(eq? target 'val)
;; This case happens for a function call that isn't in
;; tail position.
(let ([proc-return (make-label 'procReturn)])
(append-instruction-sequences
(make-instruction-sequence
`(,(make-PushControlFrame proc-return)
,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry))
,(make-GotoStatement entry-point)
,proc-return)))]
`(,(make-PushControlFrame proc-return)))
maybe-install-jump-address
(make-instruction-sequence
`(,(make-GotoStatement entry-point-target)
,proc-return))))]
[else
;; This case happens for evaluating arguments, since the
;; arguments are being installed into the scratch space.
(let ([proc-return (make-label 'procReturn)])
(append-instruction-sequences
(make-instruction-sequence
`(,(make-PushControlFrame proc-return)
,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry))
,(make-GotoStatement entry-point)
`(,(make-PushControlFrame proc-return)))
maybe-install-jump-address
(make-instruction-sequence
`(,(make-GotoStatement entry-point-target)
,proc-return
,(make-AssignImmediateStatement target (make-Reg 'val)))))])]
,(make-AssignImmediateStatement target (make-Reg 'val))))))])]
[(LabelLinkage? linkage)
(cond [(eq? target 'val)
;; This case happens for a function call that isn't in
;; tail position.
(let ([proc-return (make-label 'procReturn)])
(append-instruction-sequences
(make-instruction-sequence
`(,(make-PushControlFrame proc-return)
,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry))
,(make-GotoStatement entry-point)
`(,(make-PushControlFrame proc-return)))
maybe-install-jump-address
(make-instruction-sequence
`(,(make-GotoStatement entry-point-target)
,proc-return
,(make-GotoStatement (make-Label (LabelLinkage-label linkage))))))]
,(make-GotoStatement (make-Label (LabelLinkage-label linkage)))))))]
[else
;; This case happens for evaluating arguments, since the
;; arguments are being installed into the scratch space.
(let ([proc-return (make-label 'procReturn)])
(append-instruction-sequences
(make-instruction-sequence
`(,(make-PushControlFrame proc-return)
,(make-AssignPrimOpStatement 'val (make-GetCompiledProcedureEntry))
,(make-GotoStatement entry-point)
`(,(make-PushControlFrame proc-return)))
maybe-install-jump-address
(make-instruction-sequence
`(,(make-GotoStatement entry-point-target)
,proc-return
,(make-AssignImmediateStatement target (make-Reg 'val))
,(make-GotoStatement (make-Label (LabelLinkage-label linkage))))))])]))
,(make-GotoStatement (make-Label (LabelLinkage-label linkage)))))))])])))