diff --git a/basis/compiler/cfg/instructions/instructions.factor b/basis/compiler/cfg/instructions/instructions.factor index 62018e436f..f039ae4893 100644 --- a/basis/compiler/cfg/instructions/instructions.factor +++ b/basis/compiler/cfg/instructions/instructions.factor @@ -855,7 +855,7 @@ factor-call-insn ; M: gc-map-insn clone call-next-method [ clone ] change-gc-map ; ! Each one has a gc-map slot -TUPLE: gc-map scrub-d scrub-r gc-roots derived-roots ; +TUPLE: gc-map scrub-d check-d scrub-r check-r gc-roots derived-roots ; : ( -- gc-map ) gc-map new ; diff --git a/basis/compiler/cfg/stacks/vacant/vacant-docs.factor b/basis/compiler/cfg/stacks/vacant/vacant-docs.factor index a5a34eba06..e6e199b83c 100644 --- a/basis/compiler/cfg/stacks/vacant/vacant-docs.factor +++ b/basis/compiler/cfg/stacks/vacant/vacant-docs.factor @@ -15,12 +15,12 @@ ARTICLE: "compiler.cfg.stacks.vacant" "Uninitialized/overinitialized stack locat HELP: initial-state { $description "Initially the stack bottom is at 0 for both the data and retain stacks and no replaces have been registered." } ; -HELP: vacant>bit-pattern +HELP: vacant>bits { $values { "vacant" "sequence of uninitialized stack locations" } - { "bit-pattern" "sequence of 1:s and 0:s" } + { "bits" "sequence of 1:s and 0:s" } } -{ $description "Converts a sequence of uninitialized stack locations to the pattern of 1:s and 0:s that can be put in the " { $slot "scrub-d" } " and " { $slot "scrub-r" } " slots of a " { $link gc-map } "." } +{ $description "Converts a sequence of uninitialized stack locations to the pattern of 1:s and 0:s that can be put in the " { $slot "scrub-d" } " and " { $slot "scrub-r" } " slots of a " { $link gc-map } ". 0:s are uninitialized locations and 1:s are initialized." } { $examples { $example "USING: compiler.cfg.stacks.vacant prettyprint ;" @@ -29,4 +29,11 @@ HELP: vacant>bit-pattern } } ; +HELP: overinitialized>bits +{ $values + { "overinitialized" "sequence of overinitialized stack locations" } + { "bits" "sequence of 1:s and 0:s" } +} +{ $description "Converts a sequence of overinitialized stack locations to the pattern of 1:s and 0:s that can be put in the " { $slot "check-d" } " and " { $slot "check-r" } " slots of a " { $link gc-map } ". 0:s are empty locations and 1:s are initialized. First element is stack location -1,second -2 and so on." } ; + ABOUT: "compiler.cfg.stacks.vacant" diff --git a/basis/compiler/cfg/stacks/vacant/vacant-tests.factor b/basis/compiler/cfg/stacks/vacant/vacant-tests.factor index ba96af5867..80df9b5498 100644 --- a/basis/compiler/cfg/stacks/vacant/vacant-tests.factor +++ b/basis/compiler/cfg/stacks/vacant/vacant-tests.factor @@ -34,21 +34,21 @@ IN: compiler.cfg.stacks.vacant.tests } [ V{ T{ ##inc-r f 1 } } create-cfg output-stack-map ] unit-test ! Uninitialized peeks -! [ -! V{ -! T{ ##inc-d f 1 } -! T{ ##peek { dst 0 } { loc D 0 } } -! } create-cfg -! compute-vacant-sets -! ] [ vacant-peek? ] must-fail-with +[ + V{ + T{ ##inc-d f 1 } + T{ ##peek { dst 0 } { loc D 0 } } + } create-cfg + compute-vacant-sets +] [ vacant-peek? ] must-fail-with -! [ -! V{ -! T{ ##inc-r f 1 } -! T{ ##peek { dst 0 } { loc R 0 } } -! } create-cfg -! compute-vacant-sets -! ] [ vacant-peek? ] must-fail-with +[ + V{ + T{ ##inc-r f 1 } + T{ ##peek { dst 0 } { loc R 0 } } + } create-cfg + compute-vacant-sets +] [ vacant-peek? ] must-fail-with ! Here the peek refers to a parameter of the word. @@ -68,15 +68,17 @@ IN: compiler.cfg.stacks.vacant.tests compute-vacant-sets ] unit-test -! Replace -1, then gc, then peek is not ok. -! [ -! V{ -! T{ ##replace { src 10 } { loc D -1 } } -! T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } } -! T{ ##peek { dst 0 } { loc D -1 } } -! } create-cfg -! compute-vacant-sets -! ] [ vacant-peek? ] must-fail-with +! Replace -1, then gc. Peek is ok here because the -1 should be +! checked. +{ { 1 } } [ + V{ + T{ ##replace { src 10 } { loc D -1 } } + T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } } + T{ ##peek { dst 0 } { loc D -1 } } + } + [ create-cfg compute-vacant-sets ] + [ second gc-map>> check-d>> ] bi +] unit-test ! Should be ok because the value was at 0 when the gc ran. { { -1 { -1 } } } [ @@ -89,14 +91,14 @@ IN: compiler.cfg.stacks.vacant.tests ] unit-test ! Should not be ok because the value wasn't initialized when gc ran. -! [ -! V{ -! T{ ##inc-d f 1 } -! T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } } -! T{ ##peek { dst 0 } { loc D 0 } } -! } create-cfg -! compute-vacant-sets -! ] [ vacant-peek? ] must-fail-with +[ + V{ + T{ ##inc-d f 1 } + T{ ##alien-invoke { gc-map T{ gc-map { scrub-d { } } } } } + T{ ##peek { dst 0 } { loc D 0 } } + } create-cfg + compute-vacant-sets +] [ vacant-peek? ] must-fail-with ! visit-insn should set the gc info. { { 0 0 } { } } [ @@ -105,7 +107,9 @@ IN: compiler.cfg.stacks.vacant.tests [ visit-insn drop ] keep gc-map>> [ scrub-d>> ] [ scrub-r>> ] bi ] unit-test -{ { { 0 { } } { 0 { } } } } [ +{ + { { 0 { } } { 0 { } } } +} [ V{ T{ ##safepoint } T{ ##prologue } T{ ##branch } } create-cfg output-stack-map ] unit-test @@ -141,8 +145,9 @@ IN: compiler.cfg.stacks.vacant.tests } create-cfg output-stack-map first ] unit-test -{ { 0 { -1 } } } -[ +{ + { 0 { -1 } } +} [ V{ T{ ##inc-d f 1 } T{ ##replace { src 10 } { loc D 0 } } @@ -150,6 +155,12 @@ IN: compiler.cfg.stacks.vacant.tests } create-cfg output-stack-map first ] unit-test +{ + { { { } { 1 1 1 } } { { } { 1 } } } +} [ + { { 4 { 3 2 1 -3 0 -2 -1 } } { 0 { -1 } } } state>gc-data +] unit-test + : cfg1 ( -- cfg ) V{ T{ ##inc-d f 1 } @@ -219,4 +230,6 @@ IN: compiler.cfg.stacks.vacant.tests } [ over create-block ] assoc-map dup { { 0 1 } { 1 2 } { 2 3 } { 3 8 } { 8 10 } } make-edges 0 of block>cfg ; -{ { 4 { 3 2 1 0 } } } [ bug1021-cfg output-stack-map first ] unit-test +{ { 4 { 3 2 1 -3 0 -2 -1 } } } [ + bug1021-cfg output-stack-map first +] unit-test diff --git a/basis/compiler/cfg/stacks/vacant/vacant.factor b/basis/compiler/cfg/stacks/vacant/vacant.factor index bc387f4174..1d195e694d 100644 --- a/basis/compiler/cfg/stacks/vacant/vacant.factor +++ b/basis/compiler/cfg/stacks/vacant/vacant.factor @@ -1,8 +1,12 @@ -USING: accessors arrays compiler.cfg.dataflow-analysis +USING: accessors arrays assocs classes.tuple compiler.cfg.dataflow-analysis compiler.cfg.instructions compiler.cfg.registers fry kernel math math.order sequences sets ; IN: compiler.cfg.stacks.vacant +! Utils +: write-slots ( tuple values slots -- ) + [ execute( x y -- z ) ] 2each drop ; + ! Operations on the stack info : register-write ( n stack -- stack' ) first2 rot suffix members 2array ; @@ -13,28 +17,31 @@ IN: compiler.cfg.stacks.vacant : read-ok? ( n stack -- ? ) [ first >= ] [ second in? ] 2bi or ; -! After a gc, negative writes have been erased. -: register-gc ( stack -- stack' ) - first2 [ 0 >= ] filter 2array ; - : stack>vacant ( stack -- seq ) first2 [ 0 max iota ] dip diff ; -: vacant>bit-pattern ( vacant -- bit-pattern ) +: vacant>bits ( vacant -- bits ) [ { } ] [ dup supremum 1 + 1 [ '[ _ 0 -rot set-nth ] each ] keep ] if-empty ; +: stack>overinitialized ( stack -- seq ) + second [ 0 < ] filter ; + +: overinitialized>bits ( overinitialized -- bits ) + [ neg 1 - ] map vacant>bits [ 1 = 0 1 ? ] map ; + +: stack>scrub-and-check ( stack -- pair ) + [ stack>vacant vacant>bits ] + [ stack>overinitialized overinitialized>bits ] bi 2array ; + ! Operations on the analysis state -: state>gc-map ( state -- pair ) - [ stack>vacant vacant>bit-pattern ] map ; +: state>gc-data ( state -- gc-data ) + [ stack>scrub-and-check ] map ; CONSTANT: initial-state { { 0 { } } { 0 { } } } -: insn>gc-map ( insn -- pair ) - gc-map>> [ scrub-d>> ] [ scrub-r>> ] bi 2array ; - : insn>location ( insn -- n ds? ) loc>> [ n>> ] [ ds-loc? ] bi ; @@ -58,17 +65,15 @@ M: ##inc-r visit-insn ( state insn -- state' ) M: ##replace-imm visit-insn visit-replace ; M: ##replace visit-insn visit-replace ; -! Disabled for now until support is added for tracking overinitialized -! stack locations. M: ##peek visit-insn ( state insn -- state' ) - drop ; - ! 2dup peek-loc-ok? [ drop ] [ vacant-peek ] if ; + 2dup peek-loc-ok? [ drop ] [ vacant-peek ] if ; -: set-gc-map ( state insn -- ) - gc-map>> swap state>gc-map first2 [ >>scrub-d ] [ >>scrub-r ] bi* drop ; +: set-gc-map ( state gc-map -- ) + swap state>gc-data concat + { >>scrub-d >>check-d >>scrub-r >>check-r } write-slots ; M: gc-map-insn visit-insn ( state insn -- state' ) - dupd set-gc-map [ register-gc ] map ; + dupd gc-map>> set-gc-map ; M: insn visit-insn ( state insn -- state' ) drop ; diff --git a/basis/compiler/codegen/gc-maps/gc-maps-tests.factor b/basis/compiler/codegen/gc-maps/gc-maps-tests.factor index 94a63ac8b9..9c35766bcb 100644 --- a/basis/compiler/codegen/gc-maps/gc-maps-tests.factor +++ b/basis/compiler/codegen/gc-maps/gc-maps-tests.factor @@ -19,12 +19,16 @@ M: fake-cpu gc-root-offset ; 50 % - T{ gc-map f B{ } B{ } V{ } } gc-map-here + gc-map-here 50 % - T{ gc-map f B{ 0 1 1 1 0 } B{ 1 0 } V{ 1 3 } V{ { 2 4 } } } gc-map-here - + T{ gc-map + { scrub-d { 0 1 1 1 0 } } + { scrub-r { 1 0 } } + { gc-roots V{ 1 3 } } + { derived-roots V{ { 2 4 } } } + } gc-map-here emit-gc-maps ] B{ } make "result" set