tools.image-analyzer.*: fixes so that the vocab should work both on 32

and 64 bit

diff --git a/extra/tools/image-analyzer/image-analyzer-docs.factor b/extra/tools/image-analyzer/image-analyzer-docs.factor
new file mode 100644 (file)
index 0000000..b73d0f0
--- /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 (file)
index 0000000..c0b5eb4
--- /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 (file)
index 0000000..2c97bfe
--- /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 (file)
index 0000000..00fc13a
--- /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 0f6f096913a1ea26aa9e818426f0fd2ac56b3841..c2a7959fd42d43a209d420541f54eb5850f594ed 100644 (file)
--- 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 }