-USING: accessors arrays assocs classes classes.struct io
-locals math.bitwise namespaces sequences tools.image-analyzer.utils
-tools.image-analyzer.vm vm ;
+USING: accessors assocs classes classes.struct io locals
+math.bitwise namespaces sequences system tools.image-analyzer.utils
+tools.image-analyzer.vm vm vocabs.parser ;
IN: tools.image-analyzer.data-heap-reader
FROM: alien.c-types => char heap-size ;
-FROM: kernel => bi dup keep nip swap ;
+FROM: arrays => 2array ;
+FROM: kernel => ? bi dup keep nip swap ;
FROM: layouts => data-alignment ;
FROM: math => + - * align neg shift ;
+<<
+! 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
+>>
+
+: tag>class ( tag -- class )
+ {
+ { 2 array }
+ { 3 boxed-float }
+ { 4 quotation }
+ { 5 bignum }
+ { 6 alien }
+ { 7 tuple }
+ { 8 wrapper }
+ { 9 byte-array }
+ { 10 callstack }
+ { 11 string }
+ { 12 word }
+ { 13 dll }
+ } at ;
+
: object-tag ( object -- tag )
header>> 5 2 bit-range ;
+UNION: no-payload
+ alien
+ boxed-float
+ dll
+ quotation
+ wrapper
+ word ;
+
+UNION: array-payload
+ array
+ bignum ;
+
GENERIC: read-payload ( rel-base struct -- tuple )
: remainder-padding ( payload-size object -- n )
sequences system tools.deploy.backend tools.image-analyzer tools.test ;
IN: tools.image-analyzer.tests
+: image-path ( arch -- path )
+ boot-image-name resource-path ;
+
: ?make-image ( arch -- )
- dup boot-image-name resource-path exists? [ drop ] [ make-image ] if ;
+ dup image-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>>
+ image-path load-image 2drop code-size>>
] map [ 0 = ] all?
] bi
] unit-test
USING: alien.c-types classes.struct vm ;
-IN: tools.image-analyzer.vm
+IN: tools.image-analyzer.vm.32
STRUCT: boxed-float
{ header cell }
USING: alien.c-types classes.struct vm ;
-IN: tools.image-analyzer.vm
+IN: tools.image-analyzer.vm.64
STRUCT: boxed-float
{ header cell }
-USING: alien.c-types assocs classes.struct kernel kernel.private system vm
-vocabs.parser ;
+USING: alien.c-types assocs classes.struct kernel kernel.private vm ;
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 }
{ header cell }
{ object cell } ;
-UNION: no-payload
- alien
- boxed-float
- dll
- quotation
- wrapper
- word ;
-
-UNION: array-payload
- array
- bignum ;
-
-: tag>class ( tag -- class )
- {
- { 2 array }
- { 3 boxed-float }
- { 4 quotation }
- { 5 bignum }
- { 6 alien }
- { 7 tuple }
- { 8 wrapper }
- { 9 byte-array }
- { 10 callstack }
- { 11 string }
- { 12 word }
- { 13 dll }
- } at ;
-
! These structs and words correspond to vm/code_blocks.hpp
STRUCT: code-block
{ header cell }