1 program T_CTab64;
2 
3 {$i STD.INC}
4 
5 {$ifdef APPCONS}
6   {$apptype console}
7 {$endif}
8 
9 {$ifndef HAS_INT64}
10   error('No int64');
11 {$endif}
12 
13 
14 (*************************************************************************
15 
16  DESCRIPTION     :  Calculate CRC64 table for
17 
18                     x^64 + x^62 + x^57 + x^55 + x^54 + x^53 + x^52 + x^47 +
19                     x^46 + x^45 + x^40 + x^39 + x^38 + x^37 + x^35 + x^33 +
20                     x^32 + x^31 + x^29 + x^27 + x^24 + x^23 + x^22 + x^21 +
21                     x^19 + x^17 + x^13 + x^12 + x^10 + x^9  + x^7  + x^4  +
22                     x^1  + 1
23 
24  REQUIREMENTS    :  D4-D6, FPC
25 
26  EXTERNAL DATA   :  ---
27 
28  MEMORY USAGE    :  ---
29 
30  DISPLAY MODE    :  ---
31 
32  REFERENCES      :  ----
33 
34 
35  Version  Date      Author      Modification
36  -------  --------  -------     ------------------------------------------
37  1.00     31.08.03  we          Init. version for D6
38  1.01     13.09.03  we          For D4,D5,FPC
39 **************************************************************************)
40 
41 (*-------------------------------------------------------------------------
42  (C) Copyright 2002-2004 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 {$ifdef UNIT_SCOPE}
64 uses
65   System.SysUtils;
66 {$else}
67 uses
68   SysUtils;
69 {$endif}
70 
71 
72 {---------------------------------------------------------------------------}
73 procedure getPoly(var poly: int64);
74 var
75   x: int64;
76 begin
77   x := 1;
78   writeln('x^64 + x^62 + x^57 + x^55 + x^54 + x^53 + x^52 + x^47 + x^46 + x^45 +');
79   writeln('x^40 + x^39 + x^38 + x^37 + x^35 + x^33 + x^32 + x^31 + x^29 + x^27 +');
80   writeln('x^24 + x^23 + x^22 + x^21 + x^19 + x^17 + x^13 + x^12 + x^10 + x^9  +');
81   writeln('x^7  + x^4  + x^1  + 1');
82   poly := {x shl 64}+ x shl 62 + x shl 57 + x shl 55 + x shl 54 + x shl 53 + x shl 52 + x shl 47 + x shl 46 + x shl 45 +
83            x shl 40 + x shl 39 + x shl 38 + x shl 37 + x shl 35 + x shl 33 + x shl 32 + x shl 31 + x shl 29 + x shl 27 +
84            x shl 24 + x shl 23 + x shl 22 + x shl 21 + x shl 19 + x shl 17 + x shl 13 + x shl 12 + x shl 10 + x shl  9 +
85            x shl  7 + x shl 4 +  x shl  1 + 1;
86 
87   writeln;
88   writeln;
89   writeln;
90   writeln('const');
91   writeln('  PolyLo : longint = longint($', IntToHex(Poly and $FFFFFFFF, 8), ');');
92   writeln('  PolyHi : longint = longint($', IntToHex(Poly shr 32, 8), ');');
93   writeln;
94 end;
95 
96 
97 {---------------------------------------------------------------------------}
98 procedure CalcTable(const poly: int64);
99 var
100   NTab: array[0..255] of int64;
101   i,b: integer;
102   c64: int64;
103 begin
104   for i:=0 to 255 do begin
105     c64 := int64(i) shl 56;
106     for b:=1 to 8 do begin
107      if c64<0 then c64 := (c64 shl 1) xor Poly else c64 := c64 shl 1;
108     end;
109     NTab[i] := c64;
110   end;
111   writeln;
112   writeln('const');
113   writeln('  Tab64Lo : array[0..255] of longint = (');
114   write('':4);
115   for i:=0 to 255 do begin
116     write('$',IntToHex(NTab[i] and $FFFFFFFF, 8));
117     if i=255 then writeln(');')
118     else begin
119       write(',');
120       if i and 7 = 7 then begin
121         writeln;
122         write('':4);
123       end;
124     end;
125   end;
126   writeln;
127   writeln('const');
128   writeln('  Tab64Hi : array[0..255] of longint = (');
129   write('':4);
130   for i:=0 to 255 do begin
131     write('$',IntToHex((NTab[i] shr 32) and $FFFFFFFF, 8));
132     if i=255 then writeln(');')
133     else begin
134       write(',');
135       if i and 7 = 7 then begin
136         writeln;
137         write('':4);
138       end;
139     end;
140   end;
141   writeln;
142 end;
143 
144 var
145   Poly: int64;
146 begin
147   writeln('T_CTab64 - CRC64 table calculation     (c) 2002-2004 W.Ehrhardt');
148   writeln;
149   writeln('Calculate CRC64 tables for polynomial:');
150   writeln;
151   GetPoly(Poly);
152   CalcTable(Poly);
153   {$ifdef D4Plus}
154     if DebugHook<>0 then readln;
155   {$endif}
156 end.
157