diff --git a/basis/compiler/cfg/block-joining/block-joining.factor b/basis/compiler/cfg/block-joining/block-joining.factor new file mode 100644 index 0000000000..982f0866e6 --- /dev/null +++ b/basis/compiler/cfg/block-joining/block-joining.factor @@ -0,0 +1,43 @@ +! Copyright (C) 2009 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors combinators.short-circuit kernel sequences math +compiler.utilities compiler.cfg compiler.cfg.instructions compiler.cfg.rpo +compiler.cfg.utilities ; +IN: compiler.cfg.block-joining + +! Joining blocks that are not calls and are connected by a single CFG edge. +! Predecessors must be recomputed after this. Also this pass does not +! update ##phi nodes and should therefore only run before stack analysis. + +: kill-vreg-block? ( bb -- ? ) + instructions>> { + [ length 2 >= ] + [ penultimate kill-vreg-insn? ] + } 1&& ; + +: predecessor ( bb -- pred ) + predecessors>> first ; inline + +: join-block? ( bb -- ? ) + { + [ predecessors>> length 1 = ] + [ predecessor kill-vreg-block? not ] + [ predecessor successors>> length 1 = ] + [ [ predecessor ] keep back-edge? not ] + } 1&& ; + +: join-instructions ( bb pred -- ) + [ instructions>> ] bi@ dup pop* push-all ; + +: update-successors ( bb pred -- ) + [ successors>> ] dip (>>successors) ; + +: join-block ( bb pred -- ) + [ join-instructions ] [ update-successors ] 2bi ; + +: join-blocks ( cfg -- cfg' ) + dup post-order [ + dup join-block? + [ dup predecessor join-block ] [ drop ] if + ] each + cfg-changed ; diff --git a/basis/compiler/cfg/branch-splitting/branch-splitting-tests.factor b/basis/compiler/cfg/branch-splitting/branch-splitting-tests.factor index fbaaf92203..89f26f7928 100644 --- a/basis/compiler/cfg/branch-splitting/branch-splitting-tests.factor +++ b/basis/compiler/cfg/branch-splitting/branch-splitting-tests.factor @@ -1,6 +1,6 @@ USING: accessors assocs compiler.cfg compiler.cfg.branch-splitting compiler.cfg.debugger -compiler.cfg.predecessors compiler.cfg.rpo fry kernel +compiler.cfg.predecessors compiler.cfg.rpo compiler.cfg.instructions fry kernel tools.test namespaces sequences vectors ; IN: compiler.cfg.branch-splitting.tests @@ -20,31 +20,31 @@ IN: compiler.cfg.branch-splitting.tests : test-branch-splitting ( -- ) cfg new 0 get >>entry check-branch-splitting ; -V{ } 0 test-bb +V{ T{ ##branch } } 0 test-bb -V{ } 1 test-bb +V{ T{ ##branch } } 1 test-bb -V{ } 2 test-bb +V{ T{ ##branch } } 2 test-bb -V{ } 3 test-bb +V{ T{ ##branch } } 3 test-bb -V{ } 4 test-bb +V{ T{ ##branch } } 4 test-bb test-diamond [ ] [ test-branch-splitting ] unit-test -V{ } 0 test-bb +V{ T{ ##branch } } 0 test-bb -V{ } 1 test-bb +V{ T{ ##branch } } 1 test-bb -V{ } 2 test-bb +V{ T{ ##branch } } 2 test-bb -V{ } 3 test-bb +V{ T{ ##branch } } 3 test-bb -V{ } 4 test-bb +V{ T{ ##branch } } 4 test-bb -V{ } 5 test-bb +V{ T{ ##branch } } 5 test-bb 0 get 1 get 2 get V{ } 2sequence >>successors drop @@ -54,15 +54,15 @@ V{ } 5 test-bb [ ] [ test-branch-splitting ] unit-test -V{ } 0 test-bb +V{ T{ ##branch } } 0 test-bb -V{ } 1 test-bb +V{ T{ ##branch } } 1 test-bb -V{ } 2 test-bb +V{ T{ ##branch } } 2 test-bb -V{ } 3 test-bb +V{ T{ ##branch } } 3 test-bb -V{ } 4 test-bb +V{ T{ ##branch } } 4 test-bb 0 get 1 get 2 get V{ } 2sequence >>successors drop @@ -72,11 +72,11 @@ V{ } 4 test-bb [ ] [ test-branch-splitting ] unit-test -V{ } 0 test-bb +V{ T{ ##branch } } 0 test-bb -V{ } 1 test-bb +V{ T{ ##branch } } 1 test-bb -V{ } 2 test-bb +V{ T{ ##branch } } 2 test-bb 0 get 1 get 2 get V{ } 2sequence >>successors drop diff --git a/basis/compiler/cfg/branch-splitting/branch-splitting.factor b/basis/compiler/cfg/branch-splitting/branch-splitting.factor index 9d6e59e4da..2ab476e20c 100644 --- a/basis/compiler/cfg/branch-splitting/branch-splitting.factor +++ b/basis/compiler/cfg/branch-splitting/branch-splitting.factor @@ -63,7 +63,9 @@ IN: compiler.cfg.branch-splitting UNION: irrelevant ##peek ##replace ##inc-d ##inc-r ; : split-instructions? ( insns -- ? ) - [ irrelevant? not ] count 5 <= ; + [ [ irrelevant? not ] count 5 <= ] + [ last ##fixnum-overflow? not ] + bi and ; : split-branch? ( bb -- ? ) { diff --git a/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor index e5be2d9eb9..71798da6fc 100644 --- a/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor +++ b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: namespaces accessors math.order assocs kernel sequences combinators make classes words cpu.architecture @@ -36,12 +36,6 @@ M: insn compute-stack-frame* ] when ; \ _spill t frame-required? set-word-prop -\ ##fixnum-add t frame-required? set-word-prop -\ ##fixnum-sub t frame-required? set-word-prop -\ ##fixnum-mul t frame-required? set-word-prop -\ ##fixnum-add-tail f frame-required? set-word-prop -\ ##fixnum-sub-tail f frame-required? set-word-prop -\ ##fixnum-mul-tail f frame-required? set-word-prop : compute-stack-frame ( insns -- ) frame-required? off diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor index 991fd2e20d..c866835ac5 100755 --- a/basis/compiler/cfg/builder/builder.factor +++ b/basis/compiler/cfg/builder/builder.factor @@ -98,17 +98,10 @@ M: #recursive emit-node ! #if : emit-branch ( obj -- final-bb ) - [ - begin-basic-block - emit-nodes - basic-block get dup [ ##branch ] when - ] with-scope ; + [ emit-nodes ] with-branch ; : emit-if ( node -- ) - children>> [ emit-branch ] map - end-basic-block - begin-basic-block - basic-block get '[ [ _ swap successors>> push ] when* ] each ; + children>> [ emit-branch ] map emit-conditional ; : ##branch-t ( vreg -- ) \ f tag-number cc/= ##compare-imm-branch ; diff --git a/basis/compiler/cfg/checker/checker.factor b/basis/compiler/cfg/checker/checker.factor index e7d9dbdd9c..49ea775600 100644 --- a/basis/compiler/cfg/checker/checker.factor +++ b/basis/compiler/cfg/checker/checker.factor @@ -16,9 +16,9 @@ ERROR: last-insn-not-a-jump insn ; [ ##return? ] [ ##callback-return? ] [ ##jump? ] - [ ##fixnum-add-tail? ] - [ ##fixnum-sub-tail? ] - [ ##fixnum-mul-tail? ] + [ ##fixnum-add? ] + [ ##fixnum-sub? ] + [ ##fixnum-mul? ] [ ##no-tco? ] } 1|| [ drop ] [ last-insn-not-a-jump ] if ; diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor index 43ea89f284..c8a9d1861b 100644 --- a/basis/compiler/cfg/def-use/def-use.factor +++ b/basis/compiler/cfg/def-use/def-use.factor @@ -8,6 +8,7 @@ GENERIC: temp-vregs ( insn -- seq ) GENERIC: uses-vregs ( insn -- seq ) M: ##flushable defs-vregs dst>> 1array ; +M: ##fixnum-overflow defs-vregs dst>> 1array ; M: insn defs-vregs drop f ; M: ##write-barrier temp-vregs [ card#>> ] [ table>> ] bi 2array ; @@ -21,8 +22,6 @@ M: ##set-string-nth-fast temp-vregs temp>> 1array ; M: ##compare temp-vregs temp>> 1array ; M: ##compare-imm temp-vregs temp>> 1array ; M: ##compare-float temp-vregs temp>> 1array ; -M: ##fixnum-mul temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ; -M: ##fixnum-mul-tail temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ; M: ##gc temp-vregs [ temp1>> ] [ temp2>> ] bi 2array ; M: _dispatch temp-vregs temp>> 1array ; M: insn temp-vregs drop f ; diff --git a/basis/compiler/cfg/hats/hats.factor b/basis/compiler/cfg/hats/hats.factor index b61f091fad..986438d055 100644 --- a/basis/compiler/cfg/hats/hats.factor +++ b/basis/compiler/cfg/hats/hats.factor @@ -73,5 +73,7 @@ IN: compiler.cfg.hats : ^^offset>slot ( vreg -- vreg' ) cell 4 = [ 1 ^^shr-imm ] when ; inline : ^^tag-fixnum ( src -- dst ) ^^i1 ##tag-fixnum ; inline : ^^untag-fixnum ( src -- dst ) ^^i1 ##untag-fixnum ; inline - +: ^^fixnum-add ( src1 src2 -- dst ) ^^i2 ##fixnum-add ; inline +: ^^fixnum-sub ( src1 src2 -- dst ) ^^i2 ##fixnum-sub ; inline +: ^^fixnum-mul ( src1 src2 -- dst ) ^^i2 ##fixnum-mul ; inline : ^^phi ( inputs -- dst ) ^^i1 ##phi ; inline \ No newline at end of file diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 910cb1992b..8d4b0f40ad 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -92,15 +92,6 @@ INSN: ##sar-imm < ##binary-imm ; INSN: ##not < ##unary ; INSN: ##log2 < ##unary ; -! Overflowing arithmetic -TUPLE: ##fixnum-overflow < insn src1 src2 ; -INSN: ##fixnum-add < ##fixnum-overflow ; -INSN: ##fixnum-add-tail < ##fixnum-overflow ; -INSN: ##fixnum-sub < ##fixnum-overflow ; -INSN: ##fixnum-sub-tail < ##fixnum-overflow ; -INSN: ##fixnum-mul < ##fixnum-overflow temp1 temp2 ; -INSN: ##fixnum-mul-tail < ##fixnum-overflow temp1 temp2 ; - : ##tag-fixnum ( dst src -- ) tag-bits get ##shl-imm ; inline : ##untag-fixnum ( dst src -- ) tag-bits get ##sar-imm ; inline @@ -181,6 +172,7 @@ INSN: ##loop-entry ; INSN: ##phi < ##pure inputs ; +! Conditionals TUPLE: ##conditional-branch < insn { src1 vreg } { src2 vreg } cc ; INSN: ##compare-branch < ##conditional-branch ; @@ -192,6 +184,12 @@ INSN: ##compare-imm < ##binary-imm cc temp ; INSN: ##compare-float-branch < ##conditional-branch ; INSN: ##compare-float < ##binary cc temp ; +! Overflowing arithmetic +TUPLE: ##fixnum-overflow < insn { dst vreg } { src1 vreg } { src2 vreg } ; +INSN: ##fixnum-add < ##fixnum-overflow ; +INSN: ##fixnum-sub < ##fixnum-overflow ; +INSN: ##fixnum-mul < ##fixnum-overflow ; + INSN: ##gc { temp1 vreg } { temp2 vreg } live-values ; ! Instructions used by machine IR only. @@ -212,6 +210,12 @@ INSN: _compare-imm-branch label { src1 vreg } { src2 integer } cc ; INSN: _compare-float-branch < _conditional-branch ; +! Overflowing arithmetic +TUPLE: _fixnum-overflow < insn label { dst vreg } { src1 vreg } { src2 vreg } ; +INSN: _fixnum-add < _fixnum-overflow ; +INSN: _fixnum-sub < _fixnum-overflow ; +INSN: _fixnum-mul < _fixnum-overflow ; + TUPLE: spill-slot n ; C: spill-slot INSN: _gc { temp1 vreg } { temp2 vreg } gc-roots gc-root-count gc-root-size ; @@ -223,3 +227,19 @@ INSN: _reload dst class n ; INSN: _copy dst src class ; INSN: _spill-counts counts ; +! Instructions that poison the stack state +UNION: poison-insn + ##jump + ##return + ##callback-return ; + +! Instructions that kill all live vregs +UNION: kill-vreg-insn + poison-insn + ##stack-frame + ##call + ##prologue + ##epilogue + ##alien-invoke + ##alien-indirect + ##alien-callback ; diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor index 2a82139e13..57eb7fb63c 100644 --- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor +++ b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008, 2009 Slava Pestov, Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. USING: sequences accessors layouts kernel math namespaces -combinators fry +combinators fry arrays compiler.tree.propagation.info compiler.cfg.hats compiler.cfg.stacks @@ -54,6 +54,28 @@ IN: compiler.cfg.intrinsics.fixnum : emit-fixnum>bignum ( -- ) ds-pop ^^untag-fixnum ^^integer>bignum ds-push ; -: emit-fixnum-overflow-op ( quot -- next ) - [ 2inputs 1 ##inc-d ] dip call ##branch - begin-basic-block ; inline +: emit-no-overflow-case ( dst -- final-bb ) + [ -2 ##inc-d ds-push ] with-branch ; + +: emit-overflow-case ( word -- final-bb ) + [ ##call ] with-branch ; + +: emit-fixnum-overflow-op ( quot word -- ) + [ [ D 1 ^^peek D 0 ^^peek ] dip call ] dip + [ emit-no-overflow-case ] [ emit-overflow-case ] bi* 2array + emit-conditional ; inline + +: fixnum+overflow ( x y -- z ) [ >bignum ] bi@ + ; + +: fixnum-overflow ( x y -- z ) [ >bignum ] bi@ - ; + +: fixnum*overflow ( x y -- z ) [ >bignum ] bi@ * ; + +: emit-fixnum+ ( -- ) + [ ^^fixnum-add ] \ fixnum+overflow emit-fixnum-overflow-op ; + +: emit-fixnum- ( -- ) + [ ^^fixnum-sub ] \ fixnum-overflow emit-fixnum-overflow-op ; + +: emit-fixnum* ( -- ) + [ ^^untag-fixnum ^^fixnum-mul ] \ fixnum*overflow emit-fixnum-overflow-op ; \ No newline at end of file diff --git a/basis/compiler/cfg/intrinsics/intrinsics.factor b/basis/compiler/cfg/intrinsics/intrinsics.factor index ed94ec36d9..e4a7b8972a 100644 --- a/basis/compiler/cfg/intrinsics/intrinsics.factor +++ b/basis/compiler/cfg/intrinsics/intrinsics.factor @@ -100,9 +100,9 @@ IN: compiler.cfg.intrinsics { \ kernel.private:tag [ drop emit-tag ] } { \ kernel.private:getenv [ emit-getenv ] } { \ math.private:both-fixnums? [ drop emit-both-fixnums? ] } - { \ math.private:fixnum+ [ drop [ ##fixnum-add ] emit-fixnum-overflow-op ] } - { \ math.private:fixnum- [ drop [ ##fixnum-sub ] emit-fixnum-overflow-op ] } - { \ math.private:fixnum* [ drop [ i i ##fixnum-mul ] emit-fixnum-overflow-op ] } + { \ math.private:fixnum+ [ drop emit-fixnum+ ] } + { \ math.private:fixnum- [ drop emit-fixnum- ] } + { \ math.private:fixnum* [ drop emit-fixnum* ] } { \ math.private:fixnum+fast [ drop [ ^^add ] emit-fixnum-op ] } { \ math.private:fixnum-fast [ drop [ ^^sub ] emit-fixnum-op ] } { \ math.private:fixnum-bitand [ drop [ ^^and ] emit-fixnum-op ] } diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index fd95a3e09c..63da100b02 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -2159,12 +2159,7 @@ V{ T{ ##replace { src V int-regs 85 } { loc D 1 } } T{ ##replace { src V int-regs 89 } { loc D 4 } } T{ ##replace { src V int-regs 96 } { loc R 0 } } - T{ ##fixnum-mul - { src1 V int-regs 128 } - { src2 V int-regs 129 } - { temp1 V int-regs 132 } - { temp2 V int-regs 133 } - } + T{ ##replace { src V int-regs 129 } { loc R 0 } } T{ ##branch } } 2 test-bb @@ -2255,206 +2250,6 @@ V{ [ ] [ { 1 2 3 4 5 } test-linear-scan-on-cfg ] unit-test -! Another push-all reduction to demonstrate numbering anamoly -V{ T{ ##prologue } T{ ##branch } } -0 test-bb - -V{ - T{ ##peek { dst V int-regs 1 } { loc D 0 } } - T{ ##slot-imm - { dst V int-regs 5 } - { obj V int-regs 1 } - { slot 3 } - { tag 7 } - } - T{ ##peek { dst V int-regs 7 } { loc D 1 } } - T{ ##slot-imm - { dst V int-regs 12 } - { obj V int-regs 7 } - { slot 1 } - { tag 6 } - } - T{ ##add - { dst V int-regs 25 } - { src1 V int-regs 5 } - { src2 V int-regs 12 } - } - T{ ##compare-branch - { src1 V int-regs 25 } - { src2 V int-regs 5 } - { cc cc> } - } -} -1 test-bb - -V{ - T{ ##slot-imm - { dst V int-regs 41 } - { obj V int-regs 1 } - { slot 2 } - { tag 7 } - } - T{ ##slot-imm - { dst V int-regs 44 } - { obj V int-regs 41 } - { slot 1 } - { tag 6 } - } - T{ ##compare-branch - { src1 V int-regs 25 } - { src2 V int-regs 44 } - { cc cc> } - } -} -2 test-bb - -V{ - T{ ##add-imm - { dst V int-regs 54 } - { src1 V int-regs 25 } - { src2 8 } - } - T{ ##load-immediate { dst V int-regs 55 } { val 24 } } - T{ ##inc-d { n 4 } } - T{ ##inc-r { n 1 } } - T{ ##replace { src V int-regs 25 } { loc D 2 } } - T{ ##replace { src V int-regs 1 } { loc D 3 } } - T{ ##replace { src V int-regs 5 } { loc D 4 } } - T{ ##replace { src V int-regs 1 } { loc D 1 } } - T{ ##replace { src V int-regs 54 } { loc D 0 } } - T{ ##replace { src V int-regs 12 } { loc R 0 } } - T{ ##fixnum-mul - { src1 V int-regs 54 } - { src2 V int-regs 55 } - { temp1 V int-regs 58 } - { temp2 V int-regs 59 } - } - T{ ##branch } -} -3 test-bb - -V{ - T{ ##peek { dst V int-regs 60 } { loc D 1 } } - T{ ##slot-imm - { dst V int-regs 66 } - { obj V int-regs 60 } - { slot 2 } - { tag 7 } - } - T{ ##inc-d { n 1 } } - T{ ##inc-r { n 1 } } - T{ ##replace { src V int-regs 66 } { loc D 0 } } - T{ ##replace { src V int-regs 60 } { loc R 0 } } - T{ ##call { word resize-string } } - T{ ##branch } -} -4 test-bb - -V{ - T{ ##peek { dst V int-regs 67 } { loc R 0 } } - T{ ##peek { dst V int-regs 68 } { loc D 0 } } - T{ ##set-slot-imm - { src V int-regs 68 } - { obj V int-regs 67 } - { slot 2 } - { tag 7 } - } - T{ ##write-barrier - { src V int-regs 67 } - { card# V int-regs 75 } - { table V int-regs 76 } - } - T{ ##inc-d { n -1 } } - T{ ##inc-r { n -1 } } - T{ ##peek { dst V int-regs 94 } { loc D 0 } } - T{ ##peek { dst V int-regs 96 } { loc D 1 } } - T{ ##peek { dst V int-regs 98 } { loc D 2 } } - T{ ##peek { dst V int-regs 100 } { loc D 3 } } - T{ ##peek { dst V int-regs 102 } { loc D 4 } } - T{ ##peek { dst V int-regs 106 } { loc R 0 } } - T{ ##copy { dst V int-regs 95 } { src V int-regs 94 } } - T{ ##copy { dst V int-regs 97 } { src V int-regs 96 } } - T{ ##copy { dst V int-regs 99 } { src V int-regs 98 } } - T{ ##copy { dst V int-regs 101 } { src V int-regs 100 } } - T{ ##copy { dst V int-regs 103 } { src V int-regs 102 } } - T{ ##copy { dst V int-regs 107 } { src V int-regs 106 } } - T{ ##branch } -} -5 test-bb - -V{ - T{ ##inc-d { n 3 } } - T{ ##inc-r { n 1 } } - T{ ##copy { dst V int-regs 95 } { src V int-regs 1 } } - T{ ##copy { dst V int-regs 97 } { src V int-regs 25 } } - T{ ##copy { dst V int-regs 99 } { src V int-regs 1 } } - T{ ##copy { dst V int-regs 101 } { src V int-regs 5 } } - T{ ##copy { dst V int-regs 103 } { src V int-regs 7 } } - T{ ##copy { dst V int-regs 107 } { src V int-regs 12 } } - T{ ##branch } -} -6 test-bb - -V{ - T{ ##load-immediate - { dst V int-regs 78 } - { val 4611686018427387896 } - } - T{ ##and - { dst V int-regs 81 } - { src1 V int-regs 97 } - { src2 V int-regs 78 } - } - T{ ##set-slot-imm - { src V int-regs 81 } - { obj V int-regs 95 } - { slot 3 } - { tag 7 } - } - T{ ##inc-d { n -2 } } - T{ ##copy { dst V int-regs 110 } { src V int-regs 99 } } - T{ ##copy { dst V int-regs 111 } { src V int-regs 101 } } - T{ ##copy { dst V int-regs 112 } { src V int-regs 103 } } - T{ ##copy { dst V int-regs 117 } { src V int-regs 107 } } - T{ ##branch } -} -7 test-bb - -V{ - T{ ##inc-d { n 1 } } - T{ ##inc-r { n 1 } } - T{ ##copy { dst V int-regs 110 } { src V int-regs 1 } } - T{ ##copy { dst V int-regs 111 } { src V int-regs 5 } } - T{ ##copy { dst V int-regs 112 } { src V int-regs 7 } } - T{ ##copy { dst V int-regs 117 } { src V int-regs 12 } } - T{ ##branch } -} -8 test-bb - -V{ - T{ ##inc-d { n 1 } } - T{ ##inc-r { n -1 } } - T{ ##replace { src V int-regs 117 } { loc D 0 } } - T{ ##replace { src V int-regs 110 } { loc D 1 } } - T{ ##replace { src V int-regs 111 } { loc D 2 } } - T{ ##replace { src V int-regs 112 } { loc D 3 } } - T{ ##epilogue } - T{ ##return } -} -9 test-bb - -0 get 1 get 1vector >>successors drop -1 get 2 get 8 get V{ } 2sequence >>successors drop -2 get 3 get 6 get V{ } 2sequence >>successors drop -3 get 4 get 1vector >>successors drop -4 get 5 get 1vector >>successors drop -5 get 7 get 1vector >>successors drop -6 get 7 get 1vector >>successors drop -7 get 9 get 1vector >>successors drop -8 get 9 get 1vector >>successors drop - -[ ] [ { 1 2 3 4 5 } test-linear-scan-on-cfg ] unit-test - ! Fencepost error in assignment pass V{ T{ ##branch } } 0 test-bb 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 bf7e8bc042..d2fa661136 100644 --- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor +++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor @@ -122,10 +122,10 @@ M: ##copy-float compute-live-intervals* dup ranges>> [ first from>> ] [ last to>> ] bi [ >>start ] [ >>end ] bi* drop ; -: check-start/end ( live-interval -- ) - [ [ start>> ] [ uses>> first ] bi assert= ] - [ [ end>> ] [ uses>> last ] bi assert= ] - bi ; +ERROR: bad-live-interval live-interval ; + +: check-start ( live-interval -- ) + dup start>> -1 = [ bad-live-interval ] [ drop ] if ; : finish-live-intervals ( live-intervals -- ) ! Since live intervals are computed in a backward order, we have @@ -135,7 +135,7 @@ M: ##copy-float compute-live-intervals* [ ranges>> reverse-here ] [ uses>> reverse-here ] [ compute-start/end ] - [ check-start/end ] + [ check-start ] } cleave ] each ; diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor index a75ac064d9..9faa1e9e38 100755 --- a/basis/compiler/cfg/linearization/linearization.factor +++ b/basis/compiler/cfg/linearization/linearization.factor @@ -31,8 +31,10 @@ M: insn linearize-insn , drop ; M: ##branch linearize-insn drop dup successors>> first emit-branch ; +: successors ( bb -- first second ) successors>> first2 ; inline + : (binary-conditional) ( basic-block insn -- basic-block successor1 successor2 src1 src2 cc ) - [ dup successors>> first2 ] + [ dup successors ] [ [ src1>> ] [ src2>> ] [ cc>> ] tri ] bi* ; inline : binary-conditional ( basic-block insn -- basic-block successor label2 src1 src2 cc ) @@ -52,6 +54,19 @@ M: ##compare-imm-branch linearize-insn M: ##compare-float-branch linearize-insn [ binary-conditional _compare-float-branch ] with-regs emit-branch ; +: overflow-conditional ( basic-block insn -- basic-block successor label2 dst src1 src2 ) + [ dup successors number>> ] + [ [ dst>> ] [ src1>> ] [ src2>> ] tri ] bi* ; inline + +M: ##fixnum-add linearize-insn + [ overflow-conditional _fixnum-add ] with-regs emit-branch ; + +M: ##fixnum-sub linearize-insn + [ overflow-conditional _fixnum-sub ] with-regs emit-branch ; + +M: ##fixnum-mul linearize-insn + [ overflow-conditional _fixnum-mul ] with-regs emit-branch ; + M: ##dispatch linearize-insn swap [ [ [ src>> ] [ temp>> ] bi _dispatch ] with-regs ] diff --git a/basis/compiler/cfg/optimizer/optimizer.factor b/basis/compiler/cfg/optimizer/optimizer.factor index e16fb734e1..1af0fcbc53 100644 --- a/basis/compiler/cfg/optimizer/optimizer.factor +++ b/basis/compiler/cfg/optimizer/optimizer.factor @@ -6,6 +6,7 @@ compiler.cfg.predecessors compiler.cfg.useless-conditionals compiler.cfg.stack-analysis compiler.cfg.branch-splitting +compiler.cfg.block-joining compiler.cfg.alias-analysis compiler.cfg.value-numbering compiler.cfg.dce @@ -31,6 +32,8 @@ SYMBOL: check-optimizer? delete-useless-conditionals compute-predecessors split-branches + join-blocks + compute-predecessors stack-analysis compute-liveness alias-analysis diff --git a/basis/compiler/cfg/renaming/renaming.factor b/basis/compiler/cfg/renaming/renaming.factor index 228d72483c..efc841e21f 100644 --- a/basis/compiler/cfg/renaming/renaming.factor +++ b/basis/compiler/cfg/renaming/renaming.factor @@ -136,16 +136,6 @@ M: ##compare-imm fresh-insn-temps M: ##compare-float fresh-insn-temps [ fresh-vreg ] change-temp drop ; -M: ##fixnum-mul fresh-insn-temps - [ fresh-vreg ] change-temp1 - [ fresh-vreg ] change-temp2 - drop ; - -M: ##fixnum-mul-tail fresh-insn-temps - [ fresh-vreg ] change-temp1 - [ fresh-vreg ] change-temp2 - drop ; - M: ##gc fresh-insn-temps [ fresh-vreg ] change-temp1 [ fresh-vreg ] change-temp2 diff --git a/basis/compiler/cfg/stack-analysis/merge/merge.factor b/basis/compiler/cfg/stack-analysis/merge/merge.factor index cb0ad7d615..a53fd7494e 100644 --- a/basis/compiler/cfg/stack-analysis/merge/merge.factor +++ b/basis/compiler/cfg/stack-analysis/merge/merge.factor @@ -92,6 +92,7 @@ SYMBOL: added-phis :: multiple-predecessors ( bb states -- state ) states [ not ] any? [ + bb add-to-work-list ] [ [ H{ } clone added-instructions set diff --git a/basis/compiler/cfg/stack-analysis/stack-analysis.factor b/basis/compiler/cfg/stack-analysis/stack-analysis.factor index 48a4b79783..e46460a741 100644 --- a/basis/compiler/cfg/stack-analysis/stack-analysis.factor +++ b/basis/compiler/cfg/stack-analysis/stack-analysis.factor @@ -14,9 +14,7 @@ compiler.cfg.stack-analysis.merge compiler.cfg.utilities ; IN: compiler.cfg.stack-analysis -SYMBOL: work-list - -: add-to-work-list ( bb -- ) work-list get push-front ; +SYMBOL: global-optimization? : redundant-replace? ( vreg loc -- ? ) dup state get untranslate-loc n>> 0 < @@ -63,14 +61,16 @@ UNION: sync-if-back-edge ##conditional-branch ##compare-imm-branch ##dispatch - ##loop-entry ; + ##loop-entry + ##fixnum-overflow ; : sync-state? ( -- ? ) basic-block get successors>> [ [ predecessors>> ] keep '[ _ back-edge? ] any? ] any? ; M: sync-if-back-edge visit - sync-state? [ sync-state ] when , ; + global-optimization? get [ sync-state? [ sync-state ] when ] unless + , ; : eliminate-peek ( dst src -- ) ! the requested stack location is already in 'src' @@ -87,31 +87,8 @@ M: ##replace visit M: ##copy visit [ call-next-method ] [ record-copy ] bi ; -! Instructions that poison the stack state -UNION: poison-insn - ##jump - ##return - ##callback-return - ##fixnum-mul-tail - ##fixnum-add-tail - ##fixnum-sub-tail ; - M: poison-insn visit call-next-method poison-state ; -! Instructions that kill all live vregs -UNION: kill-vreg-insn - poison-insn - ##stack-frame - ##call - ##prologue - ##epilogue - ##fixnum-mul - ##fixnum-add - ##fixnum-sub - ##alien-invoke - ##alien-indirect - ##alien-callback ; - M: kill-vreg-insn visit sync-state , ; ! Maps basic-blocks to states @@ -142,21 +119,13 @@ SYMBOLS: state-in state-out ; ] 2bi ] V{ } make >>instructions drop ; -: visit-successors ( bb -- ) - dup successors>> [ - 2dup back-edge? [ 2drop ] [ nip add-to-work-list ] if - ] with each ; - -: process-work-list ( -- ) - work-list get [ visit-block ] slurp-deque ; - : stack-analysis ( cfg -- cfg' ) [ work-list set H{ } clone copies set H{ } clone state-in set H{ } clone state-out set - dup [ add-to-work-list ] each-basic-block - process-work-list + dup [ visit-block ] each-basic-block + global-optimization? get [ work-list get [ visit-block ] slurp-deque ] when cfg-changed ] with-scope ; diff --git a/basis/compiler/cfg/stack-analysis/state/state.factor b/basis/compiler/cfg/stack-analysis/state/state.factor index f701b84763..25fa249853 100644 --- a/basis/compiler/cfg/stack-analysis/state/state.factor +++ b/basis/compiler/cfg/stack-analysis/state/state.factor @@ -1,6 +1,6 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: kernel accessors namespaces assocs sets math +USING: kernel accessors namespaces assocs sets math deques compiler.cfg.registers ; IN: compiler.cfg.stack-analysis.state @@ -47,3 +47,7 @@ M: rs-loc translate-loc [ n>> ] [ rs-height>> ] bi* - ; GENERIC# untranslate-loc 1 ( loc state -- loc' ) M: ds-loc untranslate-loc [ n>> ] [ ds-height>> ] bi* + ; M: rs-loc untranslate-loc [ n>> ] [ rs-height>> ] bi* + ; + +SYMBOL: work-list + +: add-to-work-list ( bb -- ) work-list get push-front ; diff --git a/basis/compiler/cfg/tco/tco.factor b/basis/compiler/cfg/tco/tco.factor index 5fa2e1b042..3dbdf148e9 100644 --- a/basis/compiler/cfg/tco/tco.factor +++ b/basis/compiler/cfg/tco/tco.factor @@ -2,6 +2,7 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors combinators.short-circuit kernel math namespaces sequences fry combinators +compiler.utilities compiler.cfg compiler.cfg.rpo compiler.cfg.hats @@ -19,8 +20,6 @@ IN: compiler.cfg.tco [ second ##return? ] } 1&& ; -: penultimate ( seq -- elt ) [ length 2 - ] keep nth ; - : tail-call? ( bb -- ? ) { [ instructions>> { [ length 2 >= ] [ last ##branch? ] } 1&& ] @@ -54,28 +53,11 @@ IN: compiler.cfg.tco [ [ cfg get entry>> successors>> first ] dip successors>> push ] tri ; -: fixnum-tail-call? ( bb -- ? ) - instructions>> penultimate - { [ ##fixnum-add? ] [ ##fixnum-sub? ] [ ##fixnum-mul? ] } 1|| ; - -GENERIC: convert-fixnum-tail-call* ( src1 src2 insn -- insn' ) - -M: ##fixnum-add convert-fixnum-tail-call* drop \ ##fixnum-add-tail new-insn ; -M: ##fixnum-sub convert-fixnum-tail-call* drop \ ##fixnum-sub-tail new-insn ; -M: ##fixnum-mul convert-fixnum-tail-call* drop i i \ ##fixnum-mul-tail new-insn ; - -: convert-fixnum-tail-call ( bb -- ) - [ - [ src1>> ] [ src2>> ] [ ] tri - convert-fixnum-tail-call* - ] convert-tail-call ; - : optimize-tail-call ( bb -- ) dup tail-call? [ { { [ dup loop-tail-call? ] [ convert-loop-tail-call ] } { [ dup word-tail-call? ] [ convert-word-tail-call ] } - { [ dup fixnum-tail-call? ] [ convert-fixnum-tail-call ] } [ drop ] } cond ] [ drop ] if ; diff --git a/basis/compiler/cfg/two-operand/two-operand.factor b/basis/compiler/cfg/two-operand/two-operand.factor index d30a02b0d3..98bbfb9cd0 100644 --- a/basis/compiler/cfg/two-operand/two-operand.factor +++ b/basis/compiler/cfg/two-operand/two-operand.factor @@ -44,6 +44,8 @@ M: ##shl-imm convert-two-operand* convert-two-operand/integer ; M: ##shr-imm convert-two-operand* convert-two-operand/integer ; M: ##sar-imm convert-two-operand* convert-two-operand/integer ; +M: ##fixnum-overflow convert-two-operand* convert-two-operand/integer ; + M: ##add-float convert-two-operand* convert-two-operand/float ; M: ##sub-float convert-two-operand* convert-two-operand/float ; M: ##mul-float convert-two-operand* convert-two-operand/float ; diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor index 288fa403dd..9cb8bf26f9 100644 --- a/basis/compiler/cfg/utilities/utilities.factor +++ b/basis/compiler/cfg/utilities/utilities.factor @@ -36,6 +36,18 @@ IN: compiler.cfg.utilities : emit-primitive ( node -- ) word>> ##call ##branch begin-basic-block ; +: with-branch ( quot -- final-bb ) + [ + begin-basic-block + call + basic-block get dup [ ##branch ] when + ] with-scope ; inline + +: emit-conditional ( branches -- ) + end-basic-block + begin-basic-block + basic-block get '[ [ _ swap successors>> push ] when* ] each ; + : back-edge? ( from to -- ? ) [ number>> ] bi@ >= ; diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index df6e91aec9..42c6bf45cb 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -171,18 +171,12 @@ M: ##sar-imm generate-insn dst/src1/src2 %sar-imm ; M: ##not generate-insn dst/src %not ; M: ##log2 generate-insn dst/src %log2 ; -: src1/src2 ( insn -- src1 src2 ) - [ src1>> register ] [ src2>> register ] bi ; inline +: label/dst/src1/src2 ( insn -- label dst src1 src2 ) + [ label>> lookup-label ] [ dst/src1/src2 ] bi ; inline -: src1/src2/temp1/temp2 ( insn -- src1 src2 temp1 temp2 ) - [ src1/src2 ] [ temp1>> register ] [ temp2>> register ] tri ; inline - -M: ##fixnum-add generate-insn src1/src2 %fixnum-add ; -M: ##fixnum-add-tail generate-insn src1/src2 %fixnum-add-tail ; -M: ##fixnum-sub generate-insn src1/src2 %fixnum-sub ; -M: ##fixnum-sub-tail generate-insn src1/src2 %fixnum-sub-tail ; -M: ##fixnum-mul generate-insn src1/src2/temp1/temp2 %fixnum-mul ; -M: ##fixnum-mul-tail generate-insn src1/src2/temp1/temp2 %fixnum-mul-tail ; +M: _fixnum-add generate-insn label/dst/src1/src2 %fixnum-add ; +M: _fixnum-sub generate-insn label/dst/src1/src2 %fixnum-sub ; +M: _fixnum-mul generate-insn label/dst/src1/src2 %fixnum-mul ; : dst/src/temp ( insn -- dst src temp ) [ dst/src ] [ temp>> register ] bi ; inline diff --git a/basis/compiler/tree/debugger/debugger.factor b/basis/compiler/tree/debugger/debugger.factor index 4fc4f4814b..d6906d6348 100644 --- a/basis/compiler/tree/debugger/debugger.factor +++ b/basis/compiler/tree/debugger/debugger.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2006, 2008 Slava Pestov. +! Copyright (C) 2006, 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel assocs match fry accessors namespaces make effects sequences sequences.private quotations generic macros arrays @@ -15,7 +15,9 @@ compiler.tree.def-use compiler.tree.builder compiler.tree.optimizer compiler.tree.combinators -compiler.tree.checker ; +compiler.tree.checker +compiler.tree.dead-code +compiler.tree.modular-arithmetic ; FROM: fry => _ ; RENAME: _ match => __ IN: compiler.tree.debugger @@ -201,8 +203,15 @@ SYMBOL: node-count : cleaned-up-tree ( quot -- nodes ) [ - check-optimizer? on - build-tree optimize-tree + build-tree + analyze-recursive + normalize + propagate + cleanup + compute-def-use + remove-dead-code + compute-def-use + optimize-modular-arithmetic ] with-scope ; : inlined? ( quot seq/word -- ? ) diff --git a/basis/compiler/tree/finalization/finalization.factor b/basis/compiler/tree/finalization/finalization.factor index 0e72deb6fa..4c17399c95 100644 --- a/basis/compiler/tree/finalization/finalization.factor +++ b/basis/compiler/tree/finalization/finalization.factor @@ -46,6 +46,9 @@ M: predicate finalize-word [ drop ] } cond ; +M: math-partial finalize-word + dup primitive? [ drop ] [ nip cached-expansion ] if ; + M: word finalize-word drop ; M: #call finalize* diff --git a/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor index 7fb1b3d5ac..13555d45f7 100644 --- a/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor +++ b/basis/compiler/tree/modular-arithmetic/modular-arithmetic-tests.factor @@ -4,12 +4,12 @@ IN: compiler.tree.modular-arithmetic.tests USING: kernel kernel.private tools.test math math.partial-dispatch math.private accessors slots.private sequences strings sbufs compiler.tree.builder -compiler.tree.optimizer +compiler.tree.normalization compiler.tree.debugger alien.accessors layouts combinators byte-arrays ; : test-modular-arithmetic ( quot -- quot' ) - build-tree optimize-tree nodes>quot ; + cleaned-up-tree nodes>quot ; [ [ >R >fixnum R> >fixnum fixnum+fast ] ] [ [ { integer integer } declare + >fixnum ] test-modular-arithmetic ] unit-test diff --git a/basis/compiler/utilities/utilities.factor b/basis/compiler/utilities/utilities.factor index ac276b6e41..c21be39adb 100644 --- a/basis/compiler/utilities/utilities.factor +++ b/basis/compiler/utilities/utilities.factor @@ -27,4 +27,6 @@ SYMBOL: yield-hook yield-hook [ [ ] ] initialize : alist-max ( alist -- pair ) - [ ] [ [ [ second ] bi@ > ] most ] map-reduce ; \ No newline at end of file + [ ] [ [ [ second ] bi@ > ] most ] map-reduce ; + +: penultimate ( seq -- elt ) [ length 2 - ] keep nth ; diff --git a/basis/cpu/architecture/architecture.factor b/basis/cpu/architecture/architecture.factor index 556424f50c..41dd53fa8a 100644 --- a/basis/cpu/architecture/architecture.factor +++ b/basis/cpu/architecture/architecture.factor @@ -82,12 +82,9 @@ HOOK: %sar-imm cpu ( dst src1 src2 -- ) HOOK: %not cpu ( dst src -- ) HOOK: %log2 cpu ( dst src -- ) -HOOK: %fixnum-add cpu ( src1 src2 -- ) -HOOK: %fixnum-add-tail cpu ( src1 src2 -- ) -HOOK: %fixnum-sub cpu ( src1 src2 -- ) -HOOK: %fixnum-sub-tail cpu ( src1 src2 -- ) -HOOK: %fixnum-mul cpu ( src1 src2 temp1 temp2 -- ) -HOOK: %fixnum-mul-tail cpu ( src1 src2 temp1 temp2 -- ) +HOOK: %fixnum-add cpu ( label dst src1 src2 -- ) +HOOK: %fixnum-sub cpu ( label dst src1 src2 -- ) +HOOK: %fixnum-mul cpu ( label dst src1 src2 -- ) HOOK: %integer>bignum cpu ( dst src temp -- ) HOOK: %bignum>integer cpu ( dst src temp -- ) diff --git a/basis/cpu/x86/32/32.factor b/basis/cpu/x86/32/32.factor index 96a99f4d5e..727131aa25 100755 --- a/basis/cpu/x86/32/32.factor +++ b/basis/cpu/x86/32/32.factor @@ -51,8 +51,6 @@ M: x86.32 reserved-area-size 0 ; M: x86.32 %alien-invoke 0 CALL rc-relative rel-dlsym ; -M: x86.32 %alien-invoke-tail 0 JMP rc-relative rel-dlsym ; - M: x86.32 return-struct-in-registers? ( c-type -- ? ) c-type [ return-in-registers?>> ] diff --git a/basis/cpu/x86/64/64.factor b/basis/cpu/x86/64/64.factor index 5390d7e0c8..8eb04eb2b5 100644 --- a/basis/cpu/x86/64/64.factor +++ b/basis/cpu/x86/64/64.factor @@ -167,11 +167,6 @@ M: x86.64 %alien-invoke rc-absolute-cell rel-dlsym R11 CALL ; -M: x86.64 %alien-invoke-tail - R11 0 MOV - rc-absolute-cell rel-dlsym - R11 JMP ; - M: x86.64 %prepare-alien-indirect ( -- ) "unbox_alien" f %alien-invoke RBP RAX MOV ; diff --git a/basis/cpu/x86/x86.factor b/basis/cpu/x86/x86.factor index bb2ee620e3..bd39549973 100644 --- a/basis/cpu/x86/x86.factor +++ b/basis/cpu/x86/x86.factor @@ -129,83 +129,18 @@ M: x86 %log2 BSR ; : ?MOV ( dst src -- ) 2dup = [ 2drop ] [ MOV ] if ; inline -:: move>args ( src1 src2 -- ) - { - { [ src1 param-reg-2 = ] [ param-reg-1 src2 ?MOV param-reg-1 param-reg-2 XCHG ] } - { [ src1 param-reg-1 = ] [ param-reg-2 src2 ?MOV ] } - { [ src2 param-reg-1 = ] [ param-reg-2 src1 ?MOV param-reg-1 param-reg-2 XCHG ] } - { [ src2 param-reg-2 = ] [ param-reg-1 src1 ?MOV ] } - [ - param-reg-1 src1 MOV - param-reg-2 src2 MOV - ] - } cond ; - -HOOK: %alien-invoke-tail cpu ( func dll -- ) - -:: overflow-template ( src1 src2 insn inverse func -- ) -