tools.image-analyzer.*: wrap read objects in heap-node tuples with their addresses

db4
Björn Lindqvist 2015-12-07 04:20:43 +01:00
parent 74cb1acd17
commit bf28e85405
4 changed files with 19 additions and 20 deletions

View File

@ -1,10 +1,8 @@
USING: accessors alien.c-types classes.struct combinators io kernel USING: accessors alien.c-types classes.struct io kernel math
math math.bitwise tools.image-analyzer.gc-info tools.image-analyzer.vm ; math.bitwise tools.image-analyzer.gc-info tools.image-analyzer.vm ;
IN: tools.image-analyzer.code-heap-reader IN: tools.image-analyzer.code-heap-reader
QUALIFIED: layouts QUALIFIED: layouts
TUPLE: code-block-t free? owner parameters relocation gc-maps payload ;
: free? ( code-block -- ? ) : free? ( code-block -- ? )
header>> 1 mask? ; header>> 1 mask? ;
@ -14,10 +12,6 @@ TUPLE: code-block-t free? owner parameters relocation gc-maps payload ;
: (read-code-block) ( -- code-block payload ) : (read-code-block) ( -- code-block payload )
code-block [ read-struct ] [ heap-size ] bi over size swap - read ; code-block [ read-struct ] [ heap-size ] bi over size swap - read ;
: >code-block< ( code-block -- free? owner parameters relocation )
{ [ free? ] [ owner>> ] [ parameters>> ] [ relocation>> ] } cleave ;
: read-code-block ( -- code-block ) : read-code-block ( -- code-block )
(read-code-block) tell-input (read-code-block) 2dup [ free? ] [ byte-array>gc-maps ] bi*
[ >code-block< ] [ [ byte-array>gc-maps ] keep ] bi* code-heap-node boa ;
code-block-t boa ;

View File

@ -1,10 +1,10 @@
USING: accessors assocs classes classes.struct io locals USING: accessors assocs classes.struct io locals math.bitwise
math.bitwise namespaces sequences system tools.image-analyzer.utils namespaces system tools.image-analyzer.utils tools.image-analyzer.vm
tools.image-analyzer.vm vm vocabs.parser ; vm vocabs.parser ;
IN: tools.image-analyzer.data-heap-reader IN: tools.image-analyzer.data-heap-reader
FROM: alien.c-types => uchar heap-size ; FROM: alien.c-types => uchar heap-size ;
FROM: arrays => 2array ; FROM: arrays => 2array ;
FROM: kernel => ? bi dup keep nip swap ; FROM: kernel => ? boa bi dup keep nip swap ;
FROM: layouts => data-alignment ; FROM: layouts => data-alignment ;
FROM: math => + - * align neg shift ; FROM: math => + - * align neg shift ;
@ -103,4 +103,4 @@ M: tuple read-payload ( rel-base tuple -- payload )
peek-read-object object-tag tag>class read-struct ; peek-read-object object-tag tag>class read-struct ;
: read-object ( rel-base -- object ) : read-object ( rel-base -- object )
(read-object) [ read-payload ] keep swap 2array ; tell-input swap (read-object) [ read-payload ] keep swap heap-node boa ;

View File

@ -1,13 +1,14 @@
USING: accessors arrays assocs classes.struct fry io io.encodings.binary USING: accessors classes.struct fry io io.encodings.binary io.files
io.files io.streams.byte-array kernel kernel.private math sequences io.streams.byte-array kernel sequences
tools.image-analyzer.code-heap-reader tools.image-analyzer.data-heap-reader tools.image-analyzer.code-heap-reader
tools.image-analyzer.utils tools.image-analyzer.vm vm ; tools.image-analyzer.data-heap-reader tools.image-analyzer.utils
tools.image-analyzer.vm ;
IN: tools.image-analyzer IN: tools.image-analyzer
: code-heap>code-blocks ( code-heap -- code-blocks ) : code-heap>code-blocks ( code-heap -- code-blocks )
binary [ [ read-code-block ] consume-stream>sequence ] with-byte-reader ; binary [ [ read-code-block ] consume-stream>sequence ] with-byte-reader ;
: data-heap>objects ( data-relocation-base data-heap -- object-assoc ) : data-heap>objects ( data-relocation-base data-heap -- seq )
binary [ '[ _ read-object ] consume-stream>sequence ] with-byte-reader ; binary [ '[ _ read-object ] consume-stream>sequence ] with-byte-reader ;
: load-image ( image -- header data-heap code-heap ) : load-image ( image -- header data-heap code-heap )

View File

@ -90,3 +90,7 @@ STRUCT: code-block
{ owner cell_t } { owner cell_t }
{ parameters cell_t } { parameters cell_t }
{ relocation cell_t } ; { relocation cell_t } ;
TUPLE: heap-node address object payload ;
TUPLE: code-heap-node < heap-node free? gc-maps ;