From 89eaca34bf46c4875065f695ad5f73c9e4f3ecf4 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Bj=C3=B6rn=20Lindqvist?= Date: Sat, 12 Dec 2015 12:03:08 +0100 Subject: [PATCH] tools.image-analyzer: now relocation pointers are decoded too -> nicer graphs --- .../image-analyzer/graphviz/graphviz.factor | 84 +++++++++---------- .../image-analyzer/image-analyzer.factor | 15 +++- .../image-analyzer/ref-fixer/ref-fixer.factor | 68 --------------- .../references/references.factor | 39 +++++++++ .../relocations/relocations.factor | 30 +++++++ extra/tools/image-analyzer/vm/vm.factor | 8 +- 6 files changed, 124 insertions(+), 120 deletions(-) delete mode 100644 extra/tools/image-analyzer/ref-fixer/ref-fixer.factor create mode 100644 extra/tools/image-analyzer/references/references.factor create mode 100644 extra/tools/image-analyzer/relocations/relocations.factor diff --git a/extra/tools/image-analyzer/graphviz/graphviz.factor b/extra/tools/image-analyzer/graphviz/graphviz.factor index 700de8e957..b672f0c413 100644 --- a/extra/tools/image-analyzer/graphviz/graphviz.factor +++ b/extra/tools/image-analyzer/graphviz/graphviz.factor @@ -1,12 +1,11 @@ -USING: accessors alien.strings assocs classes graphviz -graphviz.attributes graphviz.notation kernel math.parser sequences -slots.syntax system tools.image-analyzer -tools.image-analyzer.ref-fixer tools.image-analyzer.vm vocabs.parser ; +USING: accessors alien.strings assocs classes fry graphviz +graphviz.attributes graphviz.notation kernel sequences system +tools.image-analyzer.references tools.image-analyzer.vm vocabs.parser ; IN: tools.image-analyzer.graphviz FROM: arrays => 1array 2array ; FROM: byte-arrays => >byte-array ; FROM: kernel => object ; -FROM: math => - ; +FROM: math => <= - shift ; << ! For the two annoying structs that differ on 32 and 64 bit. @@ -16,22 +15,8 @@ cpu x86.32? ? use-vocab >> -GENERIC: object-references ( struct -- seq ) - -M: word object-references ( struct -- seq ) - slots{ def entry_point name props vocabulary } ; - -M: code-block object-references ( struct -- seq ) - slots{ owner parameters relocation } ; - -M: object object-references ( struct -- seq ) - drop { } ; - -: heap-node>edges ( heap-node -- edges ) - [ address>> ] - [ - object>> object-references [ 1 = ] reject - ] bi [ 2array ] with map ; +: array>string ( array -- str ) + 0 suffix >byte-array alien>native-string ; CONSTANT: node-colors { { array "#999999" } @@ -40,38 +25,47 @@ CONSTANT: node-colors { { code-block "#ffaaff" } { string "#aaddff" } { quotation "#449900" } - { word "#00ff99" } + { word "#00ffcc" } } -: array>string ( array -- str ) - 0 suffix >byte-array alien>native-string ; +: heap-node>color ( heap-node -- color ) + object>> class-of node-colors at ; -: heap-node>label ( heap-node -- id ) - dup object>> dup string? [ drop payload>> array>string ] [ - [ address>> ] dip - code-block? [ code-heap-shift - ] when number>string - ] if ; +: relativise-address ( image heap-node -- address ) + swap [ + [ address>> ] [ code-heap-node? ] bi + ] [ + header>> [ code-relocation-base>> ] [ data-relocation-base>> ] bi + ] bi* ? - ; -: heap-node>fill-color ( heap-node -- color ) - object>> class-of node-colors at ; +: heap-node>label ( image heap-node -- label ) + dup object>> string? [ + nip payload>> array>string + ] [ relativise-address ] if ; + +: heap-node>node ( image heap-node -- node ) + [ heap-node>label ] [ heap-node>color ] [ address>> ] tri + swap =fillcolor swap =label "filled" =style ; + +: add-nodes ( graph image -- graph ) + dup heap>> [ heap-node>node add ] with each ; -: heap-node>node ( heap-node -- node ) - dup address>> - over heap-node>fill-color =fillcolor - swap heap-node>label =label - "filled" =style ; +: heap-node-edges ( heap heap-node -- seq ) + [ collect-pointers ] keep address>> '[ _ swap 2array ] map ; -: add-edges ( graph edges -- graph ) +: image>edges ( image -- edges ) + heap>> dup [ heap-node-edges ] with map concat ; + +: add-graphviz-edges ( graph edges -- graph ) [ first2 add-edge ] each ; -: setup-graph ( graph -- graph ) +: add-edges ( graph image -- graph ) + image>edges add-graphviz-edges ; + +: ( -- graph ) + [graph "neato" =layout ]; "false" >>overlap add ; -: make-graph ( heap-nodes -- graph ) - dup setup-graph - swap [ heap-node>node add ] each - swap [ heap-node>edges add-edges ] each ; - -: graph-image ( image -- graph ) - load-image swap dupd fix-references make-graph ; +: image>graph ( image -- graph ) + over add-nodes swap add-edges ; diff --git a/extra/tools/image-analyzer/image-analyzer.factor b/extra/tools/image-analyzer/image-analyzer.factor index 690c485a9e..fe8f101d83 100644 --- a/extra/tools/image-analyzer/image-analyzer.factor +++ b/extra/tools/image-analyzer/image-analyzer.factor @@ -1,21 +1,30 @@ USING: accessors classes.struct fry io io.encodings.binary io.files -io.streams.byte-array kernel sequences +io.streams.byte-array kernel math sequences tools.image-analyzer.code-heap-reader tools.image-analyzer.data-heap-reader tools.image-analyzer.utils tools.image-analyzer.vm ; IN: tools.image-analyzer +TUPLE: image header heap ; + : code-heap>code-blocks ( code-heap -- code-blocks ) binary [ [ read-code-block ] consume-stream>sequence ] with-byte-reader ; : data-heap>objects ( data-relocation-base data-heap -- seq ) binary [ '[ _ read-object ] consume-stream>sequence ] with-byte-reader ; -: load-image ( image -- header heap-nodes ) +: (adjust-addresses) ( nodes base -- ) + '[ [ _ + ] change-address drop ] each ; + +: adjust-addresses ( header data-nodes code-nodes -- ) + pick code-relocation-base>> (adjust-addresses) + swap data-relocation-base>> (adjust-addresses) ; + +: load-image ( image-file -- image ) binary [ image-header read-struct dup [ [ data-relocation-base>> ] [ data-size>> read ] bi data-heap>objects ] [ code-size>> read code-heap>code-blocks ] bi - ] with-file-reader append ; + ] with-file-reader 3dup adjust-addresses append image boa ; diff --git a/extra/tools/image-analyzer/ref-fixer/ref-fixer.factor b/extra/tools/image-analyzer/ref-fixer/ref-fixer.factor deleted file mode 100644 index d8ceee0eea..0000000000 --- a/extra/tools/image-analyzer/ref-fixer/ref-fixer.factor +++ /dev/null @@ -1,68 +0,0 @@ -USING: accessors arrays combinators fry kernel layouts math -math.bitwise sequences ; -IN: tools.image-analyzer.ref-fixer -QUALIFIED-WITH: tools.image-analyzer.vm vm - -: update-ref ( val rel-base -- val' ) - [ 15 unmask ] dip - ; - -: update-data-ref ( val rel-base -- val' ) - over 1 = [ 2drop 1 ] [ update-ref ] if ; - -: update-ep-ref ( val rel-base -- val' ) - update-ref 4 cell * - ; - - -GENERIC# fix-data-reference 1 ( struct rel-base -- ) - -M: vm:word fix-data-reference ( word rel-base -- ) - '[ _ update-data-ref ] - { - [ change-name drop ] - [ change-vocabulary drop ] - [ change-def drop ] - [ change-props drop ] - } 2cleave ; - -M: vm:code-block fix-data-reference ( quotation rel-base -- ) - '[ _ update-data-ref ] - [ change-owner drop ] - [ change-relocation drop ] - [ change-parameters drop ] 2tri ; - -M: object fix-data-reference ( object rel-base -- ) - 2drop ; - -: fix-data-references ( heap-nodes rel-base -- ) - '[ object>> _ fix-data-reference ] each ; - -GENERIC# fix-code-reference 1 ( struct rel-base -- ) - -M: vm:word fix-code-reference ( word rel-base -- ) - '[ _ update-ep-ref ] change-entry_point drop ; - -M: vm:quotation fix-code-reference ( quotation rel-base -- ) - '[ _ update-ep-ref ] change-entry_point drop ; - -M: object fix-code-reference ( object rel-base -- ) - 2drop ; - -CONSTANT: code-heap-shift 65536 - -: shift-code-addresses ( heap-nodes -- ) - [ dup object>> vm:code-block? [ - [ code-heap-shift + ] change-address ] when drop - ] each ; - -: shift-code-heap ( heap-nodes header -- ) - [ shift-code-addresses ] [ - [ code-heap-shift - ] change-code-relocation-base drop - ] bi* ; - -: fix-code-references ( heap-nodes rel-base -- ) - '[ object>> _ fix-code-reference ] each ; - -: fix-references ( heap-nodes header -- ) - 2dup shift-code-heap - [ data-relocation-base>> fix-data-references ] - [ code-relocation-base>> fix-code-references ] 2bi ; diff --git a/extra/tools/image-analyzer/references/references.factor b/extra/tools/image-analyzer/references/references.factor new file mode 100644 index 0000000000..89345d8c2f --- /dev/null +++ b/extra/tools/image-analyzer/references/references.factor @@ -0,0 +1,39 @@ +! Tools to follow references in the loaded image. +USING: accessors byte-arrays fry kernel layouts math math.bitwise +sequences slots.syntax tools.image-analyzer.relocations ; +IN: tools.image-analyzer.references +QUALIFIED-WITH: tools.image-analyzer.vm vm + +! Edges in the heap +GENERIC: pointers ( heap heap-node struct -- seq ) + +M: vm:array pointers ( heap heap-node struct -- seq ) + drop nip payload>> ; + +: find-heap-node ( heap ptr -- node ) + 15 unmask '[ address>> _ = ] find nip ; + +: load-relocations ( heap code-block -- seq ) + relocation>> find-heap-node payload>> >byte-array byte-array>relocations + [ first 2 = ] filter ; + +: relocation>pointer ( heap-node relocation -- ptr ) + over payload>> swap load-relative-value swap address>> + ; + +: relocation-pointers ( heap heap-node code-block -- seq ) + swapd load-relocations [ relocation>pointer ] with map ; + +M: vm:code-block pointers ( heap heap-node struct -- seq ) + [ relocation-pointers ] [ slots{ owner parameters relocation } ] bi + append ; + +M: vm:word pointers ( heap heap-node struct -- seq ) + 2nip [ + slots{ def name props vocabulary } + ] [ entry_point>> 4 cell * - ] bi suffix ; + +M: object pointers ( heap heap-node struct -- seq ) + 3drop { } ; + +: collect-pointers ( heap heap-node -- seq ) + dup object>> pointers [ 1 <= ] reject [ 15 unmask ] map ; diff --git a/extra/tools/image-analyzer/relocations/relocations.factor b/extra/tools/image-analyzer/relocations/relocations.factor new file mode 100644 index 0000000000..1d6b8297ca --- /dev/null +++ b/extra/tools/image-analyzer/relocations/relocations.factor @@ -0,0 +1,30 @@ +USING: alien.c-types alien.data assocs combinators.smart kernel math +sequences ; +IN: tools.image-analyzer.relocations + +CONSTANT: rel-params { + { 9 1 } + { 0 2 } { 13 2 } +} + +: rel-type ( uint -- type ) + -28 shift 0xf bitand ; + +: rel-class ( uint -- class ) + -24 shift 0xf bitand ; + +: rel-offset ( uint -- offset ) + 0xffffff bitand ; + +: rel-nr-params ( uint -- n ) + rel-params at 0 or ; + +: uint>relocation ( uint -- relocation ) + { [ rel-type ] [ rel-class ] [ rel-offset ] [ rel-nr-params ] } + cleave>array ; + +: byte-array>relocations ( byte-array -- relocations ) + uint cast-array [ uint>relocation ] { } map-as ; + +: load-relative-value ( byte-array relocation -- value ) + third [ [ 4 - ] keep rot subseq int cast-array first ] keep + ; diff --git a/extra/tools/image-analyzer/vm/vm.factor b/extra/tools/image-analyzer/vm/vm.factor index 30b13d46bb..b871130649 100644 --- a/extra/tools/image-analyzer/vm/vm.factor +++ b/extra/tools/image-analyzer/vm/vm.factor @@ -9,10 +9,10 @@ STRUCT: image-header { data-size cell_t } { code-relocation-base cell_t } { code-size cell_t } - { true-object cell_t } - { bignum-zero cell_t } - { bignum-pos-one cell_t } - { bignum-neg-one cell_t } + { reserved-1 cell_t } + { reserved-2 cell_t } + { reserved-3 cell_t } + { reserved-4 cell_t } { special-objects cell_t[special-object-count] } ; ! These structs and words correspond to vm/layouts.hpp -- 2.34.1