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