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

tools.image-analyzer.data-heap-reader: payload should be unsigned bytes 

not chars
db4
Björn Lindqvist 2015-07-13 00:54:12 +02:00 committed by John Benediktsson
parent 2f3dab093a
commit d3a6fa85e5
1 changed files with 6 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -2,7 +2,7 @@ USING: accessors assocs classes classes.struct io locals
math.bitwise namespaces sequences system tools.image-analyzer.utils math.bitwise namespaces sequences system tools.image-analyzer.utils
tools.image-analyzer.vm vm vocabs.parser ; tools.image-analyzer.vm vm vocabs.parser ;
IN: tools.image-analyzer.data-heap-reader IN: tools.image-analyzer.data-heap-reader
FROM: alien.c-types => char heap-size ; FROM: alien.c-types => uchar heap-size ;
FROM: arrays => 2array ; FROM: arrays => 2array ;
FROM: kernel => ? bi dup keep nip swap ; FROM: kernel => ? bi dup keep nip swap ;
FROM: layouts => data-alignment ; FROM: layouts => data-alignment ;
@ -64,8 +64,8 @@ GENERIC: read-payload ( rel-base struct -- tuple )
: read-array-payload ( 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 object -- payload ) : read-uchar-payload ( n-bytes object -- payload )
char read-padded-payload ; uchar read-padded-payload ;
: read-no-payload ( object -- payload ) : read-no-payload ( object -- payload )
0 swap seek-past-padding { } ; 0 swap seek-past-padding { } ;
@ -80,13 +80,13 @@ M: no-payload read-payload ( rel-base object -- payload )
nip read-no-payload ; nip read-no-payload ;
M: byte-array read-payload ( rel-base 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-uchar-payload ;
M: callstack read-payload ( rel-base object -- payload ) M: callstack read-payload ( rel-base object -- payload )
nip [ length>> -4 shift ] keep read-char-payload ; nip [ length>> -4 shift ] keep read-uchar-payload ;
M: string read-payload ( rel-base string -- payload ) M: string read-payload ( rel-base string -- payload )
nip [ length>> -4 shift ] keep read-char-payload ; nip [ length>> -4 shift ] keep read-uchar-payload ;
M: tuple read-payload ( rel-base tuple -- payload ) M: tuple read-payload ( rel-base tuple -- payload )
[ [