From 82d20d292cf6f0bb337df96adaad66f7aef7ef24 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Tue, 11 Aug 2009 21:21:21 -0500 Subject: [PATCH 1/3] Making write barrier elimination global --- basis/compiler/cfg/write-barrier/authors.txt | 2 + .../write-barrier/write-barrier-tests.factor | 72 ++++++++++++++++++- .../cfg/write-barrier/write-barrier.factor | 33 ++++++++- basis/ui/tools/error-list/error-list.factor | 4 +- 4 files changed, 105 insertions(+), 6 deletions(-) create mode 100644 basis/compiler/cfg/write-barrier/authors.txt diff --git a/basis/compiler/cfg/write-barrier/authors.txt b/basis/compiler/cfg/write-barrier/authors.txt new file mode 100644 index 0000000000..a44f8d7f8d --- /dev/null +++ b/basis/compiler/cfg/write-barrier/authors.txt @@ -0,0 +1,2 @@ +Slava Pestov +Daniel Ehrenberg diff --git a/basis/compiler/cfg/write-barrier/write-barrier-tests.factor b/basis/compiler/cfg/write-barrier/write-barrier-tests.factor index c09f404d4c..dd010f0dbc 100644 --- a/basis/compiler/cfg/write-barrier/write-barrier-tests.factor +++ b/basis/compiler/cfg/write-barrier/write-barrier-tests.factor @@ -1,7 +1,9 @@ +! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg. +! See http://factorcode.org/license.txt for BSD license. USING: compiler.cfg.write-barrier compiler.cfg.instructions compiler.cfg.registers compiler.cfg.debugger cpu.architecture arrays tools.test vectors compiler.cfg kernel accessors -compiler.cfg.utilities ; +compiler.cfg.utilities namespaces sequences ; IN: compiler.cfg.write-barrier.tests : test-write-barrier ( insns -- insns ) @@ -70,3 +72,71 @@ IN: compiler.cfg.write-barrier.tests T{ ##write-barrier f 19 30 3 } } test-write-barrier ] unit-test + +V{ + T{ ##set-slot-imm f 2 1 3 4 } + T{ ##write-barrier f 1 2 3 } +} 1 test-bb +V{ + T{ ##set-slot-imm f 2 1 3 4 } + T{ ##write-barrier f 1 2 3 } +} 2 test-bb +1 get 2 get 1vector >>successors drop +cfg new 1 get >>entry 0 set + +[ ] [ 0 [ eliminate-write-barriers ] change ] unit-test +[ V{ + T{ ##set-slot-imm f 2 1 3 4 } + T{ ##write-barrier f 1 2 3 } +} ] [ 1 get instructions>> ] unit-test +[ V{ + T{ ##set-slot-imm f 2 1 3 4 } +} ] [ 2 get instructions>> ] unit-test + +V{ + T{ ##set-slot-imm f 2 1 3 4 } + T{ ##write-barrier f 1 2 3 } +} 1 test-bb +V{ + T{ ##allot } + T{ ##set-slot-imm f 2 1 3 4 } + T{ ##write-barrier f 1 2 3 } +} 2 test-bb +1 get 2 get 1vector >>successors drop +cfg new 1 get >>entry 0 set + +[ ] [ 0 [ eliminate-write-barriers ] change ] unit-test +[ V{ + T{ ##set-slot-imm f 2 1 3 4 } + T{ ##write-barrier f 1 2 3 } +} ] [ 1 get instructions>> ] unit-test +[ V{ + T{ ##allot } + T{ ##set-slot-imm f 2 1 3 4 } + T{ ##write-barrier f 1 2 3 } +} ] [ 2 get instructions>> ] unit-test + +V{ + T{ ##set-slot-imm f 2 1 3 4 } + T{ ##write-barrier f 1 2 3 } +} 1 test-bb +V{ + T{ ##allot } +} 2 test-bb +1 get 2 get 1vector >>successors drop +V{ + T{ ##set-slot-imm f 2 1 3 4 } + T{ ##write-barrier f 1 2 3 } +} 3 test-bb +2 get 3 get 1vector >>successors drop +cfg new 1 get >>entry 0 set +[ ] [ 0 [ eliminate-write-barriers ] change ] unit-test +[ V{ + T{ ##set-slot-imm f 2 1 3 4 } + T{ ##write-barrier f 1 2 3 } +} ] [ 1 get instructions>> ] unit-test +[ V{ T{ ##allot } } ] [ 2 get instructions>> ] unit-test +[ V{ + T{ ##set-slot-imm f 2 1 3 4 } + T{ ##write-barrier f 1 2 3 } +} ] [ 3 get instructions>> ] unit-test diff --git a/basis/compiler/cfg/write-barrier/write-barrier.factor b/basis/compiler/cfg/write-barrier/write-barrier.factor index 2f32a4ca81..bb08c4f173 100644 --- a/basis/compiler/cfg/write-barrier/write-barrier.factor +++ b/basis/compiler/cfg/write-barrier/write-barrier.factor @@ -1,7 +1,8 @@ -! Copyright (C) 2008, 2009 Slava Pestov. +! Copyright (C) 2008, 2009 Slava Pestov, Daniel Ehrenberg. ! See http://factorcode.org/license.txt for BSD license. USING: kernel accessors namespaces assocs sets sequences -compiler.cfg compiler.cfg.instructions compiler.cfg.rpo ; +compiler.cfg compiler.cfg.instructions compiler.cfg.rpo +compiler.cfg.dataflow-analysis fry combinators.short-circuit ; IN: compiler.cfg.write-barrier ! Eliminate redundant write barrier hits. @@ -30,10 +31,36 @@ M: ##set-slot-imm eliminate-write-barrier M: insn eliminate-write-barrier drop t ; +FORWARD-ANALYSIS: safe + +: has-allocation? ( bb -- ? ) + instructions>> [ { [ ##allocation? ] [ ##call? ] } 1|| ] any? ; + +: (safe-in) ( maybe-safe-in bb -- safe-in ) + has-allocation? not swap and [ H{ } clone ] unless* ; + +M: safe-analysis transfer-set + drop [ (safe-in) ] keep + instructions>> over '[ + dup ##write-barrier? [ + src>> _ conjoin + ] [ drop ] if + ] each ; + +M: safe-analysis join-sets + ! maybe this would be better if we had access to the basic block + ! then in this definition, it would check for has-allocation? + ! (once rather than twice) + drop assoc-refine ; + +: safe-start ( bb -- set ) + [ safe-in ] keep (safe-in) ; + : write-barriers-step ( bb -- ) - H{ } clone safe set + dup safe-start safe set H{ } clone mutated set instructions>> [ eliminate-write-barrier ] filter-here ; : eliminate-write-barriers ( cfg -- cfg' ) + dup compute-safe-sets dup [ write-barriers-step ] each-basic-block ; diff --git a/basis/ui/tools/error-list/error-list.factor b/basis/ui/tools/error-list/error-list.factor index 1193ca237c..a1da59fe39 100644 --- a/basis/ui/tools/error-list/error-list.factor +++ b/basis/ui/tools/error-list/error-list.factor @@ -165,8 +165,8 @@ error-display "toolbar" f { { 5 5 } >>gap error-list f track-add error-list source-file-table>> "Source files" 1/4 track-add - error-list error-table>> "Errors" 1/2 track-add - error-list error-display>> "Details" 1/4 track-add + error-list error-table>> "Errors" 1/4 track-add + error-list error-display>> "Details" 1/2 track-add { 5 5 } 1 track-add ; M: error-list-gadget focusable-child* From f80416b40e190bea5c93b71d480c05bafbf5bfa8 Mon Sep 17 00:00:00 2001 From: Daniel Ehrenberg Date: Wed, 12 Aug 2009 23:52:29 -0500 Subject: [PATCH 2/3] Fixing write-barrier elimination; adding bb as a parameter to join-sets in dataflow analysis --- .../dataflow-analysis/dataflow-analysis.factor | 6 +++--- basis/compiler/cfg/liveness/liveness.factor | 2 +- basis/compiler/cfg/stacks/global/global.factor | 4 ++-- .../stacks/uninitialized/uninitialized.factor | 4 ++-- .../cfg/write-barrier/write-barrier.factor | 17 ++++------------- 5 files changed, 12 insertions(+), 21 deletions(-) diff --git a/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor b/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor index 62043fb413..275a4585b0 100644 --- a/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor +++ b/basis/compiler/cfg/dataflow-analysis/dataflow-analysis.factor @@ -5,7 +5,7 @@ namespaces functors compiler.cfg.rpo compiler.cfg.utilities compiler.cfg.predecessors compiler.cfg ; IN: compiler.cfg.dataflow-analysis -GENERIC: join-sets ( sets dfa -- set ) +GENERIC: join-sets ( sets bb dfa -- set ) GENERIC: transfer-set ( in-set bb dfa -- out-set ) GENERIC: block-order ( cfg dfa -- bbs ) GENERIC: successors ( bb dfa -- seq ) @@ -23,7 +23,7 @@ GENERIC# compute-in-set 2 ( bb out-sets dfa -- set ) M: kill-block compute-in-set 3drop f ; M:: basic-block compute-in-set ( bb out-sets dfa -- set ) - bb dfa predecessors [ out-sets at ] map dfa join-sets ; + bb dfa predecessors [ out-sets at ] map bb dfa join-sets ; :: update-in-set ( bb in-sets out-sets dfa -- ? ) bb out-sets dfa compute-in-set @@ -56,7 +56,7 @@ M:: basic-block compute-out-set ( bb in-sets dfa -- set ) in-sets out-sets ; inline -M: dataflow-analysis join-sets drop assoc-refine ; +M: dataflow-analysis join-sets 2drop assoc-refine ; FUNCTOR: define-analysis ( name -- ) diff --git a/basis/compiler/cfg/liveness/liveness.factor b/basis/compiler/cfg/liveness/liveness.factor index 6c67769a45..a10b48cc0c 100644 --- a/basis/compiler/cfg/liveness/liveness.factor +++ b/basis/compiler/cfg/liveness/liveness.factor @@ -28,4 +28,4 @@ M: live-analysis transfer-set drop instructions>> transfer-liveness ; M: live-analysis join-sets - drop assoc-combine ; \ No newline at end of file + 2drop assoc-combine ; diff --git a/basis/compiler/cfg/stacks/global/global.factor b/basis/compiler/cfg/stacks/global/global.factor index c0ca385d90..30a999064a 100644 --- a/basis/compiler/cfg/stacks/global/global.factor +++ b/basis/compiler/cfg/stacks/global/global.factor @@ -21,7 +21,7 @@ BACKWARD-ANALYSIS: live M: live-analysis transfer-set drop transfer-peeked-locs ; -M: live-analysis join-sets drop assoc-combine ; +M: live-analysis join-sets 2drop assoc-combine ; ! A stack location is available at a location if all paths from ! the entry block to the location load the location into a @@ -56,4 +56,4 @@ M: dead-analysis transfer-set [ compute-dead-sets ] [ compute-avail-sets ] [ ] - } cleave ; \ No newline at end of file + } cleave ; diff --git a/basis/compiler/cfg/stacks/uninitialized/uninitialized.factor b/basis/compiler/cfg/stacks/uninitialized/uninitialized.factor index 97211eb8e8..ce0e98de5f 100644 --- a/basis/compiler/cfg/stacks/uninitialized/uninitialized.factor +++ b/basis/compiler/cfg/stacks/uninitialized/uninitialized.factor @@ -65,7 +65,7 @@ M: uninitialized-analysis transfer-set ( pair bb analysis -- pair' ) drop [ prepare ] dip visit-block finish ; M: uninitialized-analysis join-sets ( sets analysis -- pair ) - drop sift [ f ] [ [ ] [ [ (join-sets) ] 2map ] map-reduce ] if-empty ; + 2drop sift [ f ] [ [ ] [ [ (join-sets) ] 2map ] map-reduce ] if-empty ; : uninitialized-locs ( bb -- locs ) uninitialized-in dup [ @@ -73,4 +73,4 @@ M: uninitialized-analysis join-sets ( sets analysis -- pair ) [ [ ] (uninitialized-locs) ] [ [ ] (uninitialized-locs) ] bi* append - ] when ; \ No newline at end of file + ] when ; diff --git a/basis/compiler/cfg/write-barrier/write-barrier.factor b/basis/compiler/cfg/write-barrier/write-barrier.factor index bb08c4f173..2375075df5 100644 --- a/basis/compiler/cfg/write-barrier/write-barrier.factor +++ b/basis/compiler/cfg/write-barrier/write-barrier.factor @@ -36,11 +36,8 @@ FORWARD-ANALYSIS: safe : has-allocation? ( bb -- ? ) instructions>> [ { [ ##allocation? ] [ ##call? ] } 1|| ] any? ; -: (safe-in) ( maybe-safe-in bb -- safe-in ) - has-allocation? not swap and [ H{ } clone ] unless* ; - M: safe-analysis transfer-set - drop [ (safe-in) ] keep + drop [ H{ } assoc-clone-like ] dip instructions>> over '[ dup ##write-barrier? [ src>> _ conjoin @@ -48,19 +45,13 @@ M: safe-analysis transfer-set ] each ; M: safe-analysis join-sets - ! maybe this would be better if we had access to the basic block - ! then in this definition, it would check for has-allocation? - ! (once rather than twice) - drop assoc-refine ; - -: safe-start ( bb -- set ) - [ safe-in ] keep (safe-in) ; + drop has-allocation? [ drop H{ } clone ] [ assoc-refine ] if ; : write-barriers-step ( bb -- ) - dup safe-start safe set + dup safe-in H{ } assoc-clone-like safe set H{ } clone mutated set instructions>> [ eliminate-write-barrier ] filter-here ; : eliminate-write-barriers ( cfg -- cfg' ) - dup compute-safe-sets + dup compute-safe-sets dup [ write-barriers-step ] each-basic-block ; From 2f18c2a52b1747c992077fedecc46652a854cad0 Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Thu, 13 Aug 2009 00:48:50 -0500 Subject: [PATCH 3/3] remove duplicate defintion of unless-zero from calendar --- basis/calendar/calendar.factor | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/basis/calendar/calendar.factor b/basis/calendar/calendar.factor index e9028b7841..536eb71687 100644 --- a/basis/calendar/calendar.factor +++ b/basis/calendar/calendar.factor @@ -34,14 +34,14 @@ C: timestamp : ( year month day -- timestamp ) 0 0 0 gmt-offset-duration ; -ERROR: not-a-month n ; +ERROR: not-a-month ; M: not-a-month summary drop "Months are indexed starting at 1" ; @@ -186,9 +186,6 @@ GENERIC: +second ( timestamp x -- timestamp ) { [ day>> 29 = ] [ month>> 2 = ] [ leap-year? not ] } 1&& [ 3 >>month 1 >>day ] when ; -: unless-zero ( n quot -- ) - [ dup zero? [ drop ] ] dip if ; inline - M: integer +year ( timestamp n -- timestamp ) [ [ + ] curry change-year adjust-leap-year ] unless-zero ; @@ -196,7 +193,7 @@ M: real +year ( timestamp n -- timestamp ) [ float>whole-part swapd days-per-year * +day swap +year ] unless-zero ; : months/years ( n -- months years ) - 12 /rem dup zero? [ drop 1- 12 ] when swap ; inline + 12 /rem [ 1 - 12 ] when-zero swap ; inline M: integer +month ( timestamp n -- timestamp ) [ over month>> + months/years [ >>month ] dip +year ] unless-zero ;