steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

tools.image-analyzer.*: support for callstack reading

db4
Björn Lindqvist 2015-07-09 15:41:03 +02:00
parent 16029fa0c9
commit f2a85d1b13
2 changed files with 24 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

35
extra/tools/image-analyzer/data-heap-reader/data-heap-reader.factor
View File

@ -7,48 +7,51 @@ FROM: kernel => bi dup keep nip swap ;
FROM: layouts => data-alignment ; FROM: layouts => data-alignment ;
FROM: math => + - * align neg shift ; FROM: math => + - * align neg shift ;
: object-tag ( vm-object -- tag ) : object-tag ( object -- tag )
header>> 5 2 bit-range ; header>> 5 2 bit-range ;
GENERIC: read-payload ( rel-base struct -- tuple ) GENERIC: read-payload ( rel-base struct -- tuple )
: remainder-padding ( payload-size vm-object -- n ) : remainder-padding ( payload-size object -- n )
class-heap-size + dup data-alignment get align swap - ; class-heap-size + dup data-alignment get align swap - ;
: seek-past-padding ( payload-size vm-object -- ) : seek-past-padding ( payload-size object -- )
remainder-padding seek-relative seek-input ; remainder-padding seek-relative seek-input ;
:: read-padded-payload ( count vm-object c-type -- payload ) :: read-padded-payload ( count object c-type -- payload )
count c-type heap-size * :> payload-size count c-type heap-size * :> payload-size
payload-size [ payload-size [
c-type read-bytes>array c-type read-bytes>array
] [ vm-object seek-past-padding ] bi ; ] [ object seek-past-padding ] bi ;
: read-array-payload ( vm-array -- payload ) : read-array-payload ( array -- payload )
[ capacity>> -4 shift ] keep cell read-padded-payload ; [ capacity>> -4 shift ] keep cell read-padded-payload ;
: read-char-payload ( n-bytes vm-object -- payload ) : read-char-payload ( n-bytes object -- payload )
char read-padded-payload ; char read-padded-payload ;
: read-no-payload ( vm-object -- payload ) : read-no-payload ( object -- payload )
0 swap seek-past-padding { } ; 0 swap seek-past-padding { } ;
: layout-address ( rel-base vm-tuple -- address ) : layout-address ( rel-base tuple -- address )
layout>> 15 unmask - neg ; layout>> 15 unmask - neg ;
M: array-payload read-payload ( rel-base vm-object -- payload ) M: array-payload read-payload ( rel-base object -- payload )
nip read-array-payload ; nip read-array-payload ;
M: no-payload read-payload ( rel-base vm-object -- payload ) M: no-payload read-payload ( rel-base object -- payload )
nip read-no-payload ; nip read-no-payload ;
M: byte-array read-payload ( rel-base vm-object -- payload ) M: byte-array read-payload ( rel-base object -- payload )
nip [ capacity>> -4 shift ] keep read-char-payload ; nip [ capacity>> -4 shift ] keep read-char-payload ;
M: string read-payload ( rel-base vm-string -- payload ) M: callstack read-payload ( rel-base object -- payload )
nip [ length>> -4 shift ] keep read-char-payload ; nip [ length>> -4 shift ] keep read-char-payload ;
M: tuple read-payload ( rel-base vm-tuple -- payload ) M: string read-payload ( rel-base string -- payload )
nip [ length>> -4 shift ] keep read-char-payload ;
M: tuple read-payload ( rel-base tuple -- payload )
[ [
[ [
layout-address seek-absolute seek-input layout-address seek-absolute seek-input
@ -56,10 +59,10 @@ M: tuple read-payload ( rel-base vm-tuple -- payload )
] save-io-excursion ] save-io-excursion
] keep cell read-padded-payload ; ] keep cell read-padded-payload ;
: peek-read-object ( -- vm-base ) : peek-read-object ( -- object )
[ object read-struct ] save-io-excursion ; [ object read-struct ] save-io-excursion ;
: (read-object) ( -- vm-object ) : (read-object) ( -- object )
peek-read-object object-tag tag>class read-struct ; peek-read-object object-tag tag>class read-struct ;
: read-object ( rel-base -- object ) : read-object ( rel-base -- object )

5
extra/tools/image-analyzer/vm/vm.factor
View File

@ -39,6 +39,10 @@ STRUCT: byte-array
{ header cell } { header cell }
{ capacity cell } ; { capacity cell } ;
STRUCT: callstack
{ header cell }
{ length cell } ;
STRUCT: dll STRUCT: dll
{ header cell } { header cell }
{ path cell } { path cell }
@ -111,6 +115,7 @@ UNION: array-payload
{ 7 tuple } { 7 tuple }
{ 8 wrapper } { 8 wrapper }
{ 9 byte-array } { 9 byte-array }
{ 10 callstack }
{ 11 string } { 11 string }
{ 12 word } { 12 word }
{ 13 dll } { 13 dll }