~aghuloum/scheme-libraries/r6rs-hexdump

« back to all changes in this revision

Viewing changes to hexdump.ss

  • Committer: Abdulaziz Ghuloum
  • Date: 2008-02-27 06:40:33 UTC
  • Revision ID: aghuloum@cs.indiana.edu-20080227064033-2wq0mpszr0zvur2w
added documentation and license.

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
;;; Software License Agreement (BSD License)
 
2
;;; 
 
3
;;; Copyright (c) 2008, Abdulaziz Ghuloum.
 
4
;;; All rights reserved.
 
5
;;; 
 
6
;;; Redistribution and use of this software in source and binary forms,
 
7
;;; with or without modification, are permitted provided that the
 
8
;;; following conditions are met:
 
9
;;; 
 
10
;;; - Redistributions of source code must retain the above copyright
 
11
;;;   notice, this list of conditions and the following disclaimer.
 
12
;;; 
 
13
;;; - Redistributions in binary form must reproduce the above copyright
 
14
;;;   notice, this list of conditions and the following disclaimer in
 
15
;;;   the documentation and/or other materials provided with the
 
16
;;;   distribution.
 
17
;;; 
 
18
;;; - The name of the author may not be used to endorse or promote
 
19
;;;   products derived from this software without specific prior written
 
20
;;;   permission from the author.
 
21
;;; 
 
22
;;; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 
23
;;; "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 
24
;;; LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
 
25
;;; FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
 
26
;;; COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
 
27
;;; INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
 
28
;;; BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
 
29
;;; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
 
30
;;; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
 
31
;;; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
 
32
;;; ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 
33
;;; POSSIBILITY OF SUCH DAMAGE.
 
34
 
 
35
;;;
 
36
;;; hexdump utility for R6RS Scheme.
 
37
;;;
 
38
;;; 
 
39
;;; Usage:
 
40
;;;  (import (hexdump))
 
41
;;;  
 
42
;;;  (hexdump bytevector)
 
43
;;;    dumps all bytes in bytevector
 
44
;;;
 
45
;;;  (hexdump bytevector start-index) 
 
46
;;;    dumps bytevector from start-index to the end of the bytevector
 
47
;;;
 
48
;;;  (hexdump bytevector start-index count)
 
49
;;;    dumps count bytes bytevector starting from start-index
 
50
;;;
1
51
 
2
52
(library (hexdump)
3
53
  (export hexdump)
7
57
 
8
58
  (define hex-string "0123456789ABCDEF")
9
59
 
 
60
  (define D display)
 
61
 
10
62
  (define (dump-hex-bytes i n)
11
63
    (unless (= n 0) 
12
64
      (dump-hex-bytes (div i 16) (- n 1))
13
 
      (display (string-ref hex-string (mod i 16)))))
 
65
      (D (string-ref hex-string (mod i 16)))))
14
66
 
15
67
  (define (dump-line-number i)
16
 
    (display "0x")
 
68
    (D "0x")
17
69
    (dump-hex-bytes i 8)
18
 
    (display " "))
 
70
    (D " "))
19
71
 
20
72
  (define (dump-data bv i j)
21
73
    (unless (= i j) 
22
 
      (display " ")
 
74
      (D " ")
23
75
      (dump-hex-bytes (bytevector-u8-ref bv i) 2)
24
76
      (dump-data bv (+ i 1) j)))
25
77
 
28
80
      (let ([n (bytevector-u8-ref bv i)])
29
81
        (cond
30
82
          [(<= (char->integer #\!) n (char->integer #\~))
31
 
           (display (integer->char n))]
32
 
          [else (display ".")]))
 
83
           (D (integer->char n))]
 
84
          [else (D ".")]))
33
85
      (dump-chars bv (+ i 1) j)))
34
86
 
35
87
  (define (dump-empty n)
36
88
    (unless (zero? n)
37
 
      (display " ")
 
89
      (D " ")
38
90
      (dump-empty (- n 1))))
39
91
 
40
92
  (define (dump-line bv i k)
43
95
      (let ([m (min j k)])
44
96
        (dump-data bv i m)
45
97
        (dump-empty (* (- j m) 3))
46
 
        (display " | ")
 
98
        (D " | ")
47
99
        (dump-chars bv i m)
48
100
        (dump-empty (- j m))
49
 
        (display " |\n")
 
101
        (D " |\n")
50
102
        m)))
51
103
 
52
104
  (define (dump bv i j)