1 {-Test Cyc/B and MB/s for CRC/HASH, we 2012-2017}
2 
3 program t_speeda;
4 
5 {$i STD.INC}
6 
7 {$ifdef APPCONS}
8   {$apptype console}
9 {$endif}
10 
11 
12 {$ifndef FPC}
13   {$B-,N+}
14 {$endif}
15 
16 {$ifdef BASM16}
17   {$i ALIGN.INC}
18 {$endif}
19 
20 
21 uses
22   {$ifdef WIN32or64}
23     {$ifdef UNIT_SCOPE}
24       winapi.windows,
25     {$else}
26       windows,
27     {$endif}
28   {$endif}
29   hrtimer,
30   {$ifdef WINCRT}
31     wincrt,
32   {$else}
33     crt,
34   {$endif}
35   hash,
36   whirl512,
37   adler32,
38   crc64,
39   sha1,
40   sha224,
41   sha256,
42   sha384,
43   sha512,
44   sha5_224,
45   sha5_256,
46   sha3_224,
47   sha3_256,
48   sha3_384,
49   sha3_512,
50   blaks224,
51   blaks256,
52   blakb384,
53   blakb512,
54   rmd160,
55   ED2K,
56   md4,
57   md5,
58   fcrc32,
59   crc32,
60   bjl3,
61   crc24,
62   crc16;
63 
64 const
65   NUMBYTES  = 50000;
66   NUMROUNDS = 20;
67   BYTECOUNT = NUMBYTES*NUMROUNDS;
68   MEGCOUNT  = BYTECOUNT/1E6;
69   DThresh   = 0.3;
70 
71 
72 {$ifndef BIT16}
73   MinRnd = 10;
74 {$else}
75   {$ifdef BASM16}
76     MinRnd = 10;
77   {$else}
78     MinRnd = 5;
79   {$endif}
80 {$endif}
81 
82 type
83   TCompArray = array[0..MinRnd] of comp;
84   TBuf  = array[1..NUMBYTES] of byte;
85   TTest = record
86             name : string[11];
87             adiff: TCompArray;
88             mdiff: double;
89             CpB  : double;
90             MBs  : double;
91             D100 : double;
92             done : boolean;
93           end;
94 
95 var
96   T_CRC16   : TTest;
97   T_CRC24   : TTest;
98   T_CRC32   : TTest;
99   T_FCRC32  : TTest;
100   T_bCRC32  : TTest;
101   T_Adler32 : TTest;
102   T_BJL3    : TTest;
103   T_BJDelphi: TTest;
104   T_CRC64   : TTest;
105   T_bCRC64  : TTest;
106   T_MD4     : TTest;
107   T_ED2K    : TTest;
108   T_MD5     : TTest;
109   T_SHA1    : TTest;
110   T_SHA224  : TTest;
111   T_SHA256  : TTest;
112   T_SHA384  : TTest;
113   T_SHA512  : TTest;
114   T_Whirl   : TTest;
115   T_RMD160  : TTest;
116   T_SHA5_224: TTest;
117   T_SHA5_256: TTest;
118   T_SHA3_224: TTest;
119   T_SHA3_256: TTest;
120   T_SHA3_384: TTest;
121   T_SHA3_512: TTest;
122   T_BLAKS224: TTest;
123   T_BLAKS256: TTest;
124   T_BLAKB384: TTest;
125   T_BLAKB512: TTest;
126   MaxD100   : double;
127   rnd       : integer;
128   start     : comp;
129   stop      : comp;
130   HR        : THRTimer;
131   pbuf      : ^TBuf;
132 
133 
134 {---------------------------------------------------------------------------}
135 procedure CalcStat(var Test: TTest);
136 var
137   sum,diff: comp;
138   sec,mean,delta,t: double;
139   i,n: integer;
140 begin
141 
142   if rnd=0 then Test.done := false;
143   if Test.done then exit;
144 
145   diff:= stop-start;
146   sec := diff/CPUFrequency;
147   i := rnd mod (MinRnd+1);
148   Test.adiff[i] := diff;
149   if rnd>MinRnd then n:=MinRnd else n:=rnd;
150 
151   sum := 0;
152   for i:=0 to n do sum := sum + Test.adiff[i];
153   mean := sum/(n+1);
154 
155   if rnd>0 then begin
156     delta := abs(mean-Test.adiff[0]);
157     for i:=1 to n do begin
158       t := abs(mean-Test.adiff[0]);
159       if t>delta then delta := t;
160     end;
161   end
162   else begin
163     delta := diff;
164   end;
165   {FPC3+ -O4 generates buggy code for Test.CpB := diff/BYTECOUNT;}
166   t := diff;
167   Test.CpB  := t/BYTECOUNT;
168   Test.MBs  := MEGCOUNT/sec;
169   Test.D100 := 100*delta/diff;
170   Test.done := (rnd>MinRnd) and (Test.D100<DThresh);
171   if Test.D100>MaxD100 then MaxD100 := Test.D100;
172 end;
173 
174 
175 {---------------------------------------------------------------------------}
176 procedure ShowResult(var Test: TTest);
177 begin
178   CalcStat(Test);
179   writeln(' ',Test.name,'':12-length(Test.name), Test.CpB:8:1, Test.MBs:8:2, Test.D100:8:1);
180 end;
181 
182 
183 {---------------------------------------------------------------------------}
184 procedure CRC16_Test;
185 var
186   bc: word;
187   rounds: integer;
188 begin
189   if (rnd<=MinRnd) or not T_CRC16.done then begin
190     start := ReadCycles(HR);
191     for rounds:=1 to NUMROUNDS do CRC16Full(bc, pbuf, sizeof(TBuf));
192     stop := ReadCycles(HR);
193   end;
194   ShowResult(T_CRC16);
195 end;
196 
197 
198 {---------------------------------------------------------------------------}
199 procedure CRC24_Test;
200 var
201   bc: longint;
202   rounds: integer;
203 begin
204   if (rnd<=MinRnd) or not T_CRC24.done then begin
205     start := ReadCycles(HR);
206     for rounds:=1 to NUMROUNDS do CRC24Full(bc, pbuf, sizeof(TBuf));
207     stop := ReadCycles(HR);
208   end;
209   ShowResult(T_CRC24);
210 end;
211 
212 
213 {---------------------------------------------------------------------------}
214 procedure CRC32_Test;
215 var
216   bc: longint;
217   rounds: integer;
218 begin
219   if (rnd<=MinRnd) or not T_CRC32.done then begin
220     start := ReadCycles(HR);
221     for rounds:=1 to NUMROUNDS do CRC32Full(bc, pbuf, sizeof(TBuf));
222     stop := ReadCycles(HR);
223   end;
224   ShowResult(T_CRC32);
225 end;
226 
227 
228 {---------------------------------------------------------------------------}
229 procedure BJL3_Test;
230 var
231   bc: longint;
232   rounds: integer;
233 begin
234   if (rnd<=MinRnd) or not T_CRC32.done then begin
235     start := ReadCycles(HR);
236     for rounds:=1 to NUMROUNDS do BJL3Full(bc, pbuf, sizeof(TBuf));
237     stop := ReadCycles(HR);
238   end;
239   ShowResult(T_BJL3);
240 end;
241 
242 
243 {---------------------------------------------------------------------------}
244 procedure FCRC32_Test;
245 var
246   bc: longint;
247   rounds: integer;
248 begin
249   if (rnd<=MinRnd) or not T_FCRC32.done then begin
250     start := ReadCycles(HR);
251     for rounds:=1 to NUMROUNDS do FCRC32Full(bc, pbuf, sizeof(TBuf));
252     stop := ReadCycles(HR);
253   end;
254   ShowResult(T_FCRC32);
255 end;
256 
257 
258 {---------------------------------------------------------------------------}
259 procedure Adler32_Test;
260 var
261   bc: longint;
262   rounds: integer;
263 begin
264   if (rnd<=MinRnd) or not T_Adler32.done then begin
265     start := ReadCycles(HR);
266     for rounds:=1 to NUMROUNDS do Adler32Full(bc, pbuf, sizeof(TBuf));
267     stop := ReadCycles(HR);
268   end;
269   ShowResult(T_Adler32);
270 end;
271 
272 
273 {---------------------------------------------------------------------------}
274 procedure CRC64_Test;
275 var
276   bc: TCRC64;
277   rounds: integer;
278 begin
279   if (rnd<=MinRnd) or not T_CRC64.done then begin
280     start := ReadCycles(HR);
281     for rounds:=1 to NUMROUNDS do CRC64Full(bc, pbuf, sizeof(TBuf));
282     stop := ReadCycles(HR);
283   end;
284   ShowResult(T_CRC64);
285 end;
286 
287 
288 {---------------------------------------------------------------------------}
289 procedure ED2K_Test;
290 var
291   bc: TED2KResult;
292   rounds: integer;
293 begin
294   if (rnd<=MinRnd) or not T_ED2K.done then begin
295     start := ReadCycles(HR);
296     for rounds:=1 to NUMROUNDS do ED2K_Full(bc, pbuf, sizeof(TBuf));
297     stop := ReadCycles(HR);
298   end;
299   ShowResult(T_ED2K);
300 end;
301 
302 
303 {---------------------------------------------------------------------------}
304 procedure MD4_Test;
305 var
306   bc: TMD4Digest;
307   rounds: integer;
308 begin
309   if (rnd<=MinRnd) or not T_MD4.done then begin
310     start := ReadCycles(HR);
311     for rounds:=1 to NUMROUNDS do MD4Full(bc, pbuf, sizeof(TBuf));
312     stop := ReadCycles(HR);
313   end;
314   ShowResult(T_MD4);
315 end;
316 
317 
318 {---------------------------------------------------------------------------}
319 procedure MD5_Test;
320 var
321   bc: TMD5Digest;
322   rounds: integer;
323 begin
324   if (rnd<=MinRnd) or not T_MD5.done then begin
325     start := ReadCycles(HR);
326     for rounds:=1 to NUMROUNDS do MD5Full(bc, pbuf, sizeof(TBuf));
327     stop := ReadCycles(HR);
328   end;
329   ShowResult(T_MD5);
330 end;
331 
332 
333 {---------------------------------------------------------------------------}
334 procedure RMD160_Test;
335 var
336   bc: TRMD160Digest;
337   rounds: integer;
338 begin
339   if (rnd<=MinRnd) or not T_RMD160.done then begin
340     start := ReadCycles(HR);
341     for rounds:=1 to NUMROUNDS do RMD160Full(bc, pbuf, sizeof(TBuf));
342     stop := ReadCycles(HR);
343   end;
344   ShowResult(T_RMD160);
345 end;
346 
347 
348 {---------------------------------------------------------------------------}
349 procedure SHA1_Test;
350 var
351   bc: TSHA1Digest;
352   rounds: integer;
353 begin
354   if (rnd<=MinRnd) or not T_SHA1.done then begin
355     start := ReadCycles(HR);
356     for rounds:=1 to NUMROUNDS do SHA1Full(bc, pbuf, sizeof(TBuf));
357     stop := ReadCycles(HR);
358   end;
359   ShowResult(T_SHA1);
360 end;
361 
362 
363 {---------------------------------------------------------------------------}
364 procedure SHA224_Test;
365 var
366   bc: TSHA224Digest;
367   rounds: integer;
368 begin
369   if (rnd<=MinRnd) or not T_SHA224.done then begin
370     start := ReadCycles(HR);
371     for rounds:=1 to NUMROUNDS do SHA224Full(bc, pbuf, sizeof(TBuf));
372     stop := ReadCycles(HR);
373   end;
374   ShowResult(T_SHA224);
375 end;
376 
377 
378 {---------------------------------------------------------------------------}
379 procedure SHA256_Test;
380 var
381   bc: TSHA256Digest;
382   rounds: integer;
383 begin
384   if (rnd<=MinRnd) or not T_SHA256.done then begin
385     start := ReadCycles(HR);
386     for rounds:=1 to NUMROUNDS do SHA256Full(bc, pbuf, sizeof(TBuf));
387     stop := ReadCycles(HR);
388   end;
389   ShowResult(T_SHA256);
390 end;
391 
392 
393 {---------------------------------------------------------------------------}
394 procedure SHA384_Test;
395 var
396   bc: TSHA384Digest;
397   rounds: integer;
398 begin
399   if (rnd<=MinRnd) or not T_SHA384.done then begin
400     start := ReadCycles(HR);
401     for rounds:=1 to NUMROUNDS do SHA384Full(bc, pbuf, sizeof(TBuf));
402     stop := ReadCycles(HR);
403   end;
404   ShowResult(T_SHA384);
405 end;
406 
407 
408 {---------------------------------------------------------------------------}
409 procedure SHA512_Test;
410 var
411   bc: TSHA512Digest;
412   rounds: integer;
413 begin
414   if (rnd<=MinRnd) or not T_SHA512.done then begin
415     start := ReadCycles(HR);
416     for rounds:=1 to NUMROUNDS do SHA512Full(bc, pbuf, sizeof(TBuf));
417     stop := ReadCycles(HR);
418   end;
419   ShowResult(T_SHA512);
420 end;
421 
422 
423 {---------------------------------------------------------------------------}
424 procedure Whirl_Test;
425 var
426   bc: TWhirlDigest;
427   rounds: integer;
428 begin
429   if (rnd<=MinRnd) or not T_Whirl.done then begin
430     start := ReadCycles(HR);
431     for rounds:=1 to NUMROUNDS do Whirl_Full(bc, pbuf, sizeof(TBuf));
432     stop := ReadCycles(HR);
433   end;
434   ShowResult(T_Whirl);
435 end;
436 
437 
438 {---------------------------------------------------------------------------}
439 procedure SHA5_224_Test;
440 var
441   bc: TSHA5_224Digest;
442   rounds: integer;
443 begin
444   if (rnd<=MinRnd) or not T_SHA5_224.done then begin
445     start := ReadCycles(HR);
446     for rounds:=1 to NUMROUNDS do SHA5_224Full(bc, pbuf, sizeof(TBuf));
447     stop := ReadCycles(HR);
448   end;
449   ShowResult(T_SHA5_224);
450 end;
451 
452 
453 {---------------------------------------------------------------------------}
454 procedure SHA5_256_Test;
455 var
456   bc: TSHA5_256Digest;
457   rounds: integer;
458 begin
459   if (rnd<=MinRnd) or not T_SHA5_256.done then begin
460     start := ReadCycles(HR);
461     for rounds:=1 to NUMROUNDS do SHA5_256Full(bc, pbuf, sizeof(TBuf));
462     stop := ReadCycles(HR);
463   end;
464   ShowResult(T_SHA5_256);
465 end;
466 
467 
468 {---------------------------------------------------------------------------}
469 procedure SHA3_224_Test;
470 var
471   bc: TSHA3_224Digest;
472   rounds: integer;
473 begin
474   if (rnd<=MinRnd) or not T_SHA3_224.done then begin
475     start := ReadCycles(HR);
476     for rounds:=1 to NUMROUNDS do SHA3_224Full(bc, pbuf, sizeof(TBuf));
477     stop := ReadCycles(HR);
478   end;
479   ShowResult(T_SHA3_224);
480 end;
481 
482 
483 {---------------------------------------------------------------------------}
484 procedure SHA3_256_Test;
485 var
486   bc: TSHA3_256Digest;
487   rounds: integer;
488 begin
489   if (rnd<=MinRnd) or not T_SHA3_256.done then begin
490     start := ReadCycles(HR);
491     for rounds:=1 to NUMROUNDS do SHA3_256Full(bc, pbuf, sizeof(TBuf));
492     stop := ReadCycles(HR);
493   end;
494   ShowResult(T_SHA3_256);
495 end;
496 
497 
498 {---------------------------------------------------------------------------}
499 procedure SHA3_384_Test;
500 var
501   bc: TSHA3_384Digest;
502   rounds: integer;
503 begin
504   if (rnd<=MinRnd) or not T_SHA3_384.done then begin
505     start := ReadCycles(HR);
506     for rounds:=1 to NUMROUNDS do SHA3_384Full(bc, pbuf, sizeof(TBuf));
507     stop := ReadCycles(HR);
508   end;
509   ShowResult(T_SHA3_384);
510 end;
511 
512 
513 {---------------------------------------------------------------------------}
514 procedure SHA3_512_Test;
515 var
516   bc: TSHA3_512Digest;
517   rounds: integer;
518 begin
519   if (rnd<=MinRnd) or not T_SHA3_512.done then begin
520     start := ReadCycles(HR);
521     for rounds:=1 to NUMROUNDS do SHA3_512Full(bc, pbuf, sizeof(TBuf));
522     stop := ReadCycles(HR);
523   end;
524   ShowResult(T_SHA3_512);
525 end;
526 
527 
528 {---------------------------------------------------------------------------}
529 procedure Blake2s_224_Test;
530 var
531   bc: TBlake2S_224Digest;
532   rounds: integer;
533 begin
534   if (rnd<=MinRnd) or not T_BLAKS224.done then begin
535     start := ReadCycles(HR);
536     for rounds:=1 to NUMROUNDS do Blaks224Full(bc, pbuf, sizeof(TBuf));
537     stop := ReadCycles(HR);
538   end;
539   ShowResult(T_BLAKS224);
540 end;
541 
542 {---------------------------------------------------------------------------}
543 procedure Blake2s_256_Test;
544 var
545   bc: TBlake2S_256Digest;
546   rounds: integer;
547 begin
548   if (rnd<=MinRnd) or not T_BLAKS256.done then begin
549     start := ReadCycles(HR);
550     for rounds:=1 to NUMROUNDS do Blaks256Full(bc, pbuf, sizeof(TBuf));
551     stop := ReadCycles(HR);
552   end;
553   ShowResult(T_BLAKS256);
554 end;
555 
556 
557 {---------------------------------------------------------------------------}
558 procedure Blake2b_384_Test;
559 var
560   bc: TBlake2B_384Digest;
561   rounds: integer;
562 begin
563   if (rnd<=MinRnd) or not T_BLAKB384.done then begin
564     start := ReadCycles(HR);
565     for rounds:=1 to NUMROUNDS do Blakb384Full(bc, pbuf, sizeof(TBuf));
566     stop := ReadCycles(HR);
567   end;
568   ShowResult(T_BLAKB384);
569 end;
570 
571 
572 {---------------------------------------------------------------------------}
573 procedure Blake2b_512_Test;
574 var
575   bc: TBlake2B_512Digest;
576   rounds: integer;
577 begin
578   if (rnd<=MinRnd) or not T_BLAKB512.done then begin
579     start := ReadCycles(HR);
580     for rounds:=1 to NUMROUNDS do Blakb512Full(bc, pbuf, sizeof(TBuf));
581     stop := ReadCycles(HR);
582   end;
583   ShowResult(T_BLAKB512);
584 end;
585 
586 
587 var
588   i: word;
589   done: boolean;
590 begin
591 
592   {$ifdef BASM16}
593     {$ifdef DumpAlign}
594       if readkey=#27 then halt;
595     {$endif}
596   {$endif}
597 
598   {$ifdef VER90 }
599     InitCRT;  {D2}
600   {$endif}
601   {$ifdef WIN32or64}
602     if Paramcount=0 then SetPriorityClass(GetCurrentProcess,HIGH_PRIORITY_CLASS);
603   {$endif}
604 
605   randseed := 1234567;
606   new(pbuf);
607   for i:=1 to NUMBYTES do pbuf^[i] := random(256);
608   StartTimer(HR);
609 
610   T_CRC16.name   := 'CRC16';
611   T_CRC24.name   := 'CRC24';
612   T_CRC32.name   := 'CRC32';
613   T_bCRC32.name  := 'bCRC32';
614   T_FCRC32.name  := 'FCRC32';
615   T_Adler32.name := 'Adler32';
616   T_BJL3.name    := 'BJ lookup3';
617   T_BJDelphi.name:= 'BJ Delphi';
618   T_CRC64.name   := 'CRC64';
619   T_bCRC64.name  := 'bCRC64';
620   T_ED2K.name    := 'eDonkey';
621   T_MD4.name     := 'MD4';
622   T_MD5.name     := 'MD5';
623   T_SHA1.name    := 'SHA1';
624   T_SHA224.name  := 'SHA224';
625   T_SHA256.name  := 'SHA256';
626   T_SHA384.name  := 'SHA384';
627   T_SHA512.name  := 'SHA512';
628   T_SHA5_224.name:= 'SHA512/224';
629   T_SHA5_256.name:= 'SHA512/256';
630   T_Whirl.name   := 'Whirlpool';
631   T_RMD160.name  := 'RIPEMD160';
632   T_SHA3_224.name:= 'SHA3-224';
633   T_SHA3_256.name:= 'SHA3-256';
634   T_SHA3_384.name:= 'SHA3-384';
635   T_SHA3_512.name:= 'SHA3-512';
636   T_BLAKS224.name:= 'Blake2s-224';
637   T_BLAKS256.name:= 'Blake2s-256';
638   T_BLAKB384.name:= 'Blake2b-384';
639   T_BLAKB512.name:= 'Blake2b-512';
640 
641   clrscr;
642   {$ifdef WINCRT}
643     writeln('Name        ':13, 'Cyc/B':8, 'MB/s':8, 'D[%]':8, CPUFrequency/1E6:10:1);
644   {$else}
645     textcolor(lightgreen);
646     writeln('Name        ':13, 'Cyc/B':8, 'MB/s':8, 'D[%]':8, CPUFrequency/1E6:10:1);
647     textcolor(lightgray);
648   {$endif}
649   done := false;
650   rnd  := 0;
651   repeat
652     ReStartTimer(HR);
653     gotoxy(1,2);
654     MaxD100 := 0.0;
655     CRC16_Test;
656     CRC24_Test;
657     CRC32_Test;
658     FCRC32_Test;
659     Adler32_Test;
660     BJL3_Test;
661     CRC64_Test;
662     ED2K_Test;
663     MD4_Test;
664     MD5_Test;
665     RMD160_Test;
666     SHA1_Test;
667     SHA224_Test;
668     SHA256_Test;
669     SHA384_Test;
670     SHA512_Test;
671     SHA5_224_Test;
672     SHA5_256_Test;
673     Whirl_Test;
674     SHA3_224_Test;
675     SHA3_256_Test;
676     SHA3_384_Test;
677     SHA3_512_Test;
678     Blake2s_224_Test;
679     Blake2s_256_Test;
680     Blake2b_384_Test;
681     Blake2b_512_Test;
682     inc(rnd);
683     writeln('Rounds: ',rnd);
684     {Some compilers have no break!!}
685     if keypressed and (readkey=#27) then done := true;
686     if (rnd>MinRnd) and (MaxD100 < DThresh)  then done := true;
687  until done;
688 end.
689