basis/tools/hexdump/hexdump.factor

   1 ! Copyright (C) 2008 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3
   4 USING: accessors ascii byte-arrays byte-vectors combinators
   5 command-line destructors fry io io.encodings io.encodings.binary
   6 io.encodings.string io.encodings.utf8 io.files io.streams.string
   7 kernel literals locals math math.parser namespaces sequences
   8 sequences.private strings typed ;
   9
  10 IN: tools.hexdump
  11
  12 <PRIVATE
  13
  14 CONSTANT: line# "00000000  "
  15
  16 : inc-line# ( -- )
  17     7 [ CHAR: 0 = over 0 > and ] [
  18         1 - dup line# [
  19             {
  20                 { CHAR: 9 [ CHAR: a ] }
  21                 { CHAR: f [ CHAR: 0 ] }
  22                 [ 1 + ]
  23             } case dup
  24         ] change-nth-unsafe
  25     ] do while drop ;
  26
  27 : reset-line# ( -- )
  28     8 [ CHAR: 0 swap line# set-nth ] each-integer ;
  29
  30 CONSTANT: hex-digits $[
  31     256 <iota> [ >hex 2 CHAR: 0 pad-head " " append ] map
  32 ]
  33
  34 : all-bytes ( bytes -- from to bytes )
  35     [ 0 swap length ] keep ; inline
  36
  37 : each-byte ( from to bytes quot: ( elt -- ) -- )
  38     '[ _ nth-unsafe @ ] (each-integer) ; inline
  39
  40 : write-bytes ( from to bytes stream -- )
  41     '[ hex-digits nth-unsafe _ stream-write ] each-byte ; inline
  42
  43 : write-space ( from to bytes stream -- )
  44     [ drop - 16 + ] dip '[
  45         3 * CHAR: \s <string> _ stream-write
  46     ] unless-zero ; inline
  47
  48 : write-ascii ( from to bytes stream -- )
  49     dup stream-bl '[
  50         [ printable? ] keep CHAR: . ? _ stream-write1
  51     ] each-byte ; inline
  52
  53 TYPED: write-hex-line ( from: fixnum to: fixnum bytes: byte-array -- )
  54     line# write inc-line# output-stream get {
  55         [ write-bytes ]
  56         [ write-space ]
  57         [ write-ascii ]
  58     } 4cleave nl ;
  59
  60 :: hexdump-bytes ( from to bytes -- )
  61     reset-line#
  62     to from - :> len
  63     len 16 /mod
  64     [ [ 16 * dup 16 + bytes write-hex-line ] each-integer ]
  65     [ [ len swap - len bytes write-hex-line ] unless-zero ] bi*
  66     len >hex 8 CHAR: 0 pad-head print ;
  67
  68 : hexdump-stream ( stream -- )
  69     reset-line# 0 swap [
  70         all-bytes [ write-hex-line ] [ length + ] bi
  71     ] 16 (each-stream-block) >hex 8 CHAR: 0 pad-head print ;
  72
  73 PRIVATE>
  74
  75 GENERIC: hexdump. ( byte-array -- )
  76
  77 M: byte-array hexdump. all-bytes hexdump-bytes ;
  78
  79 M: byte-vector hexdump. all-bytes underlying>> hexdump-bytes ;
  80
  81 M: string hexdump. utf8 encode hexdump. ;
  82
  83
  84 : hexdump ( byte-array -- str )
  85     [ hexdump. ] with-string-writer ;
  86
  87 : hexdump-file ( path -- )
  88     binary <file-reader> [ hexdump-stream ] with-disposal ;
  89
  90 : hexdump-main ( -- )
  91     command-line get [
  92         input-stream get binary re-decode hexdump-stream
  93     ] [
  94         [ hexdump-file ] each
  95     ] if-empty ;
  96
  97 MAIN: hexdump-main