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

Last change on this file since 35339 was 35339, checked in by kon, 12 months ago

add define-types include, add types, reflow
File size: 4.8 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(use
29  (only type-checks
30    check-integer check-char)
31  (only type-errors
32    error-argument-type)
33  message-digest-type
34  message-digest-support
35  blob-set-int
36  typed-define)
37
38;;; Support
39
40;;
41
42(include "message-digest-types")
43
44;;
45
46(define: (get-byte-order (loc symbol) (obj *)) --> symbol
47  (case obj
48        ((big-endian be big msb)                                'big-endian )
49        ((little-endian le little lsb)  'little-endian )
50    (else
51        (error-argument-type loc obj "symbol in {big-endian little-endian}" obj) ) ) )
52
53;;
54
55(define: (*message-digest-update-uint (loc symbol) (md message-digest) (n number) (size fixnum) (setter procedure)) -> void
56  (let (
57    (blb (setup-message-digest-buffer! (check-message-digest loc md) size)) )
58        (setter blb (check-integer loc n) 0)
59        (*message-digest-update-blob md blb size) ) )
60
61;;; Char & Integer Update
62
63;; Char
64
65(define: (message-digest-update-char-u8 (md message-digest) (ch char)) -> void
66        (*message-digest-update-uint 'message-digest-update-char-u8
67          md
68          (char->integer (check-char 'message-digest-update-char-u8 ch))
69          1
70          *blob-set-u8!) )
71
72(define: (message-digest-update-char-be (md message-digest) (ch char)) -> void
73        (*message-digest-update-uint 'message-digest-update-char-be
74          md
75          (char->integer (check-char 'message-digest-update-char ch))
76          4
77          *blob-set-u32-be!) )
78
79(define: (message-digest-update-char-le (md message-digest) (ch char)) -> void
80        (*message-digest-update-uint 'message-digest-update-char-le
81          md
82          (char->integer (check-char 'message-digest-update-char ch))
83          4
84          *blob-set-u32-le!) )
85
86;; Unsigned Integer 8, 16, 32, & 64 bits
87
88(define: (message-digest-update-u8 (md message-digest) (n number)) -> void
89        (*message-digest-update-uint 'message-digest-update-u8 md n 1 *blob-set-u8!) )
90
91(define: (message-digest-update-u16-be (md message-digest) (n number)) -> void
92        (*message-digest-update-uint 'message-digest-update-u16-be md n 2 *blob-set-u16-be!) )
93
94(define: (message-digest-update-u16-le (md message-digest) (n number)) -> void
95        (*message-digest-update-uint 'message-digest-update-u16-le md n 2 *blob-set-u16-le!) )
96
97(define: (message-digest-update-u32-be (md message-digest) (n number)) -> void
98        (*message-digest-update-uint 'message-digest-update-u32-be md n 4 *blob-set-u32-be!) )
99
100(define: (message-digest-update-u32-le (md message-digest) (n number)) -> void
101        (*message-digest-update-uint 'message-digest-update-u32-le md n 4 *blob-set-u32-le!) )
102
103(define: (message-digest-update-u64-be (md message-digest) (n number)) -> void
104        (*message-digest-update-uint 'message-digest-update-u64-be md n 8 *blob-set-u64-be!) )
105
106(define: (message-digest-update-u64-le (md message-digest) (n number)) -> void
107        (*message-digest-update-uint 'message-digest-update-u64-le md n 8 *blob-set-u64-le!) )
108
109;; Machine Byte Order w/ Char & Unsigned Integer
110
111(define: (message-digest-update-char (md message-digest) (ch char) . (opts (list-of symbol))) -> void
112  (let (
113    (order (optional opts (machine-byte-order))) )
114    (case (get-byte-order 'message-digest-update-char order)
115      ((little-endian)  (message-digest-update-char-le md ch) )
116      ((big-endian)                     (message-digest-update-char-be md ch) ) ) ) )
117
118(define: (message-digest-update-u16 (md message-digest) (n number) . (opts (list-of symbol))) -> void
119  (let (
120    (order (optional opts (machine-byte-order))) )
121    (case (get-byte-order 'message-digest-update-u16 order)
122      ((little-endian)  (message-digest-update-u16-le md n) )
123      ((big-endian)                     (message-digest-update-u16-be md n) ) ) ) )
124
125(define: (message-digest-update-u32 (md message-digest) (n number) . (opts (list-of symbol))) -> void
126  (let (
127    (order (optional opts (machine-byte-order))) )
128    (case (get-byte-order 'message-digest-update-u32 order)
129      ((little-endian)  (message-digest-update-u32-le md n) )
130      ((big-endian)                     (message-digest-update-u32-be md n) ) ) ) )
131
132(define: (message-digest-update-u64 (md message-digest) (n number) . (opts (list-of symbol))) -> void
133  (let (
134    (order (optional opts (machine-byte-order))) )
135    (case (get-byte-order 'message-digest-update-u64 order)
136      ((little-endian)  (message-digest-update-u64-le md n) )
137      ((big-endian)                     (message-digest-update-u64-be md n) ) ) ) )
138
139) ;module message-digest-int
Note: See TracBrowser for help on using the repository browser.