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

Last change on this file since 35338 was 35338, checked in by Kon Lovett, 3 years ago

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