# Enhancing speed of looping cycle using Freepascal

I use Lazarus 1.2.4 and Freepascal 2.6.4.

I have created a program that reads a disk in buffers of 64Kb (tried various buffer sizes) using a repeat...until loop. Each buffer is hashed using the SHA1 unit, specifically, SHA1Init, SHA1Update and SHA1Final.

The trouble is, is that although it works and the hashes always match that computed by other tools that do the same job, my program is not as fast. On a specific workstation with an 80Gb disk attached, it reads and hashes at about 1.8Gb per minute, and this is as a result of some enhanced compiler directives (and using specific optimisations offered by the Lazarus\FPC compiler). Before those tweaks, it was just 1.22Gb p\min as an average. The other tools do it at about 2.5Gb+ a minute (around 45Mb a second) and some are faster than that.

If I remove the hashing element and just do the disk reading, it reads at about 4Gb per minute, so I am fairly sure my loop structure is actually fairly quick. So I'm almost certain the bottleneck is the hashing aspect and this has been discussed at the Lazarus forum, here where it has been suggested that maybe the library needs to be improved a little for better speed. One poster suggested I re-write the three functions in assembly but I am not that good.

There is a related post HERE regarding SHA256, where the gentlemen concerned experienced similar issues, though with a different language. His implementation was very similar to mine - Init, Update, Final. One suggestion was to use a buffer of 16Mb in that post. I have tried 4Kb, 8Kb, 64Kb, 256Kb, 512Kb and 1Mb. I haven't gone to 16Mb or anywhere near that - might that prove to be worthwhile? I read that once you go above about 1Mb programs usually go backward?

Is there an obvious way to improve speed?

I have included only the relevant parts in the hope it will make the task easier to read.

// Main parts of my code responsible for loop.
// The SHA1 functions from the SHA1 Freepascal unit follow
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_FLAG_SEQUENTIAL_SCAN, 0);  // please note I have also tried FILE_FLAG_NO_BUFFER but that made no apparant difference

// We need the exact disk size in bytes to know when to stop reading
ExactDiskSize            := GetDiskLengthInBytes(hSelectedDisk);

SectorCount              := ExactDiskSize DIV 512;

// Now read the disk FROM START TO END and hash it until completion or the user aborts it
try
SHA1Init(ctx);
FileSeek(hSelectedDisk, 0, 0);
repeat
ProgressCounter := ProgressCounter + 1; // We use this update the progress display occasionally, instead of every buffer read

// The hashing bit...read the disk in buffers, hash each buffer and then
// finalise the finished hash. If there's a read error, abort.

// Step 1 : Check we are not at the end of the disk where bytes remaining
// could be less than the size of the buffer
if (ExactDiskSize - TotalBytesRead) < SizeOf(Buffer) then
begin
end
else
begin
end;
begin
ShowMessage('There was a read error encountered. Aborting');
exit;
end
else
// Step 2 : No read errors, so now we hash ...
// Update positions, update hash sequence, and update GUI
begin
lblBytesLeftToHashB.Caption := IntToStr(ExactDiskSize - NewPos) + ' bytes, ' + FormatByteSize(ExactDiskSize - NewPos);
until (TotalBytesRead = ExactDiskSize) or (Stop = true);
// Compute the final hash value
SHA1Final(ctx, Digest);
lblHash.Caption := SHA1Print(Digest);
end;
end; // End of main looping cycle. Following code is the FPC procedures

procedure SHA1Init(out ctx: TSHA1Context);
begin
FillChar(ctx, sizeof(TSHA1Context), 0);
ctx.State[0] := $67452301; ctx.State[1] :=$efcdab89;
ctx.State[2] := $98badcfe; ctx.State[3] :=$10325476;
ctx.State[4] := $c3d2e1f0; end; procedure SHA1Update(var ctx: TSHA1Context; const Buf; BufLen: PtrUInt); var Src: PByte; Num: PtrUInt; begin if BufLen = 0 then Exit; Src := @Buf; Num := 0; // 1. Transform existing data in buffer if ctx.BufCnt > 0 then begin // 1.1 Try to fill buffer up to block size Num := 64 - ctx.BufCnt; if Num > BufLen then Num := BufLen; Move(Src^, ctx.Buffer[ctx.BufCnt], Num); Inc(ctx.BufCnt, Num); Inc(Src, Num); // 1.2 If buffer is filled, transform it if ctx.BufCnt = 64 then begin SHA1Transform(ctx, @ctx.Buffer); ctx.BufCnt := 0; end; end; // 2. Transform input data in 64-byte blocks Num := BufLen - Num; while Num >= 64 do begin SHA1Transform(ctx, Src); Inc(Src, 64); Dec(Num, 64); end; // 3. If there's less than 64 bytes left, add it to buffer if Num > 0 then begin ctx.BufCnt := Num; Move(Src^, ctx.Buffer, Num); end; end; const PADDING: array[0..63] of Byte = ($80,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
);

procedure SHA1Final(var ctx: TSHA1Context; out Digest: TSHA1Digest);
var
Length: QWord;
begin
// 1. Compute length of the whole stream in bits
Length := 8 * (ctx.Length + ctx.BufCnt);

if ctx.BufCnt >= 56 then
else

// 3. Append length of the stream (8 bytes)
Length := NtoBE(Length);
SHA1Update(ctx, Length, 8);

// 4. Invert state to digest
Invert(@ctx.State, @Digest, 20);
FillChar(ctx, sizeof(TSHA1Context), 0);
end;


If you're processing 1.8Gb per minute using 64Kb buffers, that's (1800000 / 64 =) 28000 buffers per minute i.e. (28000 / 60 =) 470 buffers / second.

I don't know what you're doing elsewhere with these statements ...

ProgressCounter := ProgressCounter + 1; // We use this update the progress display occasionally, instead of every buffer read


... but you should probably NOT try to update a GUI progress bar 500 times/second!

Also, avoid calling this 500 times times/second:

      lblBytesLeftToHashB.Caption := IntToStr(ExactDiskSize - NewPos) + ' bytes, ' + FormatByteSize(ExactDiskSize - NewPos);


Try disabling/removing that GUI-updating code completely, to see whether that improves performance. If it does improve performance then partially re-add the GUI-updating code: for example, update the GUI once every 100 buffers (instead of once every buffer as you're doing now).

Also you should get better performance if you move the I/O to a separate thread.

Alternatively this would be a time to use 'overlapped I/O' (e.g. passing a non-null LPOVERLAPPED parameter to the Win32 ReadFile function) but I don't know how to do that with the Freepascal run-time library.

• I have a progress speed checker that is activated every 2000 buffer reads. So, moving lblBytesLeftToHashB.Caption to the same if statement that checks the progress has had the ffect of meaning the interface refreshes every second or so rather than 500 times a second, and that shaves about another 8 minutes off. So it is now about as fast as the other tool! Thanks for your help. Answer accepted. – Gizmo_the_Great Jul 7 '14 at 12:47