Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/MiscUtil/library/crc.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/MiscUtil/library/crc.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 496 - (view) (download)

1 : monnier 496 (* crc.sml
2 :     *
3 :     * COPYRIGHT (c) 1994 AT&T Bell Laboratories.
4 :     *)
5 :    
6 :     signature CRC =
7 :     sig
8 :     type crc
9 :     val zero: crc
10 :     val append : crc * char -> crc
11 :     val N : int (* size, in bytes, of CRC strings *)
12 :     val fromString : string -> crc (* computes the CRC of a string *)
13 :     val toString: crc -> string
14 :     (* Axiom: fromString(toString(x)) = x *)
15 :     val compare : crc * crc -> order
16 :     val combine: crc list ->crc
17 :     val hashToInt: crc -> int
18 :     val * : crc * crc -> crc
19 :     val + : crc * crc -> crc
20 :     (* 0 <= hashToInt N c < N *)
21 :    
22 :     val suffix: {start: crc, finish: crc, length: int} -> crc
23 :    
24 :     (* Suffix allows you to compute CRC of the string B
25 :     when you already know the CRC's of A and AB
26 :    
27 :     For any strings a,b, test(a,b) = true
28 :     fun test(a,b) =
29 :     let fun crcstring(start,a) =
30 :     foldr (fn(x,y)=>CRC.append(y,x)) start (explode a)
31 :     val x = crcstring(CRC.zero,a)
32 :     val y = crcstring(x,b)
33 :     val z = crcstring(CRC.zero,b)
34 :     val z' = CRC.suffix{start=x,finish=y,length=size b}
35 :     in CRC.toString z = CRC.toString z'
36 :     end
37 :    
38 :     For a hash-consing application, I want to know the CRC of a string b
39 :     knowing only:
40 :    
41 :     X = CRC of a
42 :     Y = CRC of a^b
43 :     N = size of b (in bytes)
44 :    
45 :     The CRC of a string s is really a polynomial in the field ZF(2):
46 :    
47 :     ( Sum_i (s[i] * x^i) ) mod P
48 :    
49 :     where s[i] is the i'th bit of the string and P is a primitive polynomial;
50 :    
51 :     then we can compute Z = CRC of b as follows:
52 :    
53 :     Z = (X * x^(8N) + Y) mod P
54 :    
55 :     where addition (+) is in the field of polynomials over ZF(2).
56 :    
57 :     Let's define this operation as suffix{start=X,finish=Y,length=N}
58 :     and we can do it in constant time (though the constant depends on the
59 :     size of the polynomial P).
60 :    
61 :     *)
62 :    
63 :    
64 :    
65 :     end
66 :    
67 :     structure CRC :> CRC =
68 :     struct
69 :    
70 :     val wtoi = Word.toIntX
71 :     val itow = Word.fromInt
72 :    
73 :     (* 128-bit CRC.
74 :     * The call `append crc c' corresponds to eight steps of a shift register
75 :     * circuit, shifting in one bit of character c from the left in each step.
76 :     * See Figure 2.16 in Bertsekas and Gallager: Data Networks (1987),
77 :     * or Figure 3-32 in Siewiorek and Swarz: The Theory and Practice
78 :     * of Reliable System Design (Digital Press, 1982).
79 :     *)
80 :    
81 :     type crc = {high: int list, low: int list, lowest: int}
82 :     (* Invariant: size(high @ rev low @ [lowest]) = 16 *)
83 :    
84 :     (* The prime generator polynomial is 1 + x + x^2 + x^7 + x^128.
85 :     * Reversing the low coefficient bits we have 1110.0001 = 225
86 :     *)
87 :     val poly = 0w225
88 :    
89 :     val table : int Vector.vector =
90 :     let
91 :     fun init n = let
92 :     fun f (0w0,_,r) = wtoi r
93 :     | f (i,p,r) = if Word.andb(i,0w1)<>0w0
94 :     then f(Word.>>(i,0w1),p+p,Word.xorb(p,r))
95 :     else f(Word.>>(i,0w1),p+p,r)
96 :     in
97 :     f(itow n,poly,0w0)
98 :     end
99 :     in
100 :     Vector.tabulate(256, init)
101 :     end
102 :    
103 :     val N = 16
104 :    
105 :     val zero = {high=[0,0,0,0,0,0,0,0,0,0,0,0,0,0],low=[0],lowest=0}
106 :    
107 :     fun toString{high,low,lowest} = implode(map chr (high @ rev low @ [lowest]))
108 :    
109 :     fun append'({high=0::high', low, lowest}, c) =
110 :     {high=high',low=lowest::low,lowest=c}
111 :     | append'({high=h::high', low, lowest}, c) =
112 :     let val hilo = Vector.sub(table, h)
113 :     val hi = Word.>>(itow hilo,0w8)
114 :     val lo = Word.andb(itow hilo,0w255)
115 :     in {high=high', low= wtoi(Word.xorb(itow lowest,hi)) :: low,
116 :     lowest=wtoi(Word.xorb(itow c, lo))}
117 :     end
118 :     | append'({high=nil, low, lowest}, c) =
119 :     append'({high=rev low, low=nil, lowest=lowest}, c)
120 :    
121 :     fun append(crc, c) = append'(crc, ord c)
122 :    
123 :     val z14 = [0,0,0,0,0,0,0,0,0,0,0,0,0,0]
124 :    
125 :     fun fromString s =
126 :     let fun get i = ord(String.sub(s,i))
127 :     fun loop(high,i) = if i=0 then high
128 :     else let val i' = i-1
129 :     in loop((get i')::high,i')
130 :     end
131 :     val len = size s
132 :     in if len >= 16
133 :     then let val crc0 = {high=loop(nil,14),low=[get 14],lowest=get 15}
134 :     fun aloop(crc,i) = if i = len
135 :     then crc else aloop(append'(crc,get i),i+1)
136 :     in aloop(crc0,16)
137 :     end
138 :     else if len > 2
139 :     then let fun zloop(high,0) = high
140 :     | zloop(high,n) = zloop(0::high, n-1)
141 :     in {high=zloop(loop(nil,len-2),16-len),low=[get(len-2)],
142 :     lowest=get(len-1)}
143 :     end
144 :     else if len=2
145 :     then {high=z14,low=[get(0)], lowest=get(1)}
146 :     else if len=1
147 :     then let val {high,low,...} = zero
148 :     in {high=high,low=low,lowest=get 0}
149 :     end
150 :     else zero
151 :    
152 :     end
153 :    
154 :     val one = append'(zero,1)
155 :    
156 :     fun map2w f = ListPair.map (fn (a, b) => wtoi (f (itow a, itow b)))
157 :    
158 :     fun xor({high=h1,low=l1,lowest=x1},
159 :     {high=h2,low=l2,lowest=x2}) =
160 :     {high=map2w Word.xorb (h1 @ rev l1, h2 @ rev l2),
161 :     low=nil, lowest=wtoi(Word.xorb(itow x1,itow x2))}
162 :    
163 :     (* buggy
164 :     fun prod1(x,y) =
165 :     let fun f(0,x,y,u) = u
166 :     | f(n,x,y,u) = let val odd = Bits.andb(y,1)
167 :     in f(n-1,Bits.lshift(x,1),Bits.rshift(y,1),
168 :     Bits.xorb(u,Bits.andb(~odd,y)))
169 :     end
170 :     in f(8,x,y,0)
171 :     end
172 :     *)
173 :    
174 :     fun prod1(x,0) = 0
175 :     | prod1(x,y) =
176 :     let val u = prod1(x, wtoi(Word.>>(itow y,0w1)))
177 :     val odd = wtoi(Word.andb(itow y,0w1))
178 :     in wtoi(Word.xorb(Word.<<(itow u,0w1),
179 :     Word.andb(itow x, itow(~odd))))
180 :     end
181 :    
182 :     fun product(crc1,crc2) =
183 :     let
184 :     fun expand crc =
185 :     (* list of bytes from low to high, dropping high zeros *)
186 :     let fun f({high=0::h',low,lowest},nil) =
187 :     f({high=h',low=low,lowest=lowest},nil)
188 :     | f({high=h::h',low,lowest},r) =
189 :     f({high=h',low=low,lowest=lowest},h::r)
190 :     | f({high=nil,low=nil,lowest=0},nil) = nil
191 :     | f({high=nil,low=nil,lowest},r) = lowest::r
192 :     | f({high=nil,low,lowest},r) =
193 :     f({high=rev low, low=nil,lowest=lowest},r)
194 :     in f(crc,nil)
195 :     end
196 :    
197 :     fun prodN(x, carry, lowest::rest) =
198 :     let val hilo= prod1(x,lowest)
199 :     val lo = Word.andb(itow hilo,0w255)
200 :     val hi = Word.>>(itow hilo,0w8)
201 :     in append'(prodN(x, wtoi hi, rest),
202 :     wtoi(Word.xorb(lo,itow carry)))
203 :     end
204 :     | prodN(x, carry, nil) = append'(zero, carry)
205 :    
206 :     fun prodNN(x::xx,yy) =
207 :     xor (prodN(x,0,yy), append'(prodNN(xx,yy), 0))
208 :     | prodNN(nil,yy) = zero
209 :    
210 :     in prodNN(expand crc1, expand crc2)
211 :     end
212 :    
213 :     val MAX = 64 (* such that the "length" argument to "suffix"
214 :     is never larger than 2^MAX *)
215 :    
216 :     val expsqr = let
217 :     fun loop(i,v::vl) =
218 :     if i<MAX then
219 :     (* precondition: v = append(one,zerostring(2^(i-1)))
220 :     * where zerostring(n) is a string of n null bytes
221 :     * postcondition: loop(i+1,append(one,zerostring(2^i))::v::vl)*)
222 :     loop(i+1, product(v,v)::v::vl)
223 :     else Vector.fromList(rev (v::vl))
224 :     | loop _ = raise Fail "CRC: internal error (expsqr)"
225 :     in
226 :     loop(1,[append'(one, 0)])
227 :     end
228 :    
229 :     fun odd(n) = Word.andb(itow n,0w1) <> 0w0
230 :    
231 :     fun shift(crc,n) =
232 :     let fun scan(i,accum) =
233 :     let val j = wtoi (Word.<<(0w1,itow i))
234 :     in if j>n then accum
235 :     else if Word.andb(itow j,itow n) <> 0w0
236 :     then scan(i+1,product(accum,Vector.sub(expsqr,i)))
237 :     else scan(i+1,accum)
238 :     end
239 :     in product(crc,scan(0,one))
240 :     end
241 :    
242 :     fun suffix{start, finish, length=n} = xor(shift(start,n), finish)
243 :    
244 :    
245 :     (*
246 :     fun hashToInt n {high,low,lowest} =
247 :     let fun hashbyte(b, accum) = (accum*256 + b) mod n
248 :     in accum(lowest,foldr hashbyte (foldl hashbyte 0 high) low)
249 :     end
250 :     *)
251 :     fun hashToInt {high,low,lowest} =
252 :     let val op * = Word32.* and op + = Word32.+
253 :     fun hashbyte(b, accum: Word32.word) =
254 :     (accum*0w65599 + Word32.fromInt b)
255 :     val h = hashbyte(lowest,foldr hashbyte (foldl hashbyte 0w0 high) low)
256 :     in Word32.toInt(Word32.>>(h * 0w65599,0w2))
257 :     end
258 :    
259 :    
260 :     fun compare({high=ah::ar,low=al,lowest=at},{high=bh::br,low=bl,lowest=bt})=
261 :     if ah<bh then
262 :     LESS else if (ah:int)>bh then GREATER
263 :     else compare({high=ar,low=al,lowest=at},{high=br,low=bl,lowest=bt})
264 :     | compare({high=nil,low=al as _::_,lowest=at},b) =
265 :     compare({high=rev al,low=nil,lowest=at},b)
266 :     | compare(a,{high=nil,low=bl as _::_,lowest=bt}) =
267 :     compare(a,{high=rev bl, low=nil,lowest=bt})
268 :     | compare({high=nil,low=nil,lowest=at},{high=nil,low=nil,lowest=bt}) =
269 :     if at<(bt:int) then LESS
270 :     else if at>bt then GREATER else EQUAL
271 :     | compare _ = raise Fail "CRC: internal error (compare)"
272 :    
273 :     (*
274 :     fun {high=ah::ar,low=al,lowest=at} < {high=bh::br,low=bl,lowest=bt} =
275 :     Int.<(ah,bh)
276 :     orelse ah=bh andalso
277 :     {high=ar,low=al,lowest=at} < {high=br,low=bl,lowest=bt}
278 :     | {high=nil,low=al as _::_,lowest=at} < b =
279 :     {high=rev al,low=nil,lowest=at} < b
280 :     | a < {high=nil,low=bl as _::_,lowest=bt} =
281 :     a < {high=rev bl, low=nil,lowest=bt}
282 :     | {high=nil,low=nil,lowest=at} < {high=nil,low=nil,lowest=bt} =
283 :     Int.<(at,bt)
284 :     *)
285 :     (* fun show crc = concat(map (fn c => Int.toString(ord c) ^ " ") (explode (toString crc)))
286 :     *)
287 :    
288 :     val A: Word32.word = 0wxff208489
289 :     and B: Word32.word = 0wxf4872e10
290 :     and C: Word32.word = 0wx402d619b
291 :     and D: Word32.word = 0wx0bf359a7
292 :    
293 :    
294 :     val perm = #[
295 :     255, 254, 252, 251, 250, 248, 240, 245, 246, 238, 237, 244, 7, 189,
296 :     214, 236, 235, 20, 33, 8, 227, 14, 233, 178, 172, 60, 229, 133, 152,
297 :     19, 210, 203, 221, 208, 76, 18, 13, 199, 113, 62, 40, 190, 213, 194,
298 :     43, 181, 21, 15, 201, 162, 90, 186, 71, 117, 107, 70, 191, 5, 173, 44,
299 :     39, 12, 174, 183, 99, 11, 176, 163, 161, 72, 86, 105, 2, 83, 42, 52,
300 :     179, 135, 103, 110, 151, 58, 108, 96, 166, 25, 115, 66, 142, 10, 141,
301 :     48, 104, 34, 159, 120, 22, 140, 64, 82, 78, 68, 207, 125, 123, 150,
302 :     144, 138, 128, 139, 136, 114, 119, 53, 148, 185, 41, 124, 216, 143,
303 :     49, 92, 98, 51, 112, 73, 50, 63, 16, 46, 158, 126, 206, 122, 94, 132,
304 :     88, 184, 28, 84, 127, 156, 167, 223, 118, 89, 116, 17, 111, 121, 109,
305 :     77, 146, 61, 224, 101, 81, 218, 97, 188, 243, 155, 57, 102, 54, 129,
306 :     93, 192, 153, 106, 36, 145, 79, 31, 137, 26, 67, 85, 175, 80, 168, 65,
307 :     91, 1, 147, 149, 6, 29, 37, 69, 182, 165, 4, 74, 55, 47, 171, 169, 75,
308 :     134, 193, 195, 198, 131, 38, 180, 56, 196, 23, 154, 177, 200, 205, 27,
309 :     209, 95, 204, 160, 3, 30, 157, 32, 9, 212, 211, 45, 202, 170, 0, 219,
310 :     187, 87, 35, 100, 217, 232, 164, 228, 220, 197, 231, 215, 226, 130,
311 :     225, 234, 241, 239, 59, 230, 247, 24, 249, 242, 222, 253 ]
312 :    
313 :    
314 :     fun combine [] = zero
315 :     | combine [crc] = crc
316 :     | combine (crc1::crcs) =
317 :     let fun expand{high,low,lowest} = lowest :: low @ rev high
318 :     fun mash(crc1,crc2) = foldr (fn (c,x)=>append'(x,c)) crc1 (expand crc2)
319 :     val x = foldr mash crc1 crcs
320 :    
321 :     fun w32(a::b::c::d::rest) =
322 :     (Word32.xorb(Word32.<<(Word32.fromInt d, 0w24),
323 :     Word32.xorb(Word32.<<(Word32.fromInt c, 0w16),
324 :     Word32.xorb(Word32.<<(Word32.fromInt b, 0w8),
325 :     Word32.fromInt a))),
326 :     rest)
327 :     | w32 _ = raise Fail "CRC: internal error (w32)"
328 :    
329 :     val (u0,r0) = w32 (expand x)
330 :     val (u1,r1) = w32 r0
331 :     val (u2,r2) = w32 r1
332 :     val (u3,r3) = w32 r2
333 :     val _ = case r3 of
334 :     [] => () | _ => raise Fail "CRC: internal error (w32 rest)"
335 :    
336 :     val v0 = Word32.+(Word32.*(u0,A),u1)
337 :     val v1 = Word32.+(Word32.*(u1,B),u2)
338 :     val v2 = Word32.+(Word32.*(u2,C),u3)
339 :     val v3 = Word32.+(Word32.*(u3,D),u0)
340 :    
341 :     fun byte(b,k) =
342 :     Vector.sub(perm,
343 :     Word32.toInt(Word32.andb(0w255,Word32.>>(b,Word.fromInt k))))
344 :     fun b32(n,rest) = byte(n,0) :: byte(n,8) :: byte(n,16) :: byte(n,24)
345 :     :: rest
346 :     val x' = b32(v3,b32(v2,b32(v1,b32(v0,nil))))
347 :     in
348 :     case x' of
349 :     y0 :: y1 :: y' => { high = y', low = [y1], lowest = y0 }
350 :     | _ => raise Fail "CRC: internal error (y0,y1,y')"
351 :     end
352 :    
353 :     val op * = product
354 :     val op + = xor
355 :     end
356 :     (*
357 :     structure Test =
358 :     struct
359 :    
360 :    
361 :     fun test(a,b) =
362 :     let fun crcstring(a) =
363 :     foldl (fn(x,y)=>CRC.append(y,x)) CRC.zero (explode a)
364 :     val zeros = crcstring(implode (chr 1 :: map (fn _ => chr 0) (explode b)))
365 :     val x = crcstring a
366 :     val y = crcstring b
367 :     val z = crcstring (a^b)
368 :     val z' = CRC.+(CRC.*(x,zeros),y)
369 :     in CRC.toString z = CRC.toString z'
370 :     end
371 :    
372 :     end
373 :     *)
374 :    

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0