diff --git a/unfinished/compiler/backend/x86/32/32.factor b/unfinished/compiler/backend/x86/32/32.factor index 98726d7e35..fabdaa7ff3 100644 --- a/unfinished/compiler/backend/x86/32/32.factor +++ b/unfinished/compiler/backend/x86/32/32.factor @@ -7,5 +7,5 @@ IN: compiler.backend.x86.32 M: x86.32 machine-registers { { int-regs { EAX ECX EDX EBP EBX } } - { float-regs { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } } + { double-float-regs { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 } } } ; diff --git a/unfinished/compiler/backend/x86/64/64.factor b/unfinished/compiler/backend/x86/64/64.factor index fe21fadbd5..9499995068 100644 --- a/unfinished/compiler/backend/x86/64/64.factor +++ b/unfinished/compiler/backend/x86/64/64.factor @@ -7,7 +7,7 @@ IN: compiler.backend.x86.64 M: x86.64 machine-registers { { int-regs { RAX RCX RDX RBP RSI RDI R8 R9 R10 R11 R12 R13 } } - { float-regs { + { double-float-regs { XMM0 XMM1 XMM2 XMM3 XMM4 XMM5 XMM6 XMM7 XMM8 XMM9 XMM10 XMM11 XMM12 XMM13 XMM14 XMM15 } } diff --git a/unfinished/compiler/cfg/instructions/instructions.factor b/unfinished/compiler/cfg/instructions/instructions.factor index ac3b3b75a0..5fd7608a4c 100644 --- a/unfinished/compiler/cfg/instructions/instructions.factor +++ b/unfinished/compiler/cfg/instructions/instructions.factor @@ -1,14 +1,14 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: assocs accessors arrays kernel sequences namespaces -math compiler.cfg.instructions.syntax ; +math compiler.cfg.registers compiler.cfg.instructions.syntax ; IN: compiler.cfg.instructions ! Virtual CPU instructions, used by CFG and machine IRs -INSN: %cond-branch src ; -INSN: %unary dst src ; -INSN: %nullary dst ; +TUPLE: %cond-branch < insn src ; +TUPLE: %unary < insn dst src ; +TUPLE: %nullary < insn dst ; ! Stack operations INSN: %load-literal < %nullary obj ; @@ -50,12 +50,12 @@ INSN: %alien-callback params ; GENERIC: defs-vregs ( insn -- seq ) GENERIC: uses-vregs ( insn -- seq ) -M: %nullary defs-vregs dst>> 1array ; -M: %unary defs-vregs dst>> 1array ; +M: %nullary defs-vregs dst>> >vreg 1array ; +M: %unary defs-vregs dst>> >vreg 1array ; M: insn defs-vregs drop f ; -M: %replace uses-vregs src>> 1array ; -M: %unary uses-vregs src>> 1array ; +M: %replace uses-vregs src>> >vreg 1array ; +M: %unary uses-vregs src>> >vreg 1array ; M: insn uses-vregs drop f ; ! M: %intrinsic uses-vregs vregs>> values ; @@ -75,7 +75,7 @@ M: %cond-branch uses-vregs src>> 1array ; ! M: %if-intrinsic uses-vregs vregs>> values ; -M: %boolean-intrinsic defs-vregs out>> 1array ; +M: %boolean-intrinsic defs-vregs dst>> 1array ; ! M: %boolean-intrinsic uses-vregs ! [ vregs>> values ] [ out>> ] bi suffix ; @@ -94,14 +94,14 @@ INSN: _label label ; : resolve-label ( label/name -- ) dup label? [ get ] unless _label ; -TUPLE: _cond-branch src label ; +TUPLE: _cond-branch < insn src label ; INSN: _branch label ; INSN: _branch-f < _cond-branch ; INSN: _branch-t < _cond-branch ; INSN: _if-intrinsic label quot vregs ; -M: _cond-branch uses-vregs src>> 1array ; +M: _cond-branch uses-vregs src>> >vreg 1array ; ! M: _if-intrinsic uses-vregs vregs>> values ; INSN: _spill src n ; diff --git a/unfinished/compiler/cfg/instructions/syntax/syntax.factor b/unfinished/compiler/cfg/instructions/syntax/syntax.factor index 30bec6ac37..6d533d2059 100644 --- a/unfinished/compiler/cfg/instructions/syntax/syntax.factor +++ b/unfinished/compiler/cfg/instructions/syntax/syntax.factor @@ -1,15 +1,15 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: classes.tuple classes.tuple.parser kernel words -make parser ; +make fry sequences parser ; IN: compiler.cfg.instructions.syntax TUPLE: insn ; : INSN: - parse-tuple-definition + parse-tuple-definition "regs" suffix [ dup tuple eq? [ drop insn ] when ] dip [ define-tuple-class ] [ 2drop save-location ] - [ 2drop dup [ boa , ] curry define-inline ] + [ 2drop dup '[ f _ boa , ] define-inline ] 3tri ; parsing diff --git a/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor b/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor index d0b1176c68..0bfcc8bcd0 100644 --- a/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor +++ b/unfinished/compiler/cfg/linear-scan/allocation/allocation.factor @@ -140,7 +140,7 @@ SYMBOL: spill-counter : init-allocator ( registers -- ) V{ } clone active-intervals set unhandled-intervals set - [ >vector ] assoc-map free-registers set + [ reverse >vector ] assoc-map free-registers set 0 spill-counter set -1 progress set ; @@ -150,10 +150,10 @@ SYMBOL: spill-counter : (allocate-registers) ( -- ) unhandled-intervals get [ handle-interval ] slurp-heap ; -: allocate-registers ( live-intervals machine-registers -- ) +: allocate-registers ( live-intervals machine-registers -- live-intervals ) #! This modifies the input live-intervals. [ init-allocator - init-unhandled + dup init-unhandled (allocate-registers) ] with-scope ; diff --git a/unfinished/compiler/cfg/linear-scan/assignment/assignment-tests.factor b/unfinished/compiler/cfg/linear-scan/assignment/assignment-tests.factor new file mode 100644 index 0000000000..9efc23651b --- /dev/null +++ b/unfinished/compiler/cfg/linear-scan/assignment/assignment-tests.factor @@ -0,0 +1,4 @@ +USING: compiler.cfg.linear-scan.assignment tools.test ; +IN: compiler.cfg.linear-scan.assignment.tests + +\ assign-registers must-infer diff --git a/unfinished/compiler/cfg/linear-scan/rewriting/rewriting.factor b/unfinished/compiler/cfg/linear-scan/assignment/assignment.factor similarity index 68% rename from unfinished/compiler/cfg/linear-scan/rewriting/rewriting.factor rename to unfinished/compiler/cfg/linear-scan/assignment/assignment.factor index ad9e58c2ec..8b53ee9531 100644 --- a/unfinished/compiler/cfg/linear-scan/rewriting/rewriting.factor +++ b/unfinished/compiler/cfg/linear-scan/assignment/assignment.factor @@ -5,7 +5,7 @@ fry make compiler.cfg.registers compiler.cfg.instructions compiler.cfg.linear-scan.live-intervals ; -IN: compiler.cfg.linear-scan.rewriting +IN: compiler.cfg.linear-scan.assignment ! A vector of live intervals. There is linear searching involved ! but since we never have too many machine registers (around 30 @@ -55,45 +55,24 @@ SYMBOL: unhandled-intervals ] [ 2drop ] if ] if ; -GENERIC: rewrite-instruction ( insn -- ) +: (assign-registers) ( insn -- ) + dup + [ defs-vregs ] [ uses-vregs ] bi append + active-intervals get swap '[ vreg>> _ member? ] filter + [ [ vreg>> ] [ reg>> ] bi ] { } map>assoc + >>regs drop ; -M: %cond-branch rewrite-instruction - [ lookup-register ] change-vreg - drop ; +: init-assignment ( live-intervals -- ) + V{ } clone active-intervals set + unhandled-intervals set + init-unhandled ; -M: %unary rewrite-instruction - [ lookup-register ] change-dst - [ lookup-register ] change-src - drop ; - -M: %peek rewrite-instruction - [ lookup-register ] change-vreg - drop ; - -M: %replace rewrite-instruction - [ lookup-register ] change-vreg - drop ; - -M: %load-literal rewrite-instruction - [ lookup-register ] change-vreg - drop ; - -: lookup-registers ( assoc -- assoc' ) - [ dup vreg? [ lookup-register ] when ] assoc-map ; - -M: %intrinsic rewrite-instruction - [ lookup-registers ] change-vregs - drop ; - -M: _if-intrinsic rewrite-instruction - [ lookup-registers ] change-vregs - drop ; - -: rewrite-instructions ( insns -- insns' ) +: assign-registers ( insns live-intervals -- insns' ) [ + init-assignment [ [ activate-new-intervals ] - [ drop [ rewrite-instruction ] [ , ] bi ] + [ drop [ (assign-registers) ] [ , ] bi ] [ expire-old-intervals ] tri ] each-index diff --git a/unfinished/compiler/cfg/linear-scan/debugger/debugger.factor b/unfinished/compiler/cfg/linear-scan/debugger/debugger.factor index 88cff9e95f..89bf81d2ba 100644 --- a/unfinished/compiler/cfg/linear-scan/debugger/debugger.factor +++ b/unfinished/compiler/cfg/linear-scan/debugger/debugger.factor @@ -19,5 +19,5 @@ IN: compiler.cfg.linear-scan.debugger ] [ 1array ] if ; : check-linear-scan ( live-intervals machine-registers -- ) - [ [ clone ] map dup ] dip allocate-registers + [ [ clone ] map ] dip allocate-registers [ split-children ] map concat check-assigned ; diff --git a/unfinished/compiler/cfg/linear-scan/linear-scan.factor b/unfinished/compiler/cfg/linear-scan/linear-scan.factor index 307eecf53a..cbbb33b6c9 100644 --- a/unfinished/compiler/cfg/linear-scan/linear-scan.factor +++ b/unfinished/compiler/cfg/linear-scan/linear-scan.factor @@ -1,6 +1,19 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. +USING: kernel accessors +compiler.backend +compiler.cfg +compiler.cfg.linear-scan.live-intervals +compiler.cfg.linear-scan.allocation +compiler.cfg.linear-scan.assignment ; IN: compiler.cfg.linear-scan ! See http://www.cs.ucla.edu/~palsberg/course/cs132/linearscan.pdf +! and http://www.ssw.uni-linz.ac.at/Research/Papers/Wimmer04Master/ +: linear-scan ( mr -- mr' ) + [ + dup compute-live-intervals + machine-registers allocate-registers + assign-registers + ] change-instructions ; diff --git a/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor b/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor index f3f20680e6..d6ee979fe5 100644 --- a/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor +++ b/unfinished/compiler/cfg/linear-scan/live-intervals/live-intervals.factor @@ -33,15 +33,17 @@ SYMBOL: live-intervals : compute-live-intervals* ( insn n -- ) live-intervals get - [ [ uses-vregs ] 2dip '[ _ swap >vreg _ add-use ] each ] - [ [ defs-vregs ] 2dip '[ _ swap >vreg _ new-live-interval ] each ] + [ [ uses-vregs ] 2dip '[ _ swap _ add-use ] each ] + [ [ defs-vregs ] 2dip '[ _ swap _ new-live-interval ] each ] 3bi ; -: finalize-live-intervals ( -- ) +: finalize-live-intervals ( assoc -- seq' ) #! Reverse uses lists so that we can pop values off. - live-intervals get [ nip uses>> reverse-here ] assoc-each ; + values dup [ uses>> reverse-here ] each ; -: compute-live-intervals ( instructions -- ) - H{ } clone live-intervals set - [ compute-live-intervals* ] each-index - finalize-live-intervals ; +: compute-live-intervals ( instructions -- live-intervals ) + H{ } clone [ + live-intervals [ + [ compute-live-intervals* ] each-index + ] with-variable + ] keep finalize-live-intervals ; diff --git a/unfinished/compiler/cfg/linear-scan/rewriting/rewriting-tests.factor b/unfinished/compiler/cfg/linear-scan/rewriting/rewriting-tests.factor deleted file mode 100644 index 63a411c777..0000000000 --- a/unfinished/compiler/cfg/linear-scan/rewriting/rewriting-tests.factor +++ /dev/null @@ -1,4 +0,0 @@ -USING: compiler.cfg.linear-scan.rewriting tools.test ; -IN: compiler.cfg.linear-scan.rewriting.tests - -\ rewrite-instructions must-infer diff --git a/unfinished/compiler/cfg/linearization/linearization.factor b/unfinished/compiler/cfg/linearization/linearization.factor index 7c25a1b3bf..b1288fb301 100644 --- a/unfinished/compiler/cfg/linearization/linearization.factor +++ b/unfinished/compiler/cfg/linearization/linearization.factor @@ -56,7 +56,7 @@ M: %branch linearize-insn dup successors>> first2 swap label>> ; inline : boolean-conditional ( basic-block insn -- basic-block successor vreg label2 ) - [ conditional ] [ dst>> ] bi* swap ; inline + [ conditional ] [ src>> ] bi* swap ; inline M: %branch-f linearize-insn boolean-conditional _branch-f emit-branch ; @@ -73,10 +73,10 @@ M: %boolean-intrinsic linearize-insn "false" define-label "end" define-label "false" get over [ quot>> ] [ vregs>> ] bi _if-intrinsic - dup out>> t %load-literal + dup dst>> t %load-literal "end" get _branch "false" resolve-label - dup out>> f %load-literal + dup dst>> f %load-literal "end" resolve-label ] with-scope 2drop ;