From 95ff5ffe512d86e43c3a9918fd3aad43af6388e3 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Tue, 27 Apr 2010 10:51:00 -0400 Subject: [PATCH] New GC checks work in progress --- .../build-stack-frame.factor | 9 +- basis/compiler/cfg/cfg.factor | 5 +- basis/compiler/cfg/checker/checker.factor | 10 +- .../cfg/comparisons/comparisons.factor | 6 +- basis/compiler/cfg/def-use/def-use.factor | 8 +- .../cfg/gc-checks/gc-checks-tests.factor | 159 +++++++++++++++++- basis/compiler/cfg/gc-checks/gc-checks.factor | 91 ++++++++-- .../cfg/instructions/instructions.factor | 81 ++++----- .../cfg/intrinsics/fixnum/fixnum.factor | 3 +- .../linear-scan/allocation/allocation.factor | 21 +-- .../linear-scan/assignment/assignment.factor | 34 +--- .../cfg/linear-scan/linear-scan-tests.factor | 46 ----- .../live-intervals/live-intervals.factor | 4 +- .../linear-scan/resolve/resolve-tests.factor | 6 + .../cfg/linear-scan/resolve/resolve.factor | 4 +- .../cfg/linearization/linearization.factor | 85 +++------- .../cfg/linearization/order/order.factor | 9 +- basis/compiler/cfg/liveness/ssa/ssa.factor | 6 +- basis/compiler/cfg/mr/mr.factor | 5 +- basis/compiler/cfg/optimizer/optimizer.factor | 6 +- .../cfg/save-contexts/save-contexts.factor | 1 + .../cfg/ssa/destruction/destruction.factor | 29 ++-- .../interference/interference-tests.factor | 2 +- .../cfg/stack-frame/stack-frame.factor | 16 +- .../cfg/stacks/finalize/finalize.factor | 4 +- basis/compiler/cfg/utilities/utilities.factor | 32 ++-- basis/compiler/codegen/codegen.factor | 88 ++++------ basis/cpu/architecture/architecture.factor | 12 +- basis/cpu/x86/32/32.factor | 9 +- basis/cpu/x86/64/64.factor | 11 +- basis/cpu/x86/assembler/assembler.factor | 2 +- basis/cpu/x86/bootstrap.factor | 2 +- basis/cpu/x86/x86.factor | 49 +++--- vm/gc.cpp | 30 +++- vm/gc.hpp | 2 +- vm/vm.hpp | 2 +- 36 files changed, 478 insertions(+), 411 deletions(-) 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 670e34e5f9..cb5e9aaf3d 100644 --- a/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor +++ b/basis/compiler/cfg/build-stack-frame/build-stack-frame.factor @@ -25,12 +25,10 @@ M: stack-frame-insn compute-stack-frame* M: ##call compute-stack-frame* drop frame-required? on ; -M: ##gc compute-stack-frame* +M: ##call-gc compute-stack-frame* + drop frame-required? on - stack-frame new - swap tagged-values>> length cells >>gc-root-size - t >>calls-vm? - request-stack-frame ; + stack-frame new t >>calls-vm? request-stack-frame ; M: _spill-area-size compute-stack-frame* n>> stack-frame get (>>spill-area-size) ; @@ -40,6 +38,7 @@ M: insn compute-stack-frame* frame-required? on ] when ; +! PowerPC backend sets frame-required? for ##integer>float! \ _spill t frame-required? set-word-prop \ ##unary-float-function t frame-required? set-word-prop \ ##binary-float-function t frame-required? set-word-prop diff --git a/basis/compiler/cfg/cfg.factor b/basis/compiler/cfg/cfg.factor index 79f3b0d1fb..9568217e9c 100644 --- a/basis/compiler/cfg/cfg.factor +++ b/basis/compiler/cfg/cfg.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008, 2009 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math vectors arrays accessors namespaces ; IN: compiler.cfg @@ -8,7 +8,8 @@ TUPLE: basic-block < identity-tuple number { instructions vector } { successors vector } -{ predecessors vector } ; +{ predecessors vector } +{ unlikely? boolean } ; : ( -- bb ) basic-block new diff --git a/basis/compiler/cfg/checker/checker.factor b/basis/compiler/cfg/checker/checker.factor index 1a0265b42a..cb840a299d 100644 --- a/basis/compiler/cfg/checker/checker.factor +++ b/basis/compiler/cfg/checker/checker.factor @@ -25,15 +25,7 @@ ERROR: last-insn-not-a-jump bb ; dup instructions>> last { [ ##branch? ] [ ##dispatch? ] - [ ##compare-branch? ] - [ ##compare-imm-branch? ] - [ ##compare-integer-branch? ] - [ ##compare-integer-imm-branch? ] - [ ##compare-float-ordered-branch? ] - [ ##compare-float-unordered-branch? ] - [ ##fixnum-add? ] - [ ##fixnum-sub? ] - [ ##fixnum-mul? ] + [ conditional-branch-insn? ] [ ##no-tco? ] } 1|| [ drop ] [ last-insn-not-a-jump ] if ; diff --git a/basis/compiler/cfg/comparisons/comparisons.factor b/basis/compiler/cfg/comparisons/comparisons.factor index 35f25c2d40..019bfd7a74 100644 --- a/basis/compiler/cfg/comparisons/comparisons.factor +++ b/basis/compiler/cfg/comparisons/comparisons.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: assocs math.order sequences ; IN: compiler.cfg.comparisons @@ -12,6 +12,8 @@ SYMBOLS: SYMBOLS: vcc-all vcc-notall vcc-any vcc-none ; +SYMBOLS: cc-o cc/o ; + : negate-cc ( cc -- cc' ) H{ { cc< cc/< } @@ -28,6 +30,8 @@ SYMBOLS: { cc/= cc= } { cc/<> cc<> } { cc/<>= cc<>= } + { cc-o cc/o } + { cc/o cc-o } } at ; : negate-vcc ( cc -- cc' ) diff --git a/basis/compiler/cfg/def-use/def-use.factor b/basis/compiler/cfg/def-use/def-use.factor index 87758fafcd..a576a54884 100644 --- a/basis/compiler/cfg/def-use/def-use.factor +++ b/basis/compiler/cfg/def-use/def-use.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg. +! Copyright (C) 2008, 2010 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs arrays classes combinators compiler.units fry generalizations generic kernel locals @@ -19,6 +19,10 @@ M: insn uses-vregs drop { } ; M: ##phi uses-vregs inputs>> values ; +M: _conditional-branch defs-vreg insn>> defs-vreg ; + +M: _conditional-branch uses-vregs insn>> uses-vregs ; + [ insn-classes get [ [ define-defs-vreg-method ] each ] - [ { ##phi } diff [ define-uses-vregs-method ] each ] + [ { ##phi _conditional-branch } diff [ define-uses-vregs-method ] each ] [ [ define-temp-vregs-method ] each ] tri ] with-compilation-unit diff --git a/basis/compiler/cfg/gc-checks/gc-checks-tests.factor b/basis/compiler/cfg/gc-checks/gc-checks-tests.factor index 27d37b115f..7a148bc201 100644 --- a/basis/compiler/cfg/gc-checks/gc-checks-tests.factor +++ b/basis/compiler/cfg/gc-checks/gc-checks-tests.factor @@ -1,14 +1,14 @@ -USING: compiler.cfg.gc-checks compiler.cfg.debugger +USING: arrays compiler.cfg.gc-checks +compiler.cfg.gc-checks.private compiler.cfg.debugger compiler.cfg.registers compiler.cfg.instructions compiler.cfg -compiler.cfg.predecessors cpu.architecture tools.test kernel vectors -namespaces accessors sequences ; +compiler.cfg.predecessors compiler.cfg.rpo cpu.architecture +tools.test kernel vectors namespaces accessors sequences alien +memory classes make combinators.short-circuit byte-arrays ; IN: compiler.cfg.gc-checks.tests : test-gc-checks ( -- ) H{ } clone representations set - cfg new 0 get >>entry - insert-gc-checks - drop ; + cfg new 0 get >>entry cfg set ; V{ T{ ##inc-d f 3 } @@ -23,4 +23,149 @@ V{ [ ] [ test-gc-checks ] unit-test -[ V{ D 0 D 2 } ] [ 1 get instructions>> first uninitialized-locs>> ] unit-test +[ t ] [ cfg get blocks-with-gc 1 get 1array sequence= ] unit-test + +[ ] [ 1 get allocation-size 123 size assert= ] unit-test + +2 \ vreg-counter set-global + +[ + V{ + T{ ##load-tagged f 3 0 } + T{ ##replace f 3 D 0 } + T{ ##replace f 3 R 3 } + } +] [ [ { D 0 R 3 } wipe-locs ] V{ } make ] unit-test + +: gc-check? ( bb -- ? ) + instructions>> + { + [ length 1 = ] + [ first ##check-nursery-branch? ] + } 1&& ; + +[ t ] [ 100 gc-check? ] unit-test + +2 \ vreg-counter set-global + +[ + V{ + T{ ##save-context f 3 4 } + T{ ##load-tagged f 5 0 } + T{ ##replace f 5 D 0 } + T{ ##replace f 5 R 3 } + T{ ##call-gc f { 0 1 2 } } + T{ ##branch } + } +] +[ + { D 0 R 3 } { 0 1 2 } instructions>> +] unit-test + +30 \ vreg-counter set-global + +V{ + T{ ##branch } +} 0 test-bb + +V{ + T{ ##branch } +} 1 test-bb + +V{ + T{ ##branch } +} 2 test-bb + +V{ + T{ ##branch } +} 3 test-bb + +V{ + T{ ##branch } +} 4 test-bb + +0 { 1 2 } edges +1 3 edge +2 3 edge +3 4 edge + +[ ] [ test-gc-checks ] unit-test + +[ ] [ cfg get needs-predecessors drop ] unit-test + +[ ] [ 31337 { D 1 R 2 } { 10 20 } 3 get (insert-gc-check) ] unit-test + +[ t ] [ 1 get successors>> first gc-check? ] unit-test + +[ t ] [ 2 get successors>> first gc-check? ] unit-test + +[ t ] [ 3 get predecessors>> first gc-check? ] unit-test + +30 \ vreg-counter set-global + +V{ + T{ ##prologue } + T{ ##branch } +} 0 test-bb + +V{ + T{ ##peek f 2 D 0 } + T{ ##inc-d f 3 } + T{ ##branch } +} 1 test-bb + +V{ + T{ ##allot f 1 64 byte-array } + T{ ##branch } +} 2 test-bb + +V{ + T{ ##branch } +} 3 test-bb + +V{ + T{ ##replace f 2 D 1 } + T{ ##branch } +} 4 test-bb + +V{ + T{ ##epilogue } + T{ ##return } +} 5 test-bb + +0 1 edge +1 { 2 3 } edges +2 4 edge +3 4 edge +4 5 edge + +[ ] [ test-gc-checks ] unit-test + +H{ + { 2 tagged-rep } +} representations set + +[ ] [ cfg get insert-gc-checks drop ] unit-test + +[ 2 ] [ 2 get predecessors>> length ] unit-test + +[ t ] [ 1 get successors>> first gc-check? ] unit-test + +[ 64 ] [ 1 get successors>> first instructions>> first size>> ] unit-test + +[ t ] [ 2 get predecessors>> first gc-check? ] unit-test + +[ + V{ + T{ ##save-context f 33 34 } + T{ ##load-tagged f 35 0 } + T{ ##replace f 35 D 0 } + T{ ##replace f 35 D 1 } + T{ ##replace f 35 D 2 } + T{ ##call-gc f { 2 } } + T{ ##branch } + } +] [ 2 get predecessors>> second instructions>> ] unit-test + +! Don't forget to invalidate RPO after inserting basic blocks! +[ 8 ] [ cfg get reverse-post-order length ] unit-test diff --git a/basis/compiler/cfg/gc-checks/gc-checks.factor b/basis/compiler/cfg/gc-checks/gc-checks.factor index d151c725e2..737e956933 100644 --- a/basis/compiler/cfg/gc-checks/gc-checks.factor +++ b/basis/compiler/cfg/gc-checks/gc-checks.factor @@ -1,15 +1,25 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors kernel sequences assocs fry math -cpu.architecture layouts namespaces +USING: accessors assocs combinators fry kernel layouts locals +math make namespaces sequences cpu.architecture +compiler.cfg compiler.cfg.rpo +compiler.cfg.hats compiler.cfg.registers +compiler.cfg.utilities +compiler.cfg.comparisons compiler.cfg.instructions +compiler.cfg.predecessors +compiler.cfg.liveness +compiler.cfg.liveness.ssa compiler.cfg.stacks.uninitialized ; IN: compiler.cfg.gc-checks -! Garbage collection check insertion. This pass runs after representation -! selection, so it must keep track of representations. +> [ ##allocation? ] any? ; @@ -17,6 +27,48 @@ IN: compiler.cfg.gc-checks : blocks-with-gc ( cfg -- bbs ) post-order [ insert-gc-check? ] filter ; +! A GC check for bb consists of two new basic blocks, gc-check +! and gc-call: +! +! gc-check +! / \ +! | gc-call +! \ / +! bb + +: ( size -- bb ) + [ ] dip + [ + cc<= int-rep next-vreg-rep int-rep next-vreg-rep + ##check-nursery-branch + ] V{ } make >>instructions ; + +: wipe-locs ( uninitialized-locs -- ) + '[ + int-rep next-vreg-rep + [ 0 ##load-tagged ] + [ '[ [ _ ] dip ##replace ] each ] bi + ] unless-empty ; + +: ( uninitialized-locs gc-roots -- bb ) + [ ] 2dip + [ [ wipe-locs ] [ ##call-gc ] bi* ##branch ] V{ } make + >>instructions t >>unlikely? ; + +:: insert-guard ( check body bb -- ) + bb predecessors>> check (>>predecessors) + V{ bb body } check (>>successors) + + V{ check } body (>>predecessors) + V{ bb } body (>>successors) + + V{ check body } bb (>>predecessors) + + check predecessors>> [ bb check update-successors ] each ; + +: (insert-gc-check) ( size uninitialized-locs gc-roots bb -- ) + [ [ ] 2dip ] dip insert-guard ; + GENERIC: allocation-size* ( insn -- n ) M: ##allot allocation-size* size>> ; @@ -30,20 +82,27 @@ M: ##box-displaced-alien allocation-size* drop 5 cells ; [ ##allocation? ] filter [ allocation-size* data-alignment get align ] map-sum ; +: live-tagged ( bb -- vregs ) + live-in keys [ rep-of tagged-rep? ] filter ; + : insert-gc-check ( bb -- ) - dup dup '[ - tagged-rep next-vreg-rep - tagged-rep next-vreg-rep - _ allocation-size - f - f - _ uninitialized-locs - \ ##gc new-insn - prefix - ] change-instructions drop ; + { + [ allocation-size ] + [ uninitialized-locs ] + [ live-tagged ] + [ ] + } cleave + (insert-gc-check) ; + +PRIVATE> : insert-gc-checks ( cfg -- cfg' ) dup blocks-with-gc [ - over compute-uninitialized-sets + [ + needs-predecessors + dup compute-ssa-live-sets + dup compute-uninitialized-sets + ] dip [ insert-gc-check ] each + cfg-changed ] unless-empty ; diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 8ee21154fa..db1496f147 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -682,23 +682,30 @@ temp: temp/int-rep ; ! Overflowing arithmetic INSN: ##fixnum-add def: dst/tagged-rep -use: src1/tagged-rep src2/tagged-rep ; +use: src1/tagged-rep src2/tagged-rep +literal: cc ; INSN: ##fixnum-sub def: dst/tagged-rep -use: src1/tagged-rep src2/tagged-rep ; +use: src1/tagged-rep src2/tagged-rep +literal: cc ; INSN: ##fixnum-mul def: dst/tagged-rep -use: src1/tagged-rep src2/int-rep ; - -INSN: ##gc -temp: temp1/int-rep temp2/int-rep -literal: size data-values tagged-values uninitialized-locs ; +use: src1/tagged-rep src2/int-rep +literal: cc ; INSN: ##save-context temp: temp1/int-rep temp2/int-rep ; +! GC checks +INSN: ##check-nursery-branch +literal: size cc +temp: temp1/int-rep temp2/int-rep ; + +INSN: ##call-gc +literal: gc-roots ; + ! Instructions used by machine IR only. INSN: _prologue literal: stack-frame ; @@ -714,48 +721,11 @@ literal: label ; INSN: _loop-entry ; -INSN: _dispatch -use: src -temp: temp ; - INSN: _dispatch-label literal: label ; -INSN: _compare-branch -literal: label -use: src1 src2 -literal: cc ; - -INSN: _compare-imm-branch -literal: label -use: src1 -literal: src2 cc ; - -INSN: _compare-float-unordered-branch -literal: label -use: src1 src2 -literal: cc ; - -INSN: _compare-float-ordered-branch -literal: label -use: src1 src2 -literal: cc ; - -! Overflowing arithmetic -INSN: _fixnum-add -literal: label -def: dst -use: src1 src2 ; - -INSN: _fixnum-sub -literal: label -def: dst -use: src1 src2 ; - -INSN: _fixnum-mul -literal: label -def: dst -use: src1 src2 ; +INSN: _conditional-branch +literal: label insn ; TUPLE: spill-slot { n integer } ; C: spill-slot @@ -771,18 +741,31 @@ literal: rep src ; INSN: _spill-area-size literal: n ; -! For GC check insertion UNION: ##allocation ##allot ##box-alien ##box-displaced-alien ; +UNION: conditional-branch-insn +##compare-branch +##compare-imm-branch +##compare-integer-branch +##compare-integer-imm-branch +##compare-float-ordered-branch +##compare-float-unordered-branch +##test-vector-branch +##check-nursery-branch +##fixnum-add +##fixnum-sub +##fixnum-mul ; + ! For alias analysis UNION: ##read ##slot ##slot-imm ##vm-field ##alien-global ; UNION: ##write ##set-slot ##set-slot-imm ##set-vm-field ; -! Instructions that kill all live vregs but cannot trigger GC -UNION: partial-sync-insn +! Instructions that clobber registers +UNION: clobber-insn +##call-gc ##unary-float-function ##binary-float-function ; diff --git a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor index dcecb1fac4..b9cfac3b92 100644 --- a/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor +++ b/basis/compiler/cfg/intrinsics/fixnum/fixnum.factor @@ -4,6 +4,7 @@ USING: sequences accessors layouts kernel math math.intervals namespaces combinators fry arrays cpu.architecture compiler.tree.propagation.info +compiler.cfg compiler.cfg.hats compiler.cfg.stacks compiler.cfg.instructions @@ -55,7 +56,7 @@ IN: compiler.cfg.intrinsics.fixnum : emit-fixnum-overflow-op ( quot word -- ) ! Inputs to the final instruction need to be copied because ! of loc>vreg sync - [ [ (2inputs) [ any-rep ^^copy ] bi@ ] dip call ] dip + [ [ (2inputs) [ any-rep ^^copy ] bi@ cc/o ] dip call ] dip [ emit-no-overflow-case ] [ emit-overflow-case ] bi* 2array emit-conditional ; inline diff --git a/basis/compiler/cfg/linear-scan/allocation/allocation.factor b/basis/compiler/cfg/linear-scan/allocation/allocation.factor index ae6c375016..764e37786f 100644 --- a/basis/compiler/cfg/linear-scan/allocation/allocation.factor +++ b/basis/compiler/cfg/linear-scan/allocation/allocation.factor @@ -63,18 +63,19 @@ M: sync-point handle ( sync-point -- ) : smallest-heap ( heap1 heap2 -- heap ) ! If heap1 and heap2 have the same key, favors heap1. - [ [ heap-peek nip ] bi@ <= ] most ; + { + { [ dup heap-empty? ] [ drop ] } + { [ over heap-empty? ] [ nip ] } + [ [ [ heap-peek nip ] bi@ <= ] most ] + } cond ; : (allocate-registers) ( -- ) - { - { [ unhandled-intervals get heap-empty? ] [ unhandled-sync-points get ] } - { [ unhandled-sync-points get heap-empty? ] [ unhandled-intervals get ] } - ! If a live interval begins at the same location as a sync point, - ! process the sync point before the live interval. This ensures that the - ! return value of C function calls doesn't get spilled and reloaded - ! unnecessarily. - [ unhandled-sync-points get unhandled-intervals get smallest-heap ] - } cond dup heap-empty? [ drop ] [ heap-pop drop handle (allocate-registers) ] if ; + ! If a live interval begins at the same location as a sync point, + ! process the sync point before the live interval. This ensures that the + ! return value of C function calls doesn't get spilled and reloaded + ! unnecessarily. + unhandled-sync-points get unhandled-intervals get smallest-heap + dup heap-empty? [ drop ] [ heap-pop drop handle (allocate-registers) ] if ; : finish-allocation ( -- ) active-intervals inactive-intervals diff --git a/basis/compiler/cfg/linear-scan/assignment/assignment.factor b/basis/compiler/cfg/linear-scan/assignment/assignment.factor index 535f4515eb..6cceea3303 100644 --- a/basis/compiler/cfg/linear-scan/assignment/assignment.factor +++ b/basis/compiler/cfg/linear-scan/assignment/assignment.factor @@ -126,39 +126,9 @@ RENAMING: assign [ vreg>reg ] [ vreg>reg ] [ vreg>reg ] M: vreg-insn assign-registers-in-insn [ assign-insn-defs ] [ assign-insn-uses ] [ assign-insn-temps ] tri ; -: trace-on-gc ( assoc -- assoc' ) - ! When a GC occurs, virtual registers which contain tagged data - ! are traced by the GC. Outputs a sequence physical registers. - [ drop rep-of tagged-rep eq? ] { } assoc-filter-as values ; - -: spill-on-gc? ( vreg reg -- ? ) - [ rep-of tagged-rep? not ] [ spill-slot? not ] bi* and ; - -: spill-on-gc ( assoc -- assoc' ) - ! When a GC occurs, virtual registers which contain untagged data, - ! and are stored in physical registers, are saved to their spill - ! slots. Outputs sequence of triples: - ! - physical register - ! - spill slot - ! - representation - [ - [ - 2dup spill-on-gc? - [ swap [ rep-of ] [ vreg-spill-slot ] bi 3array , ] [ 2drop ] if - ] assoc-each - ] { } make ; - -: gc-root-offsets ( registers -- alist ) - ! Outputs a sequence of { offset register/spill-slot } pairs - [ length iota [ cell * ] map ] keep zip ; - -M: ##gc assign-registers-in-insn - ! Since ##gc is always the first instruction in a block, the set of - ! values live at the ##gc is just live-in. +M: ##call-gc assign-registers-in-insn dup call-next-method - basic-block get register-live-ins get at - [ trace-on-gc gc-root-offsets >>tagged-values ] [ spill-on-gc >>data-values ] bi - drop ; + [ [ vreg>reg ] map ] change-gc-roots drop ; M: insn assign-registers-in-insn drop ; diff --git a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor index 570c7f9aa7..3bf7dd827c 100644 --- a/basis/compiler/cfg/linear-scan/linear-scan-tests.factor +++ b/basis/compiler/cfg/linear-scan/linear-scan-tests.factor @@ -1444,49 +1444,3 @@ test-diamond [ 0 ] [ 3 get instructions>> [ _spill? ] count ] unit-test [ 0 ] [ 4 get instructions>> [ _reload? ] count ] unit-test - -V{ - T{ ##peek f 0 D 0 } - T{ ##peek f 1 D 1 } - T{ ##replace f 1 D 1 } - T{ ##branch } -} 0 test-bb - -V{ - T{ ##gc f 2 3 } - T{ ##branch } -} 1 test-bb - -V{ - T{ ##replace f 0 D 0 } - T{ ##return } -} 2 test-bb - -0 1 edge -1 2 edge - -[ ] [ { 1 2 3 } test-linear-scan-on-cfg ] unit-test - -[ { { 0 1 } } ] [ 1 get instructions>> first tagged-values>> ] unit-test - -V{ - T{ ##peek f 0 D 0 } - T{ ##peek f 1 D 1 } - T{ ##compare-imm-branch f 1 5 cc= } -} 0 test-bb - -V{ - T{ ##gc f 2 3 } - T{ ##replace f 0 D 0 } - T{ ##return } -} 1 test-bb - -V{ - T{ ##return } -} 2 test-bb - -0 { 1 2 } edges - -[ ] [ { 1 2 3 } test-linear-scan-on-cfg ] unit-test - -[ { { 0 1 } } ] [ 1 get instructions>> first tagged-values>> ] unit-test 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 221832e41a..da079da0e4 100644 --- a/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor +++ b/basis/compiler/cfg/linear-scan/live-intervals/live-intervals.factor @@ -102,7 +102,7 @@ M: vreg-insn compute-live-intervals* [ dup temp-vregs [ handle-temp ] with each ] tri ; -M: partial-sync-insn compute-live-intervals* +M: clobber-insn compute-live-intervals* [ dup defs-vreg [ +use+ handle-output ] with when* ] [ dup uses-vregs [ +memory+ handle-input ] with each ] [ dup temp-vregs [ handle-temp ] with each ] @@ -122,7 +122,7 @@ SYMBOL: sync-points GENERIC: compute-sync-points* ( insn -- ) -M: partial-sync-insn compute-sync-points* +M: clobber-insn compute-sync-points* insn#>> sync-points get push ; M: insn compute-sync-points* drop ; diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor b/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor index 893a60b267..f16c608293 100644 --- a/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor +++ b/basis/compiler/cfg/linear-scan/resolve/resolve-tests.factor @@ -57,6 +57,7 @@ IN: compiler.cfg.linear-scan.resolve.tests [ { T{ ##copy { src 1 } { dst 2 } { rep int-rep } } + T{ ##branch } } ] [ { { T{ location f 1 int-rep int-regs } T{ location f 2 int-rep int-regs } } } @@ -67,6 +68,7 @@ IN: compiler.cfg.linear-scan.resolve.tests { T{ _spill { src 0 } { rep int-rep } { dst T{ spill-slot f 0 } } } T{ _reload { dst 0 } { rep tagged-rep } { src T{ spill-slot f 1 } } } + T{ ##branch } } ] [ { @@ -80,6 +82,7 @@ IN: compiler.cfg.linear-scan.resolve.tests { T{ _spill { src 0 } { rep int-rep } { dst T{ spill-slot f 1 } } } T{ _reload { dst 0 } { rep tagged-rep } { src T{ spill-slot f 0 } } } + T{ ##branch } } ] [ { @@ -93,6 +96,7 @@ IN: compiler.cfg.linear-scan.resolve.tests { T{ _spill { src 0 } { rep int-rep } { dst T{ spill-slot f 1 } } } T{ _reload { dst 0 } { rep tagged-rep } { src T{ spill-slot f 0 } } } + T{ ##branch } } ] [ { @@ -115,11 +119,13 @@ H{ } clone spill-temps set T{ _spill { src 0 } { rep int-rep } { dst T{ spill-slot f 8 } } } T{ ##copy { dst 0 } { src 1 } { rep int-rep } } T{ _reload { dst 1 } { rep int-rep } { src T{ spill-slot f 8 } } } + T{ ##branch } } { T{ _spill { src 1 } { rep int-rep } { dst T{ spill-slot f 8 } } } T{ ##copy { dst 1 } { src 0 } { rep int-rep } } T{ _reload { dst 0 } { rep int-rep } { src T{ spill-slot f 8 } } } + T{ ##branch } } } member? ] unit-test diff --git a/basis/compiler/cfg/linear-scan/resolve/resolve.factor b/basis/compiler/cfg/linear-scan/resolve/resolve.factor index f64c0fc890..b450145bd4 100644 --- a/basis/compiler/cfg/linear-scan/resolve/resolve.factor +++ b/basis/compiler/cfg/linear-scan/resolve/resolve.factor @@ -78,11 +78,11 @@ SYMBOL: temp : mapping-instructions ( alist -- insns ) [ swap ] H{ } assoc-map-as - [ temp [ swap >insn ] parallel-mapping ] { } make ; + [ temp [ swap >insn ] parallel-mapping ##branch ] { } make ; : perform-mappings ( bb to mappings -- ) dup empty? [ 3drop ] [ - mapping-instructions insert-simple-basic-block + mapping-instructions insert-basic-block cfg get cfg-changed drop ] if ; diff --git a/basis/compiler/cfg/linearization/linearization.factor b/basis/compiler/cfg/linearization/linearization.factor index b53eebfc20..9c3a0068bc 100644 --- a/basis/compiler/cfg/linearization/linearization.factor +++ b/basis/compiler/cfg/linearization/linearization.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008, 2009 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel math accessors sequences namespaces make combinators assocs arrays locals layouts hashtables @@ -19,14 +19,8 @@ SYMBOL: numbers : number-blocks ( bbs -- ) [ 2array ] map-index >hashtable numbers set ; -! Convert CFG IR to machine IR. GENERIC: linearize-insn ( basic-block insn -- ) -: linearize-basic-block ( bb -- ) - [ block-number _label ] - [ dup instructions>> [ linearize-insn ] with each ] - bi ; - M: insn linearize-insn , drop ; : useless-branch? ( basic-block successor -- ? ) @@ -40,68 +34,29 @@ M: insn linearize-insn , drop ; M: ##branch linearize-insn drop dup successors>> first emit-branch ; -: successors ( bb -- first second ) successors>> first2 ; inline +GENERIC: negate-insn-cc ( insn -- ) -:: conditional ( bb insn n conditional-quot negate-cc-quot -- bb successor label etc... ) - bb insn - conditional-quot - [ drop dup successors>> second useless-branch? ] 2bi - [ [ swap block-number ] n ndip ] - [ [ block-number ] n ndip negate-cc-quot call ] if ; inline +M: conditional-branch-insn negate-insn-cc + [ negate-cc ] change-cc drop ; -: (binary-conditional) ( bb insn -- bb successor1 successor2 src1 src2 cc ) - [ dup successors ] - [ [ src1>> ] [ src2>> ] [ cc>> ] tri ] bi* ; inline +M: ##test-vector-branch negate-insn-cc + [ negate-vcc ] change-vcc drop ; -: binary-conditional ( bb insn -- bb successor label2 src1 src2 cc ) - 3 [ (binary-conditional) ] [ negate-cc ] conditional ; - -: (test-vector-conditional) ( bb insn -- bb successor1 successor2 src1 temp rep vcc ) - [ dup successors ] - [ { [ src1>> ] [ temp>> ] [ rep>> ] [ vcc>> ] } cleave ] bi* ; inline - -: test-vector-conditional ( bb insn -- bb successor label src1 temp rep vcc ) - 4 [ (test-vector-conditional) ] [ negate-vcc ] conditional ; - -M: ##compare-branch linearize-insn - binary-conditional _compare-branch emit-branch ; - -M: ##compare-imm-branch linearize-insn - binary-conditional _compare-imm-branch emit-branch ; - -M: ##compare-integer-branch linearize-insn - binary-conditional _compare-branch emit-branch ; - -M: ##compare-integer-imm-branch linearize-insn - binary-conditional _compare-imm-branch emit-branch ; - -M: ##compare-float-ordered-branch linearize-insn - binary-conditional _compare-float-ordered-branch emit-branch ; - -M: ##compare-float-unordered-branch linearize-insn - binary-conditional _compare-float-unordered-branch emit-branch ; - -M: ##test-vector-branch linearize-insn - test-vector-conditional _test-vector-branch emit-branch ; - -: overflow-conditional ( bb insn -- bb successor label2 dst src1 src2 ) - [ dup successors block-number ] - [ [ dst>> ] [ src1>> ] [ src2>> ] tri ] bi* ; inline - -M: ##fixnum-add linearize-insn - overflow-conditional _fixnum-add emit-branch ; - -M: ##fixnum-sub linearize-insn - overflow-conditional _fixnum-sub emit-branch ; - -M: ##fixnum-mul linearize-insn - overflow-conditional _fixnum-mul emit-branch ; +M:: conditional-branch-insn linearize-insn ( bb insn -- ) + bb successors>> first2 :> ( first second ) + bb second useless-branch? + [ bb second first ] + [ bb first second insn negate-insn-cc ] if + block-number insn _conditional-branch + emit-branch ; M: ##dispatch linearize-insn - swap - [ [ src>> ] [ temp>> ] bi _dispatch ] - [ successors>> [ block-number _dispatch-label ] each ] - bi* ; + , successors>> [ block-number _dispatch-label ] each ; + +: linearize-basic-block ( bb -- ) + [ block-number _label ] + [ dup instructions>> [ linearize-insn ] with each ] + bi ; : linearize-basic-blocks ( cfg -- insns ) [ @@ -113,7 +68,7 @@ M: ##dispatch linearize-insn ] { } make ; PRIVATE> - + : flatten-cfg ( cfg -- mr ) [ linearize-basic-blocks ] [ word>> ] [ label>> ] tri ; diff --git a/basis/compiler/cfg/linearization/order/order.factor b/basis/compiler/cfg/linearization/order/order.factor index 166a0f0d50..a68a90a8e8 100644 --- a/basis/compiler/cfg/linearization/order/order.factor +++ b/basis/compiler/cfg/linearization/order/order.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors assocs deques dlists kernel make sorting namespaces sequences combinators combinators.short-circuit @@ -8,7 +8,8 @@ sets hash-sets ; FROM: namespaces => set ; IN: compiler.cfg.linearization.order -! This is RPO except loops are rotated. Based on SBCL's src/compiler/control.lisp +! This is RPO except loops are rotated and unlikely blocks go +! at the end. Based on SBCL's src/compiler/control.lisp > not ] partition append + ; PRIVATE> diff --git a/basis/compiler/cfg/liveness/ssa/ssa.factor b/basis/compiler/cfg/liveness/ssa/ssa.factor index 5215c9c487..3e54333265 100644 --- a/basis/compiler/cfg/liveness/ssa/ssa.factor +++ b/basis/compiler/cfg/liveness/ssa/ssa.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel namespaces deques accessors sets sequences assocs fry hashtables dlists compiler.cfg.def-use compiler.cfg.instructions @@ -48,14 +48,14 @@ SYMBOL: work-list [ predecessors>> add-to-work-list ] [ drop ] if ] [ drop ] if ; -: compute-ssa-live-sets ( cfg -- cfg' ) +: compute-ssa-live-sets ( cfg -- ) needs-predecessors work-list set H{ } clone live-ins set H{ } clone phi-live-ins set H{ } clone live-outs set - dup post-order add-to-work-list + post-order add-to-work-list work-list get [ liveness-step ] slurp-deque ; : live-in? ( vreg bb -- ? ) live-in key? ; diff --git a/basis/compiler/cfg/mr/mr.factor b/basis/compiler/cfg/mr/mr.factor index a46e6c15cb..140fba8d4e 100644 --- a/basis/compiler/cfg/mr/mr.factor +++ b/basis/compiler/cfg/mr/mr.factor @@ -1,14 +1,11 @@ ! Copyright (C) 2009 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel namespaces accessors compiler.cfg -compiler.cfg.linearization compiler.cfg.gc-checks -compiler.cfg.save-contexts compiler.cfg.linear-scan +compiler.cfg.linearization compiler.cfg.linear-scan compiler.cfg.build-stack-frame ; IN: compiler.cfg.mr : build-mr ( cfg -- mr ) - insert-gc-checks - insert-save-contexts linear-scan flatten-cfg build-stack-frame ; \ No newline at end of file diff --git a/basis/compiler/cfg/optimizer/optimizer.factor b/basis/compiler/cfg/optimizer/optimizer.factor index 84726a9b99..e6cd65f4b5 100644 --- a/basis/compiler/cfg/optimizer/optimizer.factor +++ b/basis/compiler/cfg/optimizer/optimizer.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008, 2009 Slava Pestov. +! Copyright (C) 2008, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences accessors combinators namespaces compiler.cfg.tco @@ -12,6 +12,8 @@ compiler.cfg.copy-prop compiler.cfg.dce compiler.cfg.write-barrier compiler.cfg.representations +compiler.cfg.gc-checks +compiler.cfg.save-contexts compiler.cfg.ssa.destruction compiler.cfg.empty-blocks compiler.cfg.checker ; @@ -36,6 +38,8 @@ SYMBOL: check-optimizer? eliminate-dead-code eliminate-write-barriers select-representations + insert-gc-checks + insert-save-contexts destruct-ssa delete-empty-blocks ?check ; diff --git a/basis/compiler/cfg/save-contexts/save-contexts.factor b/basis/compiler/cfg/save-contexts/save-contexts.factor index e2ccf943ad..e5edd7cdff 100644 --- a/basis/compiler/cfg/save-contexts/save-contexts.factor +++ b/basis/compiler/cfg/save-contexts/save-contexts.factor @@ -10,6 +10,7 @@ IN: compiler.cfg.save-contexts : needs-save-context? ( insns -- ? ) [ { + [ ##call-gc? ] [ ##unary-float-function? ] [ ##binary-float-function? ] [ ##alien-invoke? ] diff --git a/basis/compiler/cfg/ssa/destruction/destruction.factor b/basis/compiler/cfg/ssa/destruction/destruction.factor index a55e5baa2c..83413067b7 100644 --- a/basis/compiler/cfg/ssa/destruction/destruction.factor +++ b/basis/compiler/cfg/ssa/destruction/destruction.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays assocs fry kernel namespaces sequences sequences.deep @@ -93,25 +93,32 @@ M: ##phi prepare-insn [ 2drop ] [ eliminate-copy ] if ] assoc-each ; -: useless-copy? ( ##copy -- ? ) - dup ##copy? [ [ dst>> ] [ src>> ] bi eq? ] [ drop f ] if ; +GENERIC: rename-insn ( insn -- keep? ) + +M: vreg-insn rename-insn + [ rename-insn-defs ] [ rename-insn-uses ] bi t ; + +M: ##copy rename-insn + [ call-next-method drop ] + [ [ dst>> ] [ src>> ] bi eq? not ] bi ; + +M: ##phi rename-insn drop f ; + +M: ##call-gc rename-insn + [ renamings get '[ _ at ] map members ] change-gc-roots drop t ; + +M: insn rename-insn drop t ; : perform-renaming ( cfg -- ) leader-map get keys [ dup leader ] H{ } map>assoc renamings set - [ - instructions>> [ - [ rename-insn-defs ] - [ rename-insn-uses ] - [ [ useless-copy? ] [ ##phi? ] bi or not ] tri - ] filter! drop - ] each-basic-block ; + [ instructions>> [ rename-insn ] filter! drop ] each-basic-block ; : destruct-ssa ( cfg -- cfg' ) needs-dominance dup construct-cssa dup compute-defs - compute-ssa-live-sets + dup compute-ssa-live-sets dup compute-live-ranges dup prepare-coalescing process-copies diff --git a/basis/compiler/cfg/ssa/interference/interference-tests.factor b/basis/compiler/cfg/ssa/interference/interference-tests.factor index 2f13331024..c48ae4ad58 100644 --- a/basis/compiler/cfg/ssa/interference/interference-tests.factor +++ b/basis/compiler/cfg/ssa/interference/interference-tests.factor @@ -9,7 +9,7 @@ IN: compiler.cfg.ssa.interference.tests : test-interference ( -- ) cfg new 0 get >>entry - compute-ssa-live-sets + dup compute-ssa-live-sets dup compute-defs compute-live-ranges ; diff --git a/basis/compiler/cfg/stack-frame/stack-frame.factor b/basis/compiler/cfg/stack-frame/stack-frame.factor index 3cfade23e1..5861ca67bd 100644 --- a/basis/compiler/cfg/stack-frame/stack-frame.factor +++ b/basis/compiler/cfg/stack-frame/stack-frame.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2009 Slava Pestov. +! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: math math.order namespaces accessors kernel layouts combinators combinators.smart assocs sequences cpu.architecture ; @@ -8,7 +8,6 @@ TUPLE: stack-frame { params integer } { return integer } { total-size integer } -{ gc-root-size integer } { spill-area-size integer } { calls-vm? boolean } ; @@ -19,19 +18,9 @@ TUPLE: stack-frame : spill-offset ( n -- offset ) param-base + ; -: gc-root-base ( -- n ) - stack-frame get spill-area-size>> param-base + ; - -: gc-root-offset ( n -- n' ) gc-root-base + ; - : (stack-frame-size) ( stack-frame -- n ) [ - { - [ params>> ] - [ return>> ] - [ gc-root-size>> ] - [ spill-area-size>> ] - } cleave + [ params>> ] [ return>> ] [ spill-area-size>> ] tri ] sum-outputs ; : max-stack-frame ( frame1 frame2 -- frame3 ) @@ -39,6 +28,5 @@ TUPLE: stack-frame { [ [ params>> ] bi@ max >>params ] [ [ return>> ] bi@ max >>return ] - [ [ gc-root-size>> ] bi@ max >>gc-root-size ] [ [ calls-vm?>> ] bi@ or >>calls-vm? ] } 2cleave ; \ No newline at end of file diff --git a/basis/compiler/cfg/stacks/finalize/finalize.factor b/basis/compiler/cfg/stacks/finalize/finalize.factor index ad3453704b..41512f206f 100644 --- a/basis/compiler/cfg/stacks/finalize/finalize.factor +++ b/basis/compiler/cfg/stacks/finalize/finalize.factor @@ -44,8 +44,8 @@ ERROR: bad-peek dst loc ; ! If both blocks are subroutine calls, don't bother ! computing anything. 2dup [ kill-block? ] both? [ 2drop ] [ - 2dup [ [ insert-replaces ] [ insert-peeks ] 2bi ] V{ } make - [ 2drop ] [ insert-simple-basic-block ] if-empty + 2dup [ [ insert-replaces ] [ insert-peeks ] 2bi ##branch ] V{ } make + [ 2drop ] [ insert-basic-block ] if-empty ] if ; : visit-block ( bb -- ) diff --git a/basis/compiler/cfg/utilities/utilities.factor b/basis/compiler/cfg/utilities/utilities.factor index de2d238f1e..ae860c52ce 100644 --- a/basis/compiler/cfg/utilities/utilities.factor +++ b/basis/compiler/cfg/utilities/utilities.factor @@ -37,11 +37,24 @@ SYMBOL: visited : skip-empty-blocks ( bb -- bb' ) H{ } clone visited [ (skip-empty-blocks) ] with-variable ; -:: insert-basic-block ( froms to bb -- ) - bb froms V{ } like >>predecessors drop - bb to 1vector >>successors drop - to predecessors>> [ dup froms member-eq? [ drop bb ] when ] map! drop - froms [ successors>> [ dup to eq? [ drop bb ] when ] map! drop ] each ; +:: update-predecessors ( from to bb -- ) + ! Update 'to' predecessors for insertion of 'bb' between + ! 'from' and 'to'. + to predecessors>> [ dup from eq? [ drop bb ] when ] map! drop ; + +:: update-successors ( from to bb -- ) + ! Update 'from' successors for insertion of 'bb' between + ! 'from' and 'to'. + from successors>> [ dup to eq? [ drop bb ] when ] map! drop ; + +:: insert-basic-block ( from to insns -- ) + ! Insert basic block on the edge between 'from' and 'to'. + :> bb + insns V{ } like bb (>>instructions) + V{ from } bb (>>predecessors) + V{ to } bb (>>successors) + from to bb update-predecessors + from to bb update-successors ; : add-instructions ( bb quot -- ) [ instructions>> building ] dip '[ @@ -50,15 +63,6 @@ SYMBOL: visited , ] with-variable ; inline -: ( insns -- bb ) - - swap >vector - \ ##branch new-insn over push - >>instructions ; - -: insert-simple-basic-block ( from to insns -- ) - [ 1vector ] 2dip insert-basic-block ; - : has-phis? ( bb -- ? ) instructions>> first ##phi? ; diff --git a/basis/compiler/codegen/codegen.factor b/basis/compiler/codegen/codegen.factor index bae2fdcf6c..3a101092b2 100755 --- a/basis/compiler/codegen/codegen.factor +++ b/basis/compiler/codegen/codegen.factor @@ -30,6 +30,9 @@ GENERIC: generate-insn ( insn -- ) ! Mapping _label IDs to label instances SYMBOL: labels +: lookup-label ( id -- label ) + labels get [ drop