tools.hexdump: don't require stream-length

for better stdin compatibility.
paths
John Benediktsson 2018-03-14 13:28:00 -07:00
parent f83449b688
commit ee83e0f0d3
1 changed files with 10 additions and 11 deletions

View File

@ -11,10 +11,7 @@ IN: tools.hexdump
<PRIVATE <PRIVATE
: write-header ( len -- ) CONSTANT: line# "00000000 "
dup "Length: %d, %xh\n" printf ;
CONSTANT: line# "00000000h: "
: inc-line# ( -- ) : inc-line# ( -- )
7 [ CHAR: 0 = over 0 > and ] [ 7 [ CHAR: 0 = over 0 > and ] [
@ -28,7 +25,7 @@ CONSTANT: line# "00000000h: "
] do while drop ; ] do while drop ;
: reset-line# ( -- ) : reset-line# ( -- )
7 [ CHAR: 0 swap line# set-nth ] each-integer ; 8 [ CHAR: 0 swap line# set-nth ] each-integer ;
CONSTANT: hex-digits $[ CONSTANT: hex-digits $[
256 <iota> [ >hex 2 CHAR: 0 pad-head " " append ] map 256 <iota> [ >hex 2 CHAR: 0 pad-head " " append ] map
@ -49,7 +46,9 @@ CONSTANT: hex-digits $[
] unless-zero ; inline ] unless-zero ; inline
: write-ascii ( from to bytes stream -- ) : write-ascii ( from to bytes stream -- )
'[ [ printable? ] keep CHAR: . ? _ stream-write1 ] each-byte ; inline dup stream-bl '[
[ printable? ] keep CHAR: . ? _ stream-write1
] each-byte ; inline
TYPED: write-hex-line ( from: fixnum to: fixnum bytes: byte-array -- ) TYPED: write-hex-line ( from: fixnum to: fixnum bytes: byte-array -- )
line# write inc-line# output-stream get { line# write inc-line# output-stream get {
@ -61,15 +60,15 @@ TYPED: write-hex-line ( from: fixnum to: fixnum bytes: byte-array -- )
:: hexdump-bytes ( from to bytes -- ) :: hexdump-bytes ( from to bytes -- )
reset-line# reset-line#
to from - :> len to from - :> len
len write-header
len 16 /mod len 16 /mod
[ [ 16 * dup 16 + bytes write-hex-line ] each-integer ] [ [ 16 * dup 16 + bytes write-hex-line ] each-integer ]
[ [ len swap - len bytes write-hex-line ] unless-zero ] bi* ; [ [ len swap - len bytes write-hex-line ] unless-zero ] bi*
len "%08x\n" printf ;
: hexdump-stream ( stream -- ) : hexdump-stream ( stream -- )
reset-line# reset-line# 0 swap [
[ stream-length write-header ] all-bytes [ write-hex-line ] [ length + ] bi
[ [ all-bytes write-hex-line ] 16 (each-stream-block) ] bi ; ] 16 (each-stream-block) "%08x\n" printf ;
PRIVATE> PRIVATE>