From 4669c8a4eba4c81d8957db5d4058efdcd9b4f452 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Bj=C3=B6rn=20Lindqvist?= <bjourne@gmail.com>
Date: Thu, 9 Jul 2015 18:45:56 +0200
Subject: [PATCH] tools.image-analyzer.*: fixes so that the vocab should work
 both on 32 and 64 bit

---
 .../image-analyzer/image-analyzer-docs.factor | 21 ++++++++++++++++
 .../image-analyzer-tests.factor               | 17 +++++++++++++
 extra/tools/image-analyzer/vm/32/32.factor    | 13 ++++++++++
 extra/tools/image-analyzer/vm/64/64.factor    | 10 ++++++++
 extra/tools/image-analyzer/vm/vm.factor       | 24 +++++++++----------
 5 files changed, 73 insertions(+), 12 deletions(-)
 create mode 100644 extra/tools/image-analyzer/image-analyzer-docs.factor
 create mode 100644 extra/tools/image-analyzer/image-analyzer-tests.factor
 create mode 100644 extra/tools/image-analyzer/vm/32/32.factor
 create mode 100644 extra/tools/image-analyzer/vm/64/64.factor

diff --git a/extra/tools/image-analyzer/image-analyzer-docs.factor b/extra/tools/image-analyzer/image-analyzer-docs.factor
new file mode 100644
index 0000000000..b73d0f0c3d
--- /dev/null
+++ b/extra/tools/image-analyzer/image-analyzer-docs.factor
@@ -0,0 +1,21 @@
+USING: assocs help.markup help.syntax sequences strings ;
+IN: tools.image-analyzer
+FROM: tools.image-analyzer.vm => image-header ;
+
+HELP: load-image
+{ $values
+  { "image" string }
+  { "header" image-header }
+  { "data-heap" sequence }
+  { "code-heap" sequence }
+}
+{ $description "Loads and decodes Factor image." } ;
+
+ARTICLE: "tools.image-analyzer" "Loader for Factor images"
+"The " { $vocab-link "tools.image-analyzer" } " loads and decodes Factor images."
+$nl
+"Main word:"
+{ $subsections load-image }
+{ $notes "A limitation of the vocab is that cpu architecture of the image must match the Factor process. So 32 bit Factor can only load 32 bit images and 64 bit Factor 64 bit images." } ;
+
+ABOUT: "tools.image-analyzer"
diff --git a/extra/tools/image-analyzer/image-analyzer-tests.factor b/extra/tools/image-analyzer/image-analyzer-tests.factor
new file mode 100644
index 0000000000..c0b5eb4460
--- /dev/null
+++ b/extra/tools/image-analyzer/image-analyzer-tests.factor
@@ -0,0 +1,17 @@
+USING: accessors bootstrap.image fry grouping io.files io.pathnames kernel
+sequences system tools.deploy.backend tools.image-analyzer tools.test ;
+IN: tools.image-analyzer.tests
+
+: ?make-image ( arch -- )
+    dup boot-image-name resource-path exists? [ drop ] [ make-image ] if ;
+
+: loadable-images ( -- images )
+    images cpu name>> '[ _ tail? ] filter ;
+
+{ t } [
+    loadable-images [ [ ?make-image ] each ] [
+        [
+            boot-image-name resource-path load-image 2drop code-size>>
+        ] map [ 0 = ] all?
+    ] bi
+] unit-test
diff --git a/extra/tools/image-analyzer/vm/32/32.factor b/extra/tools/image-analyzer/vm/32/32.factor
new file mode 100644
index 0000000000..2c97bfe202
--- /dev/null
+++ b/extra/tools/image-analyzer/vm/32/32.factor
@@ -0,0 +1,13 @@
+USING: alien.c-types classes.struct vm ;
+IN: tools.image-analyzer.vm
+
+STRUCT: boxed-float
+    { header cell }
+    { padding cell }
+    { n double } ;
+
+STRUCT: byte-array
+    { header cell }
+    { capacity cell }
+    { padding0 cell }
+    { padding1 cell } ;
diff --git a/extra/tools/image-analyzer/vm/64/64.factor b/extra/tools/image-analyzer/vm/64/64.factor
new file mode 100644
index 0000000000..00fc13ad45
--- /dev/null
+++ b/extra/tools/image-analyzer/vm/64/64.factor
@@ -0,0 +1,10 @@
+USING: alien.c-types classes.struct vm ;
+IN: tools.image-analyzer.vm
+
+STRUCT: boxed-float
+    { header cell }
+    { n double } ;
+
+STRUCT: byte-array
+    { header cell }
+    { capacity cell } ;
diff --git a/extra/tools/image-analyzer/vm/vm.factor b/extra/tools/image-analyzer/vm/vm.factor
index 0f6f096913..c2a7959fd4 100644
--- a/extra/tools/image-analyzer/vm/vm.factor
+++ b/extra/tools/image-analyzer/vm/vm.factor
@@ -1,6 +1,15 @@
-USING: alien.c-types assocs classes.struct kernel.private vm ;
+USING: alien.c-types assocs classes.struct kernel kernel.private system vm
+vocabs.parser ;
 IN: tools.image-analyzer.vm
 
+<<
+! For the two annoying structs that differ on 32 and 64 bit.
+cpu x86.32?
+"tools.image-analyzer.vm.32"
+"tools.image-analyzer.vm.64"
+? use-vocab
+>>
+
 ! These structs and words correspond to vm/image.hpp
 STRUCT: image-header
     { magic cell }
@@ -34,10 +43,6 @@ STRUCT: bignum
     { header cell }
     { capacity cell } ;
 
-! Different on 32 bit
-STRUCT: byte-array
-    { header cell }
-    { capacity cell } ;
 
 STRUCT: callstack
     { header cell }
@@ -48,11 +53,6 @@ STRUCT: dll
     { path cell }
     { handle void* } ;
 
-! Different on 32 bit
-STRUCT: float
-    { header cell }
-    { n double } ;
-
 STRUCT: quotation
     { header cell }
     { array cell }
@@ -95,8 +95,8 @@ STRUCT: wrapper
 
 UNION: no-payload
     alien
+    boxed-float
     dll
-    float
     quotation
     wrapper
     word ;
@@ -108,7 +108,7 @@ UNION: array-payload
 : tag>class ( tag -- class )
     {
         { 2 array }
-        { 3 float }
+        { 3 boxed-float }
         { 4 quotation }
         { 5 bignum }
         { 6 alien }
-- 
2.34.1