|
1 unit Adler32; |
|
2 |
|
3 {ZLib - Adler32 checksum function} |
|
4 |
|
5 |
|
6 interface |
|
7 |
|
8 (************************************************************************* |
|
9 |
|
10 DESCRIPTION : ZLib - Adler32 checksum function |
|
11 |
|
12 REQUIREMENTS : TP5-7, D1-D7/D9-D10/D12, FPC, VP |
|
13 |
|
14 EXTERNAL DATA : --- |
|
15 |
|
16 MEMORY USAGE : --- |
|
17 |
|
18 DISPLAY MODE : --- |
|
19 |
|
20 REFERENCES : RFC 1950 (http://tools.ietf.org/html/rfc1950) |
|
21 |
|
22 |
|
23 Version Date Author Modification |
|
24 ------- -------- ------- ------------------------------------------ |
|
25 0.10 30.08.03 W.Ehrhardt Initial version based on MD5 layout |
|
26 2.10 30.08.03 we Common vers., XL versions for Win32 |
|
27 2.20 27.09.03 we FPC/go32v2 |
|
28 2.30 05.10.03 we STD.INC, TP5.0 |
|
29 2.40 10.10.03 we common version, english comments |
|
30 3.00 01.12.03 we Common version 3.0 |
|
31 3.01 22.05.05 we Adler32UpdateXL (i,n: integer) |
|
32 3.02 17.12.05 we Force $I- in Adler32File |
|
33 3.03 07.08.06 we $ifdef BIT32: (const fname: shortstring...) |
|
34 3.04 10.02.07 we Adler32File: no eof, XL and filemode via $ifdef |
|
35 3.05 04.07.07 we BASM16: speed-up factor 15 |
|
36 3.06 12.11.08 we uses BTypes, Ptr2Inc and/or Str255 |
|
37 3.07 25.04.09 we updated RFC URL(s) |
|
38 3.08 19.07.09 we D12 fix: assign with typecast string(fname) |
|
39 **************************************************************************) |
|
40 |
|
41 (*------------------------------------------------------------------------- |
|
42 (C) Copyright 2002-2009 Wolfgang Ehrhardt |
|
43 |
|
44 This software is provided 'as-is', without any express or implied warranty. |
|
45 In no event will the authors be held liable for any damages arising from |
|
46 the use of this software. |
|
47 |
|
48 Permission is granted to anyone to use this software for any purpose, |
|
49 including commercial applications, and to alter it and redistribute it |
|
50 freely, subject to the following restrictions: |
|
51 |
|
52 1. The origin of this software must not be misrepresented; you must not |
|
53 claim that you wrote the original software. If you use this software in |
|
54 a product, an acknowledgment in the product documentation would be |
|
55 appreciated but is not required. |
|
56 |
|
57 2. Altered source versions must be plainly marked as such, and must not be |
|
58 misrepresented as being the original software. |
|
59 |
|
60 3. This notice may not be removed or altered from any source distribution. |
|
61 ----------------------------------------------------------------------------*) |
|
62 |
|
63 (* |
|
64 As per the license above, noting that this implementation of adler32 was stripped of everything we didn't need. |
|
65 That means no btypes, file loading, and the assembly version disabled. |
|
66 *) |
|
67 |
|
68 procedure Adler32Update(var adler: longint; Msg: pointer; Len: longint); |
|
69 |
|
70 implementation |
|
71 |
|
72 (* |
|
73 $ifdef BASM16 |
|
74 |
|
75 procedure Adler32Update(var adler: longint; Msg: pointer; Len: longint); |
|
76 //-update Adler32 with Msg data |
|
77 const |
|
78 BASE = 65521; // max. prime < 65536 |
|
79 NMAX = 5552; // max. n with 255n(n+1)/2 + (n+1)(BASE-1) < 2^32 |
|
80 type |
|
81 LH = packed record |
|
82 L,H: word; |
|
83 end; |
|
84 var |
|
85 s1,s2: longint; |
|
86 n: integer; |
|
87 begin |
|
88 s1 := LH(adler).L; |
|
89 s2 := LH(adler).H; |
|
90 while Len > 0 do begin |
|
91 if Len<NMAX then n := Len else n := NMAX; |
|
92 //BASM increases speed from about 52 cyc/byte to about 3.7 cyc/byte |
|
93 asm |
|
94 mov cx,[n] |
|
95 db $66; mov ax,word ptr [s1] |
|
96 db $66; mov di,word ptr [s2] |
|
97 les si,[msg] |
|
98 @@1: db $66, $26, $0f, $b6, $1c // movzx ebx,es:[si] |
|
99 inc si |
|
100 db $66; add ax,bx // inc(s1, pByte(Msg)^) |
|
101 db $66; add di,ax // inc(s2, s1 |
|
102 dec cx |
|
103 jnz @@1 |
|
104 db $66; sub cx,cx |
|
105 mov cx,BASE |
|
106 db $66; sub dx,dx |
|
107 db $66; div cx |
|
108 db $66; mov word ptr [s1],dx // s1 := s1 mod BASE |
|
109 db $66; sub dx,dx |
|
110 db $66; mov ax,di |
|
111 db $66; div cx |
|
112 db $66; mov word ptr [s2],dx // s2 := s2 mod BASE |
|
113 mov word ptr [msg],si // save offset for next chunk |
|
114 end; |
|
115 dec(len, n); |
|
116 end; |
|
117 LH(adler).L := word(s1); |
|
118 LH(adler).H := word(s2); |
|
119 end; |
|
120 *) |
|
121 |
|
122 procedure Adler32Update(var adler: longint; Msg: pointer; Len: longint); |
|
123 {-update Adler32 with Msg data} |
|
124 const |
|
125 BASE = 65521; {max. prime < 65536 } |
|
126 NMAX = 3854; {max. n with 255n(n+1)/2 + (n+1)(BASE-1) < 2^31} |
|
127 type |
|
128 LH = packed record |
|
129 L,H: word; |
|
130 end; |
|
131 var |
|
132 s1,s2: longint; |
|
133 i,n: integer; |
|
134 begin |
|
135 s1 := LH(adler).L; |
|
136 s2 := LH(adler).H; |
|
137 while Len > 0 do begin |
|
138 if Len<NMAX then n := Len else n := NMAX; |
|
139 for i:=1 to n do begin |
|
140 inc(s1, pByte(Msg)^); |
|
141 inc(Msg); |
|
142 inc(s2, s1); |
|
143 end; |
|
144 s1 := s1 mod BASE; |
|
145 s2 := s2 mod BASE; |
|
146 dec(len, n); |
|
147 end; |
|
148 LH(adler).L := word(s1); |
|
149 LH(adler).H := word(s2); |
|
150 end; |
|
151 |
|
152 end. |