diff --git a/basis/tools/hexdump/hexdump.factor b/basis/tools/hexdump/hexdump.factor index 2011260ce4..4384417d5f 100644 --- a/basis/tools/hexdump/hexdump.factor +++ b/basis/tools/hexdump/hexdump.factor @@ -1,55 +1,94 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors ascii byte-arrays byte-vectors command-line -grouping io io.encodings io.encodings.binary io.files -io.streams.string kernel math math.parser namespaces sequences ; + +USING: accessors ascii byte-arrays byte-vectors combinators +command-line destructors formatting fry io io.encodings +io.encodings.binary io.files io.streams.string kernel literals +locals math math.parser namespaces sequences sequences.private +strings typed ; + IN: tools.hexdump string write ", " write ] - [ >hex write "h" write nl ] bi ; + dup "Length: %d, %xh\n" printf ; -: write-offset ( lineno -- ) - 16 * >hex 8 CHAR: 0 pad-head write "h: " write ; +CONSTANT: line# "00000000h: " -: >hex-digit ( digit -- str ) - >hex 2 CHAR: 0 pad-head ; +: 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 ; -: >hex-digits ( bytes -- str ) - [ >hex-digit " " append ] { } map-as concat - 48 CHAR: \s pad-tail ; +: reset-line# ( -- ) + 7 [ CHAR: 0 swap line# set-nth ] each-integer ; -: >ascii ( bytes -- str ) - [ [ printable? ] keep CHAR: . ? ] "" map-as ; +CONSTANT: hex-digits $[ + 256 [ >hex 2 CHAR: 0 pad-head " " append ] map +] -: write-hex-line ( bytes lineno -- ) - write-offset [ >hex-digits write ] [ >ascii write ] bi nl ; +: all-bytes ( bytes -- from to bytes ) + [ 0 swap length ] keep ; inline -: hexdump-bytes ( bytes -- ) - [ length write-header ] - [ 16 [ write-hex-line ] each-index ] bi ; +: 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 _ stream-write + ] unless-zero ; inline + +: write-ascii ( from to bytes stream -- ) + '[ [ printable? ] keep CHAR: . ? _ stream-write1 ] each-byte ; inline + +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 write-header + len 16 /mod + [ [ 16 * dup 16 + bytes write-hex-line ] each-integer ] + [ [ len swap - len bytes write-hex-line ] unless-zero ] bi* ; + +: hexdump-stream ( stream -- ) + reset-line# + [ stream-length write-header ] + [ [ all-bytes write-hex-line ] 16 (each-stream-block) ] bi ; PRIVATE> GENERIC: hexdump. ( byte-array -- ) -M: byte-array hexdump. hexdump-bytes ; +M: byte-array hexdump. all-bytes hexdump-bytes ; -M: byte-vector hexdump. hexdump-bytes ; +M: byte-vector hexdump. all-bytes underlying>> hexdump-bytes ; : hexdump ( byte-array -- str ) [ hexdump. ] with-string-writer ; : hexdump-file ( path -- ) - binary file-contents hexdump. ; + binary [ hexdump-stream ] with-disposal ; : hexdump-main ( -- ) command-line get [ input-stream get dup decoder? [ stream>> ] when - stream-contents* hexdump. + hexdump-stream ] [ [ hexdump-file ] each ] if-empty ;