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 }