+++ /dev/null
-USING: compiler.cfg.height compiler.cfg.instructions\r
-compiler.cfg.registers tools.test ;\r
-IN: compiler.cfg.height.tests\r
-\r
-[\r
- V{\r
- T{ ##inc-r f -1 f }\r
- T{ ##inc-d f 4 f }\r
- T{ ##peek f 0 D 4 f }\r
- T{ ##peek f 1 D 0 f }\r
- T{ ##replace f 0 R -1 f }\r
- T{ ##replace f 1 R 0 f }\r
- T{ ##peek f 2 D 0 f }\r
- }\r
-] [\r
- V{\r
- T{ ##peek f 0 D 0 }\r
- T{ ##inc-d f 3 }\r
- T{ ##peek f 1 D -1 }\r
- T{ ##replace f 0 R 0 }\r
- T{ ##inc-r f -1 }\r
- T{ ##replace f 1 R 0 }\r
- T{ ##inc-d f 1 }\r
- T{ ##peek f 2 D 0 }\r
- } height-step\r
-] unit-test\r
+++ /dev/null
-! Copyright (C) 2008, 2010 Slava Pestov.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors compiler.cfg.instructions
-compiler.cfg.registers compiler.cfg.rpo fry kernel math
-namespaces sequences ;
-IN: compiler.cfg.height
-
-! Combine multiple stack height changes into one at the
-! start of the basic block.
-
-SYMBOL: ds-height
-SYMBOL: rs-height
-
-: init-height ( -- )
- 0 ds-height set
- 0 rs-height set ;
-
-GENERIC: visit-insn ( insn -- )
-
-: normalize-inc-d/r ( insn stack -- )
- swap n>> '[ _ + ] change ; inline
-
-M: ##inc-d visit-insn ds-height normalize-inc-d/r ;
-M: ##inc-r visit-insn rs-height normalize-inc-d/r ;
-
-GENERIC: loc-stack ( loc -- stack )
-
-M: ds-loc loc-stack drop ds-height ;
-M: rs-loc loc-stack drop rs-height ;
-
-GENERIC: <loc> ( n stack -- loc )
-
-M: ds-loc <loc> drop <ds-loc> ;
-M: rs-loc <loc> drop <rs-loc> ;
-
-: normalize-peek/replace ( insn -- )
- [ [ [ n>> ] [ loc-stack get ] bi + ] keep <loc> ] change-loc
- drop ; inline
-
-M: ##peek visit-insn normalize-peek/replace ;
-M: ##replace visit-insn normalize-peek/replace ;
-
-M: insn visit-insn drop ;
-
-: height-step ( insns -- insns' )
- init-height
- [ <reversed> [ visit-insn ] each ]
- [
- [ [ ##inc-d? ] [ ##inc-r? ] bi or not ] filter!
- ds-height get [ ##inc-d new-insn prefix ] unless-zero
- rs-height get [ ##inc-r new-insn prefix ] unless-zero
- ] bi ;
-
-: normalize-height ( cfg -- )
- [ height-step ] simple-optimization ;
+++ /dev/null
-Stack height normalization coalesces height changes at start of basic block
+++ /dev/null
-USING: compiler.cfg compiler.cfg.height help.markup help.syntax sequences ;
-IN: compiler.cfg.scheduling
-
-HELP: schedule-instructions
-{ $values { "cfg" cfg } }
-{ $description "Performs a instruction scheduling optimization pass over the CFG to attempt to reduce the number of spills. The step must be performed after " { $link normalize-height } " or else invalid peeks might be inserted into the CFG." } ;
+++ /dev/null
-USING: accessors arrays assocs compiler.cfg compiler.cfg.dependence
-compiler.cfg.test-words compiler.cfg.instructions
-compiler.cfg.linearization compiler.cfg.registers compiler.cfg.scheduling
-compiler.cfg.utilities grouping kernel math namespaces tools.test random
-sequences sets splitting vectors words compiler.cfg.test-words ;
-IN: compiler.cfg.scheduling.tests
-
-! Test split-insns
-{
- {
- V{ }
- V{ }
- V{ T{ ##test-branch } }
- }
-} [ V{ T{ ##test-branch } } split-insns ] unit-test
-
-{
- {
- V{ T{ ##inc-d } T{ ##inc-r } T{ ##callback-inputs } }
- V{ T{ ##add } T{ ##sub } T{ ##mul } }
- V{ T{ ##test-branch } }
- }
-} [
- V{
- T{ ##inc-d }
- T{ ##inc-r }
- T{ ##callback-inputs }
- T{ ##add }
- T{ ##sub }
- T{ ##mul }
- T{ ##test-branch }
- } split-insns
-] unit-test
-
-[
- {
- V{ }
- V{ T{ ##add } T{ ##sub } T{ ##mul } }
- V{ T{ ##dispatch } }
- }
-] [
- V{
- T{ ##add }
- T{ ##sub }
- T{ ##mul }
- T{ ##dispatch }
- } split-insns
-] unit-test
-
-! Instructions gets numbered as a side-effect
-{ t } [
- V{
- T{ ##inc-r }
- T{ ##inc-d }
- T{ ##load-tagged }
- T{ ##allot }
- T{ ##set-slot-imm }
- } insns>cfg dup schedule-instructions cfg>insns [ insn#>> ] all?
-] unit-test
-
-: test-1187 ( -- insns )
- V{
- ##inc-r
- ##inc-d
- ##peek
- ##peek
- ##load-tagged
- ##allot
- ##set-slot-imm
- ##load-reference
- ##allot
- ##set-slot-imm
- ##set-slot-imm
- ##set-slot-imm
- ##replace-imm
- ##replace
- ##replace
- ##replace
- ##replace
- ##replace-imm
- ##replace
- ##branch
- } [ [ new ] [ 2 * ] bi* >>insn# ] map-index ;
-
-{
- {
- { T{ ##inc-r } T{ ##inc-d } T{ ##peek } T{ ##peek } }
- {
- T{ ##load-tagged }
- T{ ##allot }
- T{ ##set-slot-imm }
- T{ ##load-reference }
- T{ ##allot }
- T{ ##set-slot-imm }
- T{ ##set-slot-imm }
- T{ ##set-slot-imm }
- T{ ##replace-imm }
- T{ ##replace }
- T{ ##replace }
- T{ ##replace }
- T{ ##replace }
- T{ ##replace-imm }
- T{ ##replace }
- }
- { T{ ##branch } }
- }
-} [ test-1187 [ f >>insn# ] map split-insns ] unit-test
-
-{
- V{
- T{ ##load-tagged { insn# 0 } }
- T{ ##load-reference { insn# 6 } }
- T{ ##set-slot-imm { insn# 14 } }
- T{ ##replace { insn# 16 } }
- }
-} [
- test-not-in-order setup-nodes [ ready? ] filter [ insn>> ] map
-] unit-test
-
-{
- V{
- T{ ##allot { insn# 2 } }
- T{ ##set-slot-imm { insn# 4 } }
- T{ ##allot { insn# 8 } }
- T{ ##set-slot-imm { insn# 10 } }
- T{ ##load-tagged { insn# 0 } }
- T{ ##load-reference { insn# 6 } }
- T{ ##set-slot-imm { insn# 12 } }
- T{ ##set-slot-imm { insn# 14 } }
- T{ ##replace { insn# 16 } }
- }
-} [ test-not-in-order reorder-body ] unit-test
-
-{ t f } [
- node new ready?
- node new { { 1 2 } } >>precedes ready?
-] unit-test
-
-{ t } [
- 100 [
- test-not-in-order setup-nodes [ insn>> ] map
- ] replicate all-equal?
-] unit-test
-
-{ t } [
- 100 [
- test-not-in-order setup-nodes [ score ] map
- ] replicate all-equal?
-] unit-test
-
-! You should get the exact same instruction order each time.
-{ t } [
- 100 [ test-not-in-order reorder-body ] replicate all-equal?
-] unit-test
-
-{ t } [
- 100 [ test-1187 split-insns 1 swap nth reorder ] replicate all-equal?
-] unit-test
-
-: insns-1 ( -- insns )
- V{
- T{ ##peek { dst 275 } { loc D 2 } }
- T{ ##load-tagged { dst 277 } { val 0 } }
- T{ ##allot
- { dst 280 }
- { size 16 }
- { class-of array }
- { temp 6 }
- }
- T{ ##set-slot-imm
- { src 277 }
- { obj 280 }
- { slot 1 }
- { tag 2 }
- }
- T{ ##load-reference
- { dst 283 }
- { obj
- {
- vector
- 2
- 1
- tuple
- 258304024774
- vector
- 8390923745423
- }
- }
- }
- T{ ##allot
- { dst 285 }
- { size 32 }
- { class-of tuple }
- { temp 12 }
- }
- T{ ##set-slot-imm
- { src 283 }
- { obj 285 }
- { slot 1 }
- { tag 7 }
- }
- T{ ##set-slot-imm
- { src 280 }
- { obj 285 }
- { slot 2 }
- { tag 7 }
- }
- } [ 2 * >>insn# ] map-index ;
-
-{ t f } [
- insns-1 setup-nodes
- ! Anyone preceding insn# 14?
- [
- [ precedes>> keys [ insn>> insn#>> ] map 14 swap member? ] any?
- ]
- [
- unclip-last over swap remove-node
- [ precedes>> keys [ insn>> insn#>> ] map 14 swap member? ] any?
- ] bi
-] unit-test
-
-{ V{ 0 6 12 14 } } [
- insns-1 setup-nodes
- [ parent-index>> -1/0. = ] filter [ insn>> insn#>> ] map
-] unit-test
-
-{ 7 } [
- test-not-in-order setup-nodes
- [ parent-index>> -1/0. = ] count
-] unit-test
+++ /dev/null
-! Copyright (C) 2009, 2010 Daniel Ehrenberg.
-! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs compiler.cfg.dependence
-compiler.cfg.instructions compiler.cfg.linear-scan.numbering
-compiler.cfg.rpo fry kernel make math namespaces sequences
-splitting ;
-FROM: namespaces => set ;
-IN: compiler.cfg.scheduling
-
-! Instruction scheduling to reduce register pressure, from:
-! "Register-sensitive selection, duplication, and
-! sequencing of instructions"
-! by Vivek Sarkar, et al.
-! http://portal.acm.org/citation.cfm?id=377849
-
-: set-parent-indices ( node -- )
- children>> building get length
- '[ _ >>parent-index drop ] each ;
-
-: ready? ( node -- ? ) precedes>> assoc-empty? ;
-
-! Remove the node and unregister it from all nodes precedes links.
-: remove-node ( nodes node -- )
- [ swap remove! ] keep '[ precedes>> _ swap delete-at ] each ;
-
-: score ( node -- n )
- [ parent-index>> ] [ registers>> neg ] [ insn>> insn#>> ] tri 3array ;
-
-: select-instruction ( nodes -- insn/f )
- [ f ] [
- ! select one among the ready nodes (roots)
- dup [ ready? ] filter [ score ] supremum-by
- [ remove-node ] keep
- [ insn>> ] [ set-parent-indices ] bi
- ] if-empty ;
-
-: (reorder) ( nodes -- )
- dup select-instruction [ , (reorder) ] [ drop ] if* ;
-
-UNION: initial-insn
- ##phi ##inc-d ##inc-r ##callback-inputs
- ! See #1187
- ##peek ;
-
-UNION: final-insn
-##branch
-##dispatch
-conditional-branch-insn
-##safepoint
-##epilogue ##return
-##callback-outputs ;
-
-: initial-insn-end ( insns -- n )
- [ initial-insn? not ] find drop 0 or ;
-
-: final-insn-start ( insns -- n )
- [ final-insn? not ] find-last drop [ 1 + ] [ 0 ] if* ;
-
-: split-insns ( insns -- pre/body/post )
- dup [ initial-insn-end ] [ final-insn-start ] bi 2array split-indices ;
-
-: setup-nodes ( insns -- nodes )
- [ <node> ] V{ } map-as
- [ build-dependence-graph ] [ build-fan-in-trees ] [ ] tri ;
-
-: reorder-body ( body -- body' )
- setup-nodes [ (reorder) ] V{ } make reverse ;
-
-: reorder ( insns -- insns' )
- split-insns first3 [ reorder-body ] dip 3append ;
-
-: schedule-instructions ( cfg -- )
- [ number-instructions ] [ [ reorder ] simple-optimization ] bi ;
projects / factor.git / commitdiff