diff --git a/basis/compiler/cfg/debugger/debugger.factor b/basis/compiler/cfg/debugger/debugger.factor index a04670ddab..6665564c91 100644 --- a/basis/compiler/cfg/debugger/debugger.factor +++ b/basis/compiler/cfg/debugger/debugger.factor @@ -16,7 +16,7 @@ M: word test-cfg [ build-tree-from-word nip optimize-tree ] keep build-cfg ; : test-mr ( quot -- mrs ) - test-cfg [ build-mr ] map ; + test-cfg [ build-mr linear-scan build-stack-frame ] map ; : mr. ( mrs -- ) [ diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor index 1b49609387..9402e4d841 100644 --- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor +++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor @@ -18,16 +18,22 @@ SYMBOL: free-registers ! Vector of active live intervals SYMBOL: active-intervals +: active-intervals-for ( vreg -- seq ) + reg-class>> active-intervals get at ; + : add-active ( live-interval -- ) - active-intervals get push ; + dup vreg>> active-intervals-for push ; : delete-active ( live-interval -- ) - active-intervals get delete ; + dup vreg>> active-intervals-for delq ; : expire-old-intervals ( n -- ) - active-intervals get - [ end>> > ] with partition - [ [ deallocate-register ] each ] [ active-intervals set ] bi* ; + active-intervals swap '[ + [ + [ end>> _ < ] partition + [ [ deallocate-register ] each ] dip + ] assoc-map + ] change ; ! Minheap of live intervals which still need a register allocation SYMBOL: unhandled-intervals @@ -115,7 +121,7 @@ SYMBOL: spill-counts over start>> '[ _ [ > ] find-use nip -1 or ] bi@ < ; : assign-blocked-register ( new -- ) - [ active-intervals get ] keep interval-to-spill + [ dup vreg>> active-intervals-for ] keep interval-to-spill 2dup spill-existing? [ spill-existing ] [ spill-new ] if ; : assign-free-register ( new registers -- ) @@ -126,11 +132,13 @@ SYMBOL: spill-counts [ assign-blocked-register ] [ assign-free-register ] if-empty ; ! Main loop +: reg-classes ( -- seq ) { int-regs double-float-regs } ; inline + : init-allocator ( registers -- ) - V{ } clone active-intervals set unhandled-intervals set [ reverse >vector ] assoc-map free-registers set - H{ { int-regs 0 } { double-float-regs 0 } } clone spill-counts set + reg-classes [ 0 ] { } map>assoc spill-counts set + reg-classes [ V{ } clone ] { } map>assoc active-intervals set -1 progress set ; : handle-interval ( live-interval -- ) diff --git a/basis/compiler/tests/templates.factor b/basis/compiler/tests/templates.factor index c8baaea164..a979a19e83 100644 --- a/basis/compiler/tests/templates.factor +++ b/basis/compiler/tests/templates.factor @@ -101,7 +101,6 @@ unit-test ] [ define-temp ] with-compilation-unit drop ] unit-test - ! Test how dispatch handles the end of a basic block : try-breaking-dispatch ( n a b -- a b str ) float+ swap { [ "hey" ] [ "bye" ] } dispatch ; @@ -189,7 +188,7 @@ TUPLE: my-tuple ; ] unit-test ! Regression -: a-dummy ( -- ) drop "hi" print ; +: a-dummy ( a -- ) drop "hi" print ; [ ] [ 1 [ @@ -245,8 +244,96 @@ TUPLE: my-tuple ; [ dup float+ ] } cleave ; +[ 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 2.0 ] +[ 1.0 float-spill-bug ] unit-test + [ t ] [ \ float-spill-bug compiled>> ] unit-test +: float-fixnum-spill-bug ( object -- object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object object ) + { + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + [ dup float+ ] + [ float>fixnum dup fixnum+fast ] + } cleave ; + +[ 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 2.0 2 ] +[ 1.0 float-fixnum-spill-bug ] unit-test + +[ t ] [ \ float-fixnum-spill-bug compiled>> ] unit-test + ! Regression : dispatch-alignment-regression ( -- c ) { tuple vector } 3 slot { word } declare diff --git a/basis/cpu/x86/architecture/architecture.factor b/basis/cpu/x86/architecture/architecture.factor index bfcb79d41d..3b48610fe7 100644 --- a/basis/cpu/x86/architecture/architecture.factor +++ b/basis/cpu/x86/architecture/architecture.factor @@ -15,12 +15,24 @@ HOOK: stack-reg cpu ( -- reg ) : stack@ ( n -- op ) stack-reg swap [+] ; +: spill-integer-base ( stack-frame -- n ) + [ params>> ] [ return>> ] bi + ; + : spill-integer@ ( n -- op ) - cells stack-frame get [ params>> ] [ return>> ] bi + + stack@ ; + cells + stack-frame get spill-integer-base + + stack@ ; + +: spill-float-base ( stack-frame -- n ) + [ spill-counts>> int-regs swap at int-regs reg-size * ] + [ params>> ] + [ return>> ] + tri + + ; : spill-float@ ( n -- op ) - #! XXX - cells stack-frame get [ params>> ] [ return>> ] bi + + stack@ ; + double-float-regs reg-size * + stack-frame get spill-float-base + + stack@ ; : next-stack@ ( n -- operand ) #! nth parameter from the next stack frame. Used to box