From: Björn Lindqvist <bjourne@gmail.com>
Date: Mon, 7 Dec 2015 03:20:43 +0000 (+0100)
Subject: tools.image-analyzer.*: wrap read objects in heap-node tuples with their addresses
X-Git-Tag: unmaintained~1688
X-Git-Url: https://gitweb.factorcode.org/gitweb.cgi?p=factor.git;a=commitdiff_plain;h=bf28e85405f2c609631e43778f40682244197792

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

diff --git a/extra/tools/image-analyzer/code-heap-reader/code-heap-reader.factor b/extra/tools/image-analyzer/code-heap-reader/code-heap-reader.factor
index e01c7d62ca..1a9dc9b046 100644
--- a/extra/tools/image-analyzer/code-heap-reader/code-heap-reader.factor
+++ b/extra/tools/image-analyzer/code-heap-reader/code-heap-reader.factor
@@ -1,10 +1,8 @@
-USING: accessors alien.c-types classes.struct combinators io kernel
-math math.bitwise tools.image-analyzer.gc-info tools.image-analyzer.vm ;
+USING: accessors alien.c-types classes.struct io kernel math
+math.bitwise tools.image-analyzer.gc-info tools.image-analyzer.vm ;
 IN: tools.image-analyzer.code-heap-reader
 QUALIFIED: layouts
 
-TUPLE: code-block-t free? owner parameters relocation gc-maps payload ;
-
 : free? ( code-block -- ? )
     header>> 1 mask? ;
 
@@ -14,10 +12,6 @@ TUPLE: code-block-t free? owner parameters relocation gc-maps payload ;
 : (read-code-block) ( -- code-block payload )
     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< ] [ [ byte-array>gc-maps ] keep ] bi*
-    code-block-t boa ;
+    tell-input (read-code-block) 2dup [ free? ] [ byte-array>gc-maps ] bi*
+    code-heap-node boa ;
diff --git a/extra/tools/image-analyzer/data-heap-reader/data-heap-reader.factor b/extra/tools/image-analyzer/data-heap-reader/data-heap-reader.factor
index a9b268d991..57140d41de 100644
--- a/extra/tools/image-analyzer/data-heap-reader/data-heap-reader.factor
+++ b/extra/tools/image-analyzer/data-heap-reader/data-heap-reader.factor
@@ -1,10 +1,10 @@
-USING: accessors assocs classes classes.struct io locals
-math.bitwise namespaces sequences system tools.image-analyzer.utils
-tools.image-analyzer.vm vm vocabs.parser ;
+USING: accessors assocs classes.struct io locals math.bitwise
+namespaces system tools.image-analyzer.utils tools.image-analyzer.vm
+vm vocabs.parser ;
 IN: tools.image-analyzer.data-heap-reader
 FROM: alien.c-types => uchar heap-size ;
 FROM: arrays => 2array ;
-FROM: kernel => ? bi dup keep nip swap ;
+FROM: kernel => ? boa bi dup keep nip swap ;
 FROM: layouts => data-alignment ;
 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 ;
 
 : read-object ( rel-base -- object )
-    (read-object) [ read-payload ] keep swap 2array ;
+    tell-input swap (read-object) [ read-payload ] keep swap heap-node boa ;
diff --git a/extra/tools/image-analyzer/image-analyzer.factor b/extra/tools/image-analyzer/image-analyzer.factor
index a7cc1f8158..fa061861a4 100644
--- a/extra/tools/image-analyzer/image-analyzer.factor
+++ b/extra/tools/image-analyzer/image-analyzer.factor
@@ -1,13 +1,14 @@
-USING: accessors arrays assocs classes.struct fry io io.encodings.binary
-io.files io.streams.byte-array kernel kernel.private math sequences
-tools.image-analyzer.code-heap-reader tools.image-analyzer.data-heap-reader
-tools.image-analyzer.utils tools.image-analyzer.vm vm ;
+USING: accessors classes.struct fry io io.encodings.binary io.files
+io.streams.byte-array kernel 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
 
 : 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 -- object-assoc )
+: data-heap>objects ( data-relocation-base data-heap -- seq )
     binary [ '[ _ read-object ] consume-stream>sequence ] with-byte-reader ;
 
 : load-image ( image -- header data-heap code-heap )
diff --git a/extra/tools/image-analyzer/vm/vm.factor b/extra/tools/image-analyzer/vm/vm.factor
index 6f05668a3e..30b13d46bb 100644
--- a/extra/tools/image-analyzer/vm/vm.factor
+++ b/extra/tools/image-analyzer/vm/vm.factor
@@ -90,3 +90,7 @@ STRUCT: code-block
     { owner cell_t }
     { parameters cell_t }
     { relocation cell_t } ;
+
+TUPLE: heap-node address object payload ;
+
+TUPLE: code-heap-node < heap-node free? gc-maps ;