diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor index c0f90e5932..98deca9472 100644 --- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor +++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor @@ -19,7 +19,7 @@ IN: compiler.cfg.linear-scan.assignment SYMBOL: pending-intervals : add-active ( live-interval -- ) - pending-intervals get push ; + dup end>> pending-intervals get heap-push ; ! Minheap of live intervals which still need a register allocation SYMBOL: unhandled-intervals @@ -37,7 +37,7 @@ SYMBOL: register-live-ins SYMBOL: register-live-outs : init-assignment ( live-intervals -- ) - V{ } clone pending-intervals set + pending-intervals set unhandled-intervals set H{ } clone register-live-ins set H{ } clone register-live-outs set @@ -61,12 +61,17 @@ SYMBOL: register-live-outs register->register ] [ drop ] if ; +: (expire-old-intervals) ( n heap -- ) + dup heap-empty? [ 2drop ] [ + 2dup heap-peek nip <= [ 2drop ] [ + dup heap-pop drop [ handle-spill ] [ handle-copy ] bi + (expire-old-intervals) + ] if + ] if ; + : expire-old-intervals ( n -- ) [ - [ pending-intervals get ] dip '[ - dup end>> _ < - [ [ handle-spill ] [ handle-copy ] bi f ] [ drop t ] if - ] filter-here + pending-intervals get (expire-old-intervals) ] { } make mapping-instructions % ; : insert-reload ( live-interval -- ) @@ -111,14 +116,12 @@ ERROR: overlapping-registers intervals ; dup [ reg>> ] map all-unique? [ drop ] [ overlapping-registers ] if ; : active-intervals ( n -- intervals ) - pending-intervals get [ covers? ] with filter + pending-intervals get heap-values [ covers? ] with filter check-assignment? get [ dup check-assignment ] when ; M: vreg-insn assign-registers-in-insn - dup [ all-vregs ] [ insn#>> active-intervals ] bi - '[ _ [ vreg>> = ] with find nip ] map - register-mapping - >>regs drop ; + dup [ all-vregs ] [ insn#>> active-intervals register-mapping ] bi + extract-keys >>regs drop ; M: ##gc assign-registers-in-insn ! This works because ##gc is always the first instruction diff --git a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor index d2fa661136..68a780d42a 100644 --- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor +++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: namespaces kernel assocs accessors sequences math math.order fry -combinators compiler.cfg.instructions compiler.cfg.registers +combinators binary-search compiler.cfg.instructions compiler.cfg.registers compiler.cfg.def-use compiler.cfg.liveness compiler.cfg ; IN: compiler.cfg.linear-scan.live-intervals @@ -16,16 +16,21 @@ split-before split-after split-next start end ranges uses copy-from ; -: covers? ( insn# live-interval -- ? ) - ranges>> [ [ from>> ] [ to>> ] bi between? ] with any? ; +GENERIC: covers? ( insn# obj -- ? ) -: child-interval-at ( insn# interval -- interval' ) - dup split-after>> [ - 2dup split-after>> start>> < - [ split-before>> ] [ split-after>> ] if - child-interval-at - ] [ nip ] if ; +M: f covers? 2drop f ; +M: live-range covers? [ from>> ] [ to>> ] bi between? ; + +M: live-interval covers? ( insn# live-interval -- ? ) + ranges>> + dup length 4 <= [ + [ covers? ] with any? + ] [ + [ drop ] [ [ from>> <=> ] with search nip ] 2bi + covers? + ] if ; + ERROR: dead-value-error vreg ; : shorten-range ( n live-interval -- )