source: project/release/4/message-digest/trunk/message-digest-int.scm @ 35044

Last change on this file since 35044 was 35044, checked in by kon, 11 months ago

why did i care ?

File size: 4.0 KB
Line 
1;;;; message-digest-int.scm
2;;;; Kon Lovett, Jan '06 (message-digest.scm)
3;;;; Kon Lovett, May '10 (message-digest.scm)
4;;;; Kon Lovett, Apr '12
5;;;; Kon Lovett, Aug '17
6
7;; Issues
8
9(module message-digest-int
10
11(;export
12  message-digest-update-char-u8
13  message-digest-update-char
14  message-digest-update-char-be
15  message-digest-update-char-le
16  message-digest-update-u8
17  message-digest-update-u16
18  message-digest-update-u16-be
19  message-digest-update-u16-le
20  message-digest-update-u32
21  message-digest-update-u32-be
22  message-digest-update-u32-le
23  message-digest-update-u64
24  message-digest-update-u64-be
25  message-digest-update-u64-le)
26
27(import scheme chicken)
28
29(use
30  (only type-checks
31    check-integer check-char)
32  (only type-errors
33    error-argument-type)
34  message-digest-type
35  message-digest-support
36  blob-set-int)
37
38;;; Support
39;;
40
41(define (get-byte-order loc obj)
42  (case obj
43        ((big-endian be big msb)                                'big-endian )
44        ((little-endian le little lsb)  'little-endian )
45    (else
46        (error-argument-type loc obj "symbol in {big-endian little-endian}" obj) ) ) )
47
48;;
49
50(define (*message-digest-update-uint loc md n size setter)
51  (let ((blb (setup-message-digest-buffer! (check-message-digest loc md) size)))
52        (setter blb (check-integer loc n) 0)
53        (*message-digest-update-blob md blb size) ) )
54
55;;; Char & Integer Update
56
57;; Char
58
59(define (message-digest-update-char-u8 md ch)
60        (*message-digest-update-uint
61          'message-digest-update-char-u8
62          md
63          (char->integer (check-char 'message-digest-update-char-u8 ch))
64          1
65          *blob-set-u8!) )
66
67(define (message-digest-update-char-be md ch)
68        (*message-digest-update-uint
69          'message-digest-update-char-be
70          md
71          (char->integer (check-char 'message-digest-update-char ch))
72          4
73          *blob-set-u32-be!) )
74
75(define (message-digest-update-char-le md ch)
76        (*message-digest-update-uint
77          'message-digest-update-char-le
78          md
79          (char->integer (check-char 'message-digest-update-char ch))
80          4
81          *blob-set-u32-le!) )
82
83;; Unsigned Integer 8, 16, 32, & 64 bits
84
85(define (message-digest-update-u8 md n)
86        (*message-digest-update-uint 'message-digest-update-u8 md n 1 *blob-set-u8!) )
87
88(define (message-digest-update-u16-be md n)
89        (*message-digest-update-uint 'message-digest-update-u16-be md n 2 *blob-set-u16-be!) )
90
91(define (message-digest-update-u16-le md n)
92        (*message-digest-update-uint 'message-digest-update-u16-le md n 2 *blob-set-u16-le!) )
93
94(define (message-digest-update-u32-be md n)
95        (*message-digest-update-uint 'message-digest-update-u32-be md n 4 *blob-set-u32-be!) )
96
97(define (message-digest-update-u32-le md n)
98        (*message-digest-update-uint 'message-digest-update-u32-le md n 4 *blob-set-u32-le!) )
99
100(define (message-digest-update-u64-be md n)
101        (*message-digest-update-uint 'message-digest-update-u64-be md n 8 *blob-set-u64-be!) )
102
103(define (message-digest-update-u64-le md n)
104        (*message-digest-update-uint 'message-digest-update-u64-le md n 8 *blob-set-u64-le!) )
105
106;; Machine Byte Order w/ Char & Unsigned Integer
107
108(define (message-digest-update-char md ch #!optional (order (machine-byte-order)))
109        (case (get-byte-order 'message-digest-update-char order)
110                ((little-endian)        (message-digest-update-char-le md ch) )
111                ((big-endian)                   (message-digest-update-char-be md ch) ) ) )
112
113(define (message-digest-update-u16 md n #!optional (order (machine-byte-order)))
114        (case (get-byte-order 'message-digest-update-u16 order)
115                ((little-endian)        (message-digest-update-u16-le md n) )
116                ((big-endian)                   (message-digest-update-u16-be md n) ) ) )
117
118(define (message-digest-update-u32 md n #!optional (order (machine-byte-order)))
119        (case (get-byte-order 'message-digest-update-u32 order)
120                ((little-endian)        (message-digest-update-u32-le md n) )
121                ((big-endian)                   (message-digest-update-u32-be md n) ) ) )
122
123(define (message-digest-update-u64 md n #!optional (order (machine-byte-order)))
124        (case (get-byte-order 'message-digest-update-u64 order)
125                ((little-endian)        (message-digest-update-u64-le md n) )
126                ((big-endian)                   (message-digest-update-u64-be md n) ) ) )
127
128) ;module message-digest-int
Note: See TracBrowser for help on using the repository browser.