2008-11-13 20:48:11 -05:00
|
|
|
! Copyright (C) 2008 Doug Coleman.
|
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2018-03-14 14:22:47 -04:00
|
|
|
|
|
|
|
USING: accessors ascii byte-arrays byte-vectors combinators
|
2018-03-14 16:34:41 -04:00
|
|
|
command-line destructors fry io io.encodings io.encodings.binary
|
|
|
|
io.files io.streams.string kernel literals locals math
|
|
|
|
math.parser namespaces sequences sequences.private strings typed
|
|
|
|
;
|
2018-03-14 14:22:47 -04:00
|
|
|
|
2008-11-13 20:48:11 -05:00
|
|
|
IN: tools.hexdump
|
|
|
|
|
|
|
|
<PRIVATE
|
|
|
|
|
2018-03-14 16:28:00 -04:00
|
|
|
CONSTANT: line# "00000000 "
|
2018-03-14 14:22:47 -04:00
|
|
|
|
|
|
|
: inc-line# ( -- )
|
|
|
|
7 [ CHAR: 0 = over 0 > and ] [
|
|
|
|
1 - dup line# [
|
|
|
|
{
|
|
|
|
{ CHAR: 9 [ CHAR: a ] }
|
|
|
|
{ CHAR: f [ CHAR: 0 ] }
|
|
|
|
[ 1 + ]
|
|
|
|
} case dup
|
|
|
|
] change-nth-unsafe
|
|
|
|
] do while drop ;
|
|
|
|
|
|
|
|
: reset-line# ( -- )
|
2018-03-14 16:28:00 -04:00
|
|
|
8 [ CHAR: 0 swap line# set-nth ] each-integer ;
|
2018-03-14 14:22:47 -04:00
|
|
|
|
|
|
|
CONSTANT: hex-digits $[
|
|
|
|
256 <iota> [ >hex 2 CHAR: 0 pad-head " " append ] map
|
|
|
|
]
|
|
|
|
|
|
|
|
: all-bytes ( bytes -- from to bytes )
|
|
|
|
[ 0 swap length ] keep ; inline
|
|
|
|
|
|
|
|
: each-byte ( from to bytes quot: ( elt -- ) -- )
|
|
|
|
'[ _ nth-unsafe @ ] (each-integer) ; inline
|
|
|
|
|
|
|
|
: write-bytes ( from to bytes stream -- )
|
|
|
|
'[ hex-digits nth-unsafe _ stream-write ] each-byte ; inline
|
|
|
|
|
|
|
|
: write-space ( from to bytes stream -- )
|
|
|
|
[ drop - 16 + ] dip '[
|
|
|
|
3 * CHAR: \s <string> _ stream-write
|
|
|
|
] unless-zero ; inline
|
|
|
|
|
|
|
|
: write-ascii ( from to bytes stream -- )
|
2018-03-14 16:28:00 -04:00
|
|
|
dup stream-bl '[
|
|
|
|
[ printable? ] keep CHAR: . ? _ stream-write1
|
|
|
|
] each-byte ; inline
|
2018-03-14 14:22:47 -04:00
|
|
|
|
|
|
|
TYPED: write-hex-line ( from: fixnum to: fixnum bytes: byte-array -- )
|
|
|
|
line# write inc-line# output-stream get {
|
|
|
|
[ write-bytes ]
|
|
|
|
[ write-space ]
|
|
|
|
[ write-ascii ]
|
|
|
|
} 4cleave nl ;
|
|
|
|
|
|
|
|
:: hexdump-bytes ( from to bytes -- )
|
|
|
|
reset-line#
|
|
|
|
to from - :> len
|
|
|
|
len 16 /mod
|
|
|
|
[ [ 16 * dup 16 + bytes write-hex-line ] each-integer ]
|
2018-03-14 16:28:00 -04:00
|
|
|
[ [ len swap - len bytes write-hex-line ] unless-zero ] bi*
|
2018-03-14 16:34:41 -04:00
|
|
|
len >hex 8 CHAR: 0 pad-head print ;
|
2018-03-14 14:22:47 -04:00
|
|
|
|
|
|
|
: hexdump-stream ( stream -- )
|
2018-03-14 16:28:00 -04:00
|
|
|
reset-line# 0 swap [
|
|
|
|
all-bytes [ write-hex-line ] [ length + ] bi
|
2018-03-14 16:34:41 -04:00
|
|
|
] 16 (each-stream-block) >hex 8 CHAR: 0 pad-head print ;
|
2009-02-13 10:55:38 -05:00
|
|
|
|
2008-11-13 20:48:11 -05:00
|
|
|
PRIVATE>
|
|
|
|
|
2008-11-29 01:42:15 -05:00
|
|
|
GENERIC: hexdump. ( byte-array -- )
|
|
|
|
|
2018-03-14 14:22:47 -04:00
|
|
|
M: byte-array hexdump. all-bytes hexdump-bytes ;
|
2009-02-13 10:55:38 -05:00
|
|
|
|
2018-03-14 14:22:47 -04:00
|
|
|
M: byte-vector hexdump. all-bytes underlying>> hexdump-bytes ;
|
2008-11-13 20:48:11 -05:00
|
|
|
|
2008-11-29 01:42:15 -05:00
|
|
|
: hexdump ( byte-array -- str )
|
2008-11-13 20:48:11 -05:00
|
|
|
[ hexdump. ] with-string-writer ;
|
2009-06-05 23:49:07 -04:00
|
|
|
|
|
|
|
: hexdump-file ( path -- )
|
2018-03-14 14:22:47 -04:00
|
|
|
binary <file-reader> [ hexdump-stream ] with-disposal ;
|
2015-04-09 13:43:20 -04:00
|
|
|
|
|
|
|
: hexdump-main ( -- )
|
2018-03-13 16:53:47 -04:00
|
|
|
command-line get [
|
2018-08-02 16:34:38 -04:00
|
|
|
input-stream get binary re-decode hexdump-stream
|
2018-03-13 16:53:47 -04:00
|
|
|
] [
|
|
|
|
[ hexdump-file ] each
|
|
|
|
] if-empty ;
|
2015-04-09 13:43:20 -04:00
|
|
|
|
|
|
|
MAIN: hexdump-main
|