From 9b35de2b10315effba3dd5dce45369a1d03edb0f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Bj=C3=B6rn=20Lindqvist?= Date: Mon, 25 Aug 2014 02:25:12 +0200 Subject: [PATCH] tools.gc-decode: vocab for reading words gc maps --- extra/tools/gc-decode/gc-decode-docs.factor | 44 ++++++++++++ extra/tools/gc-decode/gc-decode-tests.factor | 75 ++++++++++++++++++++ extra/tools/gc-decode/gc-decode.factor | 69 ++++++++++++++++++ 3 files changed, 188 insertions(+) create mode 100644 extra/tools/gc-decode/gc-decode-docs.factor create mode 100644 extra/tools/gc-decode/gc-decode-tests.factor create mode 100644 extra/tools/gc-decode/gc-decode.factor diff --git a/extra/tools/gc-decode/gc-decode-docs.factor b/extra/tools/gc-decode/gc-decode-docs.factor new file mode 100644 index 0000000000..9013099e47 --- /dev/null +++ b/extra/tools/gc-decode/gc-decode-docs.factor @@ -0,0 +1,44 @@ +USING: assocs help.markup help.syntax words ; +IN: tools.gc-decode + +ARTICLE: "tools.gc-decode" "GC maps decoder" +"A vocab that disassembles words gc maps. It's useful to have when debugging garbage collection issues." ; + +HELP: gc-info +{ $class-description "A struct that defines the sizes of the garbage collection maps for a word. It has the following slots:" + { $table + { { $slot "scrub-d-count" } "Number of datastack scrub bits per callsite." } + { { $slot "scrub-r-count" } "Number of retainstack scrub bits per callsite." } + { { $slot "gc-root-count" } "Number of gc root bits per callsite." } + { { $slot "derived-root-count" } "Number of derived roots per callsite." } + { { $slot "return-address-count" } "Number of gc callsites." } + } +} ; + +HELP: word>gc-info +{ $values { "word" word } { "gc-info" gc-info } } +{ $description "Gets the gc-info struct for a word." } ; + +HELP: decode-gc-maps +{ $values { "word" word } { "assoc" assoc } } +{ $description "Main word of the vocab. Decodes the gc maps for a word into an assoc with the following format:" + { $list + "Each key is the return addess of a gc callsite (delta relative to the start of the code block)." + { + "Each value is a two-tuple where:" + { $list + "The first element is a three-tuple containing the scrub patterns for the datastack, retainstack and gc roots." + "The second element is a sequence of derived roots for the callsite." + } + } + } +} +{ $examples + { $unchecked-example + "USING: effects prettyprint ;" + "\\ decode-gc-maps ." + "{ { 151 { { ?{ t } ?{ t t t } ?{ f t t t t } } { } } } }" + } +} ; + +ABOUT: "tools.gc-decode" diff --git a/extra/tools/gc-decode/gc-decode-tests.factor b/extra/tools/gc-decode/gc-decode-tests.factor new file mode 100644 index 0000000000..c306cdcad7 --- /dev/null +++ b/extra/tools/gc-decode/gc-decode-tests.factor @@ -0,0 +1,75 @@ +USING: bit-arrays classes.struct tools.gc-decode tools.test ; +QUALIFIED: effects +QUALIFIED: llvm.types +QUALIFIED: unix.process +IN: tools.gc-decode.tests + +! byte-array>bit-array +{ + ?{ + t t t t f t t t + t f f f f f f f + } +} [ + B{ 239 1 } byte-array>bit-array +] unit-test + +{ ?{ t t t t t t t t } } [ B{ 255 } byte-array>bit-array ] unit-test + +! scrub-bits +{ + ?{ t t t t f t t t t } +} [ + \ effects: word>gc-info scrub-bits +] unit-test + +{ + { } +} [ + \ decode-gc-maps word>gc-info scrub-bits +] unit-test + +! decode-gc-maps +{ + { + { 151 { { ?{ t } ?{ t t t } ?{ f t t t t } } { } } } + } +} [ + \ effects: decode-gc-maps +] unit-test + +{ + { + { 82 { { ?{ t f f } ?{ t f } ?{ } } { } } } + { 244 { { ?{ t f f } ?{ f f } ?{ } } { } } } + { 522 { { ?{ t t f } ?{ t f } ?{ } } { } } } + } +} [ + \ unix.process:fork-process decode-gc-maps +] unit-test + +! read-gc-maps +{ { } } [ + \ decode-gc-maps decode-gc-maps +] unit-test + +! base-pointer-groups +{ + + { + { -1 -1 -1 -1 -1 -1 -1 } + { -1 -1 -1 -1 -1 -1 -1 } + { -1 -1 -1 -1 -1 -1 5 } + { -1 -1 -1 -1 -1 -1 5 } + } +} [ + \ llvm.types:resolve-types word>gc-info base-pointer-groups +] unit-test + + +! One of the few words that has derived roots. +{ + S{ gc-info f 0 2 6 7 4 } +} [ + \ llvm.types:resolve-types word>gc-info +] unit-test diff --git a/extra/tools/gc-decode/gc-decode.factor b/extra/tools/gc-decode/gc-decode.factor new file mode 100644 index 0000000000..461dbc71a6 --- /dev/null +++ b/extra/tools/gc-decode/gc-decode.factor @@ -0,0 +1,69 @@ +USING: accessors alien alien.c-types alien.data arrays assocs bit-arrays +bit-arrays.private classes.struct fry grouping kernel math math.statistics +sequences sequences.repeating words ; +IN: tools.gc-decode + +! Utils +: byte-array>bit-array ( byte-array -- bit-array ) + [ integer>bit-array 8 f pad-tail ] { } map-as concat ; + +: split-indices ( seq indices -- parts ) + over length suffix 0 prefix 2 clump [ first2 rot subseq ] with map ; + +: (cut-points) ( counts times -- seq ) + cum-sum but-last ; + +: reshape-sequence ( seq counts times -- seqs ) + [ (cut-points) split-indices ] keep flip ; + +: end-address>direct-array ( obj count type -- seq ) + [ heap-size * [ >c-ptr alien-address ] dip - ] 2keep + c-direct-array-constructor execute( alien len -- seq ) ; + +STRUCT: gc-info + { scrub-d-count uint read-only } + { scrub-r-count uint read-only } + { gc-root-count uint read-only } + { derived-root-count uint read-only } + { return-address-count uint read-only } ; + +: bit-counts ( gc-info -- counts ) + struct-slot-values 3 head ; + +: total-bitmap-bits ( gc-info -- n ) + [ bit-counts sum ] [ return-address-count>> ] bi * ; + +: return-addresses ( gc-info -- seq ) + dup return-address-count>> uint end-address>direct-array ; + +: base-pointers ( gc-info -- seq ) + [ return-addresses ] + [ return-address-count>> ] + [ derived-root-count>> ] tri * + int end-address>direct-array ; + +: base-pointer-groups ( gc-info -- seqs ) + dup base-pointers + [ return-address-count>> { } ] + [ swap derived-root-count>> [ >array ] map ] if-empty ; + +: scrub-bytes ( gc-info -- seq ) + [ base-pointers ] [ total-bitmap-bits bits>bytes ] bi + uchar end-address>direct-array ; + +: scrub-bits ( gc-info -- seq ) + [ scrub-bytes byte-array>bit-array ] keep total-bitmap-bits head ; + +: scrub-bit-groups ( gc-info -- scrub-groups ) + [ scrub-bits ] [ bit-counts ] [ return-address-count>> ] tri + [ 2drop { } ] [ reshape-sequence ] if-zero ; + +: read-gc-maps ( gc-info -- assoc ) + [ return-addresses ] [ scrub-bit-groups ] [ base-pointer-groups ] tri + zip zip ; + +: word>gc-info ( word -- gc-info ) + word-code nip gc-info struct-size - gc-info memory>struct ; + +: decode-gc-maps ( word -- assoc ) + word>gc-info read-gc-maps ;