program threadbenchmark;
{$mode objfpc}{$H+}
uses
SysUtils, Classes;
const
num = 100000000;
Tests: array[0..8] of Integer = (1, 2, 4, 6, 8, 10, 12, 14, 16);
type
TRec = record
a, b, c: Integer;
end;
TArray = array of TRec;
PRec = ^TRec;
type
TWorkerThread = class(TThread)
private
FL, FR: Integer;
FData: PRec;
protected
procedure Execute; override;
public
constructor Create(L, R: Integer; Data: PRec);
end;
constructor TWorkerThread.Create(L, R: Integer; Data: PRec);
begin
inherited Create(True);
FL := L;
FR := R;
FData := Data;
end;
procedure TWorkerThread.Execute;
var
i: Integer;
begin
for i := FL to FR do
begin
FData[i].a := i mod 10;
FData[i].b := (i + 5) mod 10;
FData[i].c := FData[i].a + FData[i].b;
end;
end;
function RunTest(var Arr: TArray; CurrentThreads: Integer): QWord;
var
Threads: array of TWorkerThread;
i, L, R: Integer;
t0: QWord;
begin
FillChar(Arr[0], Length(Arr) * SizeOf(TRec), 0);
SetLength(Threads, CurrentThreads);
t0 := GetTickCount64;
for i := 0 to CurrentThreads - 1 do
begin
L := (i * Length(Arr)) div CurrentThreads;
R := ((i + 1) * Length(Arr)) div CurrentThreads - 1;
Threads[i] := TWorkerThread.Create(L, R, @Arr[0]);
Threads[i].Start;
end;
for i := 0 to High(Threads) do
begin
Threads[i].WaitFor;
Threads[i].Free;
end;
Result := GetTickCount64 - t0;
end;
procedure Benchmark;
var
Arr: TArray;
tSingle, tCurrent: QWord;
Speedup, Efficiency: Double;
i: Integer;
begin
Writeln('Allocating ', (Int64(num) * SizeOf(TRec)) div (1024*1024), ' MB RAM...');
SetLength(Arr, num);
Writeln('Running benchmarks...');
Writeln;
Writeln('Threads | Time (ms) | Speedup | Efficiency');
Writeln('-------------------------------------------');
tSingle := RunTest(Arr, 1);
Writeln(1:7, ' | ', tSingle:9, ' | 1.00x | 100.0%');
for i := 1 to High(Tests) do
begin
tCurrent := RunTest(Arr, Tests[i]);
if tCurrent > 0 then
begin
Speedup := tSingle / tCurrent;
Efficiency := (Speedup / Tests[i]) * 100;
Writeln(Tests[i]:7, ' | ', tCurrent:9, ' | ', Speedup:6:2, 'x | ', Efficiency:7:1, '%');
end;
end;
Writeln('-------------------------------------------');
Writeln('Done. Press Enter to exit.');
Readln;
end;
begin
Benchmark;
end.
Recent
