From b776a925465b59ab0231a54f8e4f50640ffe19c9 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Sun, 18 Jul 2010 17:38:29 -0400 Subject: [PATCH] compiler.cfg.linear-scan: fix bad interaction between split position calculation and register-clobbering instructions --- .../linear-scan/allocation/allocation.factor | 45 ++++++------------- .../allocation/spilling/spilling.factor | 7 +-- .../live-intervals/live-intervals.factor | 36 ++++++++++----- 3 files changed, 43 insertions(+), 45 deletions(-) diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor index 92f09c650f..d4f79e5cb3 100644 --- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor +++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor @@ -48,52 +48,33 @@ IN: compiler.cfg.linear-scan.allocation 2dup spill-at-sync-point? [ swap n>> spill f ] [ 2drop t ] if ; -: handle-interval ( live-interval -- ) +GENERIC: handle ( obj -- ) + +M: live-interval handle [ start>> deactivate-intervals ] [ start>> activate-intervals ] [ assign-register ] tri ; -: (handle-sync-point) ( sync-point -- ) +: handle-sync-point ( sync-point -- ) active-intervals get values [ [ spill-at-sync-point ] with filter! drop ] with each ; -: handle-sync-point ( sync-point -- ) +M: sync-point handle ( sync-point -- ) [ n>> deactivate-intervals ] - [ (handle-sync-point) ] + [ handle-sync-point ] [ n>> activate-intervals ] tri ; +: smallest-heap ( heap1 heap2 -- heap ) + [ [ heap-peek nip ] bi@ <= ] most ; + :: (allocate-registers-step) ( unhandled-intervals unhandled-sync-points -- ) { - { - [ unhandled-intervals heap-empty? ] - [ unhandled-sync-points heap-pop drop handle-sync-point ] - } - { - [ unhandled-sync-points heap-empty? ] - [ unhandled-intervals heap-pop drop handle-interval ] - } - [ - unhandled-intervals heap-peek :> ( i ik ) - unhandled-sync-points heap-peek :> ( s sk ) - { - { - [ ik sk < ] - [ unhandled-intervals heap-pop* i handle-interval ] - } - { - [ ik sk > ] - [ unhandled-sync-points heap-pop* s handle-sync-point ] - } - [ - unhandled-intervals heap-pop* - i handle-interval - s (handle-sync-point) - ] - } cond - ] - } cond ; + { [ unhandled-intervals heap-empty? ] [ unhandled-sync-points ] } + { [ unhandled-sync-points heap-empty? ] [ unhandled-intervals ] } + [ unhandled-sync-points unhandled-intervals smallest-heap ] + } cond heap-pop drop handle ; : (allocate-registers) ( unhandled-intervals unhandled-sync-points -- ) 2dup [ heap-empty? ] both? [ 2drop ] [ diff --git a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor index e773cb9e46..bc1f538a5c 100644 --- a/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor +++ b/basis/compiler/cfg/linear-scan/allocation/spilling/spilling.factor @@ -79,12 +79,13 @@ ERROR: bad-live-ranges interval ; : split-for-spill ( live-interval n -- before after ) split-interval [ spill-before ] [ spill-after ] bi* ; -: find-use-position ( live-interval new -- n ) - [ uses>> ] [ start>> '[ n>> _ >= ] ] bi* find nip +: find-next-use ( live-interval new -- n ) + [ uses>> ] [ start>> ] bi* + '[ [ spill-slot?>> not ] [ n>> ] bi _ >= and ] find nip [ n>> ] [ 1/0. ] if* ; : find-use-positions ( live-intervals new assoc -- ) - '[ [ _ find-use-position ] [ reg>> ] bi _ add-use-position ] each ; + '[ [ _ find-next-use ] [ reg>> ] bi _ add-use-position ] each ; : active-positions ( new assoc -- ) [ [ active-intervals-for ] keep ] dip 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 665ffc324d..fbe0cd4507 100644 --- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor +++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor @@ -16,7 +16,7 @@ TUPLE: live-range from to ; C: live-range -TUPLE: vreg-use n def-rep use-rep ; +TUPLE: vreg-use n def-rep use-rep spill-slot? ; : ( n -- vreg-use ) vreg-use new swap >>n ; @@ -36,8 +36,10 @@ reg-class ; : last-use? ( insn# uses -- use/f ) [ drop f ] [ last [ n>> = ] keep and ] if-empty ; -: (add-use) ( insn# live-interval -- use ) - uses>> 2dup last-use? dup [ 2nip ] [ drop new-use ] if ; +:: (add-use) ( insn# live-interval spill-slot? -- use ) + live-interval uses>> :> uses + insn# uses last-use? [ insn# uses new-use ] unless* + spill-slot? [ t >>spill-slot? ] when ; GENERIC: covers? ( insn# obj -- ? ) @@ -105,28 +107,42 @@ GENERIC: compute-live-intervals* ( insn -- ) M: insn compute-live-intervals* drop ; -:: record-def ( vreg n -- ) +:: record-def ( vreg n spill-slot? -- ) vreg live-interval :> live-interval n live-interval shorten-range - n live-interval (add-use) vreg rep-of >>def-rep drop ; + n live-interval spill-slot? (add-use) vreg rep-of >>def-rep drop ; -:: record-use ( vreg n -- ) +:: record-use ( vreg n spill-slot? -- ) vreg live-interval :> live-interval from get n live-interval add-range - n live-interval (add-use) vreg rep-of >>use-rep drop ; + n live-interval spill-slot? (add-use) vreg rep-of >>use-rep drop ; :: record-temp ( vreg n -- ) vreg live-interval :> live-interval n n live-interval add-range - n live-interval (add-use) vreg rep-of >>def-rep drop ; + n live-interval f (add-use) vreg rep-of >>def-rep drop ; M: vreg-insn compute-live-intervals* ( insn -- ) dup insn#>> - [ [ defs-vregs ] dip '[ _ record-def ] each ] - [ [ uses-vregs ] dip '[ _ record-use ] each ] + [ [ defs-vregs ] dip '[ _ f record-def ] each ] + [ [ uses-vregs ] dip '[ _ f record-use ] each ] + [ [ temp-vregs ] dip '[ _ record-temp ] each ] + 2tri ; + +M: clobber-insn compute-live-intervals* ( insn -- ) + dup insn#>> + [ [ defs-vregs ] dip '[ _ f record-def ] each ] + [ [ uses-vregs ] dip '[ _ t record-use ] each ] + [ [ temp-vregs ] dip '[ _ record-temp ] each ] + 2tri ; + +M: hairy-clobber-insn compute-live-intervals* ( insn -- ) + dup insn#>> + [ [ defs-vregs ] dip '[ _ t record-def ] each ] + [ [ uses-vregs ] dip '[ _ t record-use ] each ] [ [ temp-vregs ] dip '[ _ record-temp ] each ] 2tri ;