diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment-tests.factor b/basis/compiler/cfg/linear-scan/assignment/assignment-tests.factor index 9543d4c67d..e436d37ea5 100644 --- a/basis/compiler/cfg/linear-scan/assignment/assignment-tests.factor +++ b/basis/compiler/cfg/linear-scan/assignment/assignment-tests.factor @@ -16,6 +16,21 @@ IN: compiler.cfg.linear-scan.assignment.tests T{ ##peek f 37 D: 0 0 } [ assign-insn-defs ] keep ] unit-test +! assign-all-registers +{ + T{ ##replace-imm f 20 D: 0 f } + T{ ##replace f RAX D: 0 f } +} [ + ! It doesn't do anything because ##replace-imm isn't a vreg-insn. + T{ ##replace-imm { src 20 } { loc D: 0 } } [ assign-all-registers ] keep + + ! This one does something. + H{ { 37 RAX } } pending-interval-assoc set + H{ { 37 37 } } leader-map set + T{ ##replace { src 37 } { loc D: 0 } } clone + [ assign-all-registers ] keep +] unit-test + ! assign-registers { } [ V{ T{ ##inc { loc D: 3 } { insn# 7 } } } 0 insns>block block>cfg { } @@ -59,23 +74,39 @@ IN: compiler.cfg.linear-scan.assignment.tests ] V{ } make ] unit-test +: cherry-pick ( seq indices -- seq' ) + [ swap nth ] with map ; + +: (setup-vreg-spills) ( vreg-defs -- reps leaders spill-slots ) + [ [ 2 head ] map ] + [ [ { 0 2 } cherry-pick ] map ] + [ + [ + first4 [ nip [ rep-size 2array ] dip 2array ] [ 3drop f ] if* + ] map sift + ] tri ; + +: setup-vreg-spills ( vreg-defs -- ) + (setup-vreg-spills) + [ representations set ] [ leader-map set ] [ spill-slots set ] tri* ; + +! vreg>spill-slot +{ T{ spill-slot { n 990 } } } [ + { { 10 int-rep 10 T{ spill-slot { n 990 } } } } setup-vreg-spills + 10 vreg>spill-slot +] unit-test + ! vreg>reg { T{ spill-slot f 16 } } [ - H{ { 45 double-2-rep } } representations set - H{ { 45 45 } } leader-map set - H{ { { 45 16 } T{ spill-slot { n 16 } } } } spill-slots set + { { 45 double-rep 45 T{ spill-slot { n 16 } } } } setup-vreg-spills 45 vreg>reg ] unit-test [ ! It gets very strange if the leader of a vreg has a different ! sized representation than the vreg being led. - H{ - { 45 double-2-rep } - { 46 double-rep } - } representations set - H{ { 45 45 } { 46 45 } } leader-map set - H{ { { 45 16 } T{ spill-slot { n 16 } } } } spill-slots set + { { 45 double-2-rep 45 T{ spill-slot { n 16 } } } + { 46 double-rep 45 f } } setup-vreg-spills 46 vreg>reg ] [ bad-vreg? ] must-fail-with @@ -85,7 +116,6 @@ IN: compiler.cfg.linear-scan.assignment.tests ] unit-test { 3 } [ - { 50 90 95 120 } [ 25 2array ] map >min-heap - pending-interval-heap set 90 expire-old-intervals - pending-interval-heap get heap-size + 90 { 50 90 95 120 } [ 25 2array ] map >min-heap + [ expire-old-intervals ] keep heap-size ] unit-test diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor index 0af8cb4631..0ee605d2a2 100644 --- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor +++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor @@ -29,8 +29,7 @@ ERROR: not-spilled-error vreg ; : vreg>spill-slot ( vreg -- spill-slot ) dup vreg>reg dup spill-slot? - [ nip ] - [ drop leader not-spilled-error ] if ; + [ nip ] [ drop leader not-spilled-error ] if ; : vregs>regs ( vregs -- assoc ) [ dup vreg>reg ] H{ } map>assoc ; @@ -75,9 +74,8 @@ SYMBOL: machine-live-outs : expire-interval ( live-interval -- ) [ remove-pending ] [ handle-spill ] bi ; -: expire-old-intervals ( n -- ) - pending-interval-heap get swap '[ _ < ] heap-pop-while - [ expire-interval ] each ; +: expire-old-intervals ( n pending-heap -- ) + swap '[ _ < ] heap-pop-while [ expire-interval ] each ; : insert-reload ( live-interval -- ) [ reg>> ] [ reload-rep>> ] [ reload-from>> ] tri ##reload, ; @@ -88,18 +86,16 @@ SYMBOL: machine-live-outs : activate-interval ( live-interval -- ) [ add-pending ] [ handle-reload ] bi ; -: activate-new-intervals ( n -- ) - unhandled-intervals get swap '[ _ = ] heap-pop-while - [ activate-interval ] each ; +: activate-new-intervals ( n unhandled-heap -- ) + swap '[ _ = ] heap-pop-while [ activate-interval ] each ; : prepare-insn ( n -- ) - [ expire-old-intervals ] [ activate-new-intervals ] bi ; - -GENERIC: assign-registers-in-insn ( insn -- ) + [ pending-interval-heap get expire-old-intervals ] + [ unhandled-intervals get activate-new-intervals ] bi ; RENAMING: assign [ vreg>reg ] [ vreg>reg ] [ vreg>reg ] -M: vreg-insn assign-registers-in-insn +: assign-all-registers ( insn -- ) [ assign-insn-defs ] [ assign-insn-uses ] [ assign-insn-temps ] tri ; : assign-gc-roots ( gc-map -- ) @@ -108,17 +104,15 @@ M: vreg-insn assign-registers-in-insn : assign-derived-roots ( gc-map -- ) [ [ [ vreg>spill-slot ] bi@ ] assoc-map ] change-derived-roots drop ; -M: gc-map-insn assign-registers-in-insn - [ [ assign-insn-defs ] [ assign-insn-uses ] [ assign-insn-temps ] tri ] - [ gc-map>> [ assign-gc-roots ] [ assign-derived-roots ] bi ] - bi ; - -M: insn assign-registers-in-insn drop ; +: assign-registers-in-insn ( insn -- ) + dup assign-all-registers dup gc-map-insn? [ + gc-map>> [ assign-gc-roots ] [ assign-derived-roots ] bi + ] [ drop ] if ; : begin-block ( bb -- ) { [ basic-block namespaces:set ] - [ block-from activate-new-intervals ] + [ block-from unhandled-intervals get activate-new-intervals ] [ compute-edge-live-in ] [ compute-live-in ] } cleave ;