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

another optimization: when all the arguments to a kernel primitive are simple, we avoid some stack usage

Browse Source
This commit is contained in:
Danny Yoo 2011-03-27 00:43:57 -04:00
parent b372a154b1
commit d4b7985d8e
1 changed files with 81 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

102
compile.rkt
View File

@ -447,6 +447,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
;; 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))]
[operand-poss [operand-poss
@ -458,24 +460,68 @@
(compile operand extended-cenv target 'next)) (compile operand extended-cenv target 'next))
(App-operands exp) (App-operands exp)
operand-poss)]) operand-poss)])
(cond
(end-with-linkage ;; Special case optimization: we can avoid pushing the stack altogether
linkage cenv [(all-operands-are-constant-or-stack-references (App-operands exp))
(append-instruction-sequences => (lambda (opargs)
(if (not (empty? (App-operands exp))) (end-with-linkage
(make-instruction-sequence `(,(make-PushEnvironment (length (App-operands exp)) #f))) linkage cenv
empty-instruction-sequence) (make-instruction-sequence
(apply append-instruction-sequences operand-codes) `(,(make-AssignPrimOpStatement
(make-instruction-sequence target
`(,(make-AssignPrimOpStatement (make-CallKernelPrimitiveProcedure kernel-op (map (lambda: ([arg : OpArg])
;; Optimization: we put the result directly in the registers, or in (adjust-oparg-depth arg (- n)))
;; the appropriate spot on the stack. This takes into account the popenviroment opargs)))))))]
;; that happens right afterwards. [else
(adjust-target-depth target n) (end-with-linkage
(make-CallKernelPrimitiveProcedure kernel-op operand-poss)))) linkage cenv
(if (> n 0) (append-instruction-sequences
(make-instruction-sequence `(,(make-PopEnvironment n 0)))
empty-instruction-sequence))))) (if (not (empty? (App-operands exp)))
(make-instruction-sequence `(,(make-PushEnvironment (length (App-operands exp)) #f)))
empty-instruction-sequence)
(apply append-instruction-sequences operand-codes)
(make-instruction-sequence
`(,(make-AssignPrimOpStatement
;; Optimization: we put the result directly in the registers, or in
;; the appropriate spot on the stack. This takes into account the popenviroment
;; that happens right afterwards.
(adjust-target-depth target n)
(make-CallKernelPrimitiveProcedure kernel-op operand-poss))))
(if (> n 0)
(make-instruction-sequence `(,(make-PopEnvironment n 0)))
empty-instruction-sequence)))])))
(: all-operands-are-constant-or-stack-references ((Listof ExpressionCore) -> (U False (Listof OpArg))))
;; Produces a list of OpArgs if all the operands are particularly simple, and false otherwise.
(define (all-operands-are-constant-or-stack-references rands)
(cond [(andmap (lambda: ([rand : ExpressionCore])
(or (Const? rand)
(LocalRef? rand)
(ToplevelRef? rand)))
rands)
(map (lambda: ([e : ExpressionCore])
(cond
[(Const? e)
e]
[(LocalRef? e)
(make-EnvLexicalReference (LocalRef-depth e)
(LocalRef-unbox? e))]
[(ToplevelRef? e)
(make-EnvPrefixReference (ToplevelRef-depth e)
(ToplevelRef-pos e))]
[else
(error 'all-operands-are-constant "Impossible")]))
rands)]
[else #f]))
@ -893,6 +939,20 @@
target])) target]))
(: adjust-oparg-depth (OpArg Integer -> OpArg))
(define (adjust-oparg-depth arg n)
(cond
[(Const? arg)
arg]
[(Reg? arg)
arg]
[(Label? arg)
arg]
[(EnvLexicalReference? arg)
(make-EnvLexicalReference (ensure-natural (+ n (EnvLexicalReference-depth arg)))
(EnvLexicalReference-unbox? arg))]
[(EnvPrefixReference? arg)
(make-EnvPrefixReference (ensure-natural (+ n (EnvPrefixReference-depth arg)))
(EnvPrefixReference-pos arg))]
[(EnvWholePrefixReference? arg)
(make-EnvWholePrefixReference (ensure-natural (+ n (EnvWholePrefixReference-depth arg))))]))