Board index » delphi » Two new tests for MM B&V

2005-02-25 02:56:53 PM
delphi278
Here are two tests I discussed with Dennis, ready for use in MM B^V.
Test 1 - ManyThreadTest - Many shortlived threads (capped at 1250)
Test 2 - StringThreadTest - 8 Threads doing string manipulations
The two units are included below
Modifications needed for BenchMarkForm.pas
==========================================================
Uses StringThreadTestUnit;
AddBenchMark(TManyThreadsTest);
AddBenchMark(TStringThreadTest);
Kind regards,
Ivo Tops
=============================== Save this one as StringThreadTestUnit
{****************************************************************************************
StringTestBenchMark & ManyThreadsTestBenchMark v1.0
By Ivo Tops for FastCode Memory Manager BenchMark & Validation
****************************************************************************************}
unit StringThreadTestUnit;
interface
uses BenchmarkClassUnit;
type
TStringThreadTest = class(TFastcodeMMBenchmark)
protected
public
procedure RunBenchmark; override;
class function GetBenchmarkName: string; override;
class function GetBenchmarkDescription: string; override;
class function GetWeightingFactor: Double; override;
end;
TManyThreadsTest = class(TFastcodeMMBenchmark)
protected
public
procedure RunBenchmark; override;
class function GetBenchmarkName: string; override;
class function GetBenchmarkDescription: string; override;
class function GetWeightingFactor: Double; override;
end;
// Counters for thread running
procedure IncRunningThreads;
procedure DecRunningThreads;
procedure NotifyThreadError;
procedure NotifyValidationError;
implementation
uses Math, StringThread, windows, sysutils;
var RunningThreads: Integer;
ThreadError, ValidationError, ThreadMaxReached, ZeroThreadsReached:
Boolean;
procedure InitTest;
begin
RunningThreads := 0;
ZeroThreadsReached := False;
ThreadMaxReached := False;
ThreadError := False;
end;
procedure ExitTest;
begin
// If Thread had error raise exception
if ThreadError then raise Exception.Create('TestThread failed with an
Error');
// If Thread had validate raise exception
if ValidationError then raise Exception.Create('TestThread failed
Validation');
end;
{ TStringThreadTest }
class function TStringThreadTest.GetBenchmarkDescription: string;
begin
Result := 'A benchmark that does stringmanipulations concurrently in
8 different threads';
end;
class function TStringThreadTest.GetBenchmarkName: string;
begin
Result := 'StringThreadTest';
end;
class function TStringTHreadTest.GetWeightingFactor: Double;
begin
{Arbitrary scale factor to bring scores for this benchmark in line
with the others}
Result := 4600 * Power(2, 40);
end;
procedure TStringThreadTest.RunBenchmark;
var I, J: Integer;
begin
inherited;
InitTest;
for J := 1 to 4 do
begin
for I := 1 to 8 do // Create a loose new thread that does stringactions
TStringThread.Create(50, 2000, 4096, False);
// Simply wait for all threads to finish
while not ZeroThreadsReached do sleep(10);
end;
{Update the peak address space usage}
UpdateUsageStatistics;
// Done
ExitTest;
end;
procedure IncRunningThreads;
var RT: Integer;
begin
RT := InterlockedExchangeAdd(@RunningThreads, 1);
ZeroThreadsReached := False;
ThreadMaxReached := RT>1250;
end;
procedure DecRunningThreads;
var RT: Integer;
begin
RT := InterlockedExchangeAdd(@RunningThreads, -1);
ThreadMaxReached := RT>1250;
ZeroThreadsReached := RT = 1; // Old value is 1, so new value is zero
end;
{ TManyThreadsTest }
class function TManyThreadsTest.GetBenchmarkDescription: string;
begin
Result := 'A benchmark that has many temporary threads, each doing a
little string processing. ';
Result := Result + 'This test exposes possible multithreading issues
in a memory manager and large per-thread ';
Result := Result + 'memory requirements.';
end;
class function TManyThreadsTest.GetBenchmarkName: string;
begin
Result := 'ManyShortLivedThreads';
end;
class function TManyThreadsTest.GetWeightingFactor: Double;
begin
{Arbitrary scale factor to bring scores for this benchmark in line
with the others}
Result := 4600 * Power(2, 40);
end;
procedure TManyThreadsTest.RunBenchmark;
var
I: Integer;
begin
inherited;
InitTest;
// Launch a lot of threads
for I := 1 to 100 do
begin
TStringThread.Create(1000, 10, 512, False);
TStringThread.Create(10, 2, 4096, False);
TStringThread.Create(10, 2, 1024*1024, False);
end;
// Launch a lot of threads keeping threadmax in account
for I := 1 to 500 do
begin
TStringThread.Create(100, 1, 512, False);
TStringThread.Create(100, 100, 512, False);
TStringThread.Create(100, 1, 512, False);
while ThreadMaxReached do sleep(1);
end;
// Wait for all threads to finish
while not ZeroThreadsReached do sleep(50);
{Update the peak address space usage}
UpdateUsageStatistics;
// Done
ExitTest;
end;
procedure NotifyThreadError;
begin
ThreadError := True;
end;
procedure NotifyValidationError;
begin
ValidationError := True;
end;
end.
=============================== Save this one as StringThread
{****************************************************************************************
StringThread usede by StringTestBenchMark & ManyThreadsTestBenchMark
By Ivo Tops for FastCode Memory Manager BenchMark & Validation
****************************************************************************************}
unit StringThread;
interface
uses
Classes, windows, sysutils;
const
cRandomSizes = False;
type
TStringThread = class(TThread)
private
FStringItems: Integer;
FValidate: Boolean;
FIterations: Integer;
FSize:Integer;
protected
procedure StringAction;
public
constructor Create(AIterations: Integer; AItems: Integer;
AItemSize:Integer;AValidate: Boolean); reintroduce;
procedure Execute; override;
end;
type TLargeByteArray = array[0..MaxInt - 1] of Byte;
procedure FillPattern(const Dest: Pointer; const Size: Integer; const
StartChar: Byte);
function CheckPattern(const Dest: Pointer; const Size: Integer; const
StartChar: Byte): Boolean;
implementation
uses StringThreadTestUnit;
constructor TStringThread.Create(AIterations: Integer; AItems: Integer;
AItemSize:Integer;AValidate: Boolean);
begin
inherited Create(False);
FreeOnTerminate := True;
IncRunningThreads;
FStringItems := AItems;
FValidate := AValidate;
FIterations := AIterations;
FSize:=AItemSize;
end;
procedure TStringThread.Execute;
var I: Integer;
begin
try
for I := 0 to FIterations - 1 do StringAction;
except
// Notify TestUnit we had a failure
NotifyThreadError;
end;
DecRunningThreads;
end;
procedure TStringThread.StringAction;
var I: Integer;
B1, B2: Integer;
FCB: Byte;
FillLen: Integer;
A, B: array of string;
begin
SetLength(A, FStringItems);
SetLength(B, FStringItems);
if cRandomSizes then
begin
B1 := Random(FSize) + 1;
B2 := Random(FSize) + 1;
end else
begin
B1 := FSize;
B2 := FSize div 2;
end;
for I := 0 to FStringItems - 1 do
begin
SetLength(A[I], B1);
if FValidate then
begin
FCB := Byte((I mod 250) + 1);
FillPattern(PChar(A[I]), B1, FCB);
end;
end;
// Reference counter, no copy
for I := FStringItems - 1 downto 0 do
B[I] := A[I];
// Copy resizing
for I := 0 to FStringItems - 1 do
SetLength(B[I], B2);
// Validate and CleanUp
for I := FStringItems - 1 downto 0 do
begin
if FValidate then
begin
FCB := Byte((I mod 250) + 1);
FillLen := length(A[I]);
if not CheckPattern(PChar(A[I]), FillLen, FCB) then
begin
NotifyValidationError;
Exit;
end;
if length(B[I]) < FillLen then FillLen := Length(B[I]);
if not CheckPattern(PChar(B[I]), FillLen, FCB) then
begin
NotifyValidationError;
Exit;
end;
end;
B[I] := EmptyStr; // Cleanup
A[I] := EmptyStr;
end;
end;
// Fill Memory with a Pattern
procedure FillPattern(const Dest: Pointer; const Size: Integer; const
StartChar: Byte);
var I: Integer;
PC: Byte;
begin
// Write a three byte pattern starting with the byte passed
PC := 0;
for I := 0 to Size - 1 do
begin
TLargeByteArray(Dest^)[I] := StartChar + PC;
Inc(PC);
if PC = 3 then PC := 0;
end;
end;
// Check memory for correct Pattern
function CheckPattern(const Dest: Pointer; const Size: Integer; const
StartChar: Byte): Boolean;
var I: Integer;
PC: Byte;
begin
// Check a three byte pattern starting with the byte passed
Result := True;
PC := 0;
for I := 0 to Size - 1 do
begin
if TLargeByteArray(Dest^)[I] <>StartChar + PC then
begin
Result := False;
Break;
end;
Inc(PC);
if PC = 3 then PC := 0;
end;
end;
end.
 

Hi Ivo etc.
Thanks. Who volunteers to integrate it?
Regards
Dennis
 

Hi,
Pierre
 

Rgds,
Martin
 

In article <XXXX@XXXXX.COM>,
XXXX@XXXXX.COM says...
- Brian
 

Brian Cook writes:
create just under 2000 threads in the default configuration regardless
of how much physical memory you have, and you can create more if you
reduce the maximum stack size in the project's options.
We have a couple of server applications that reach well over 1000
threads in our load testing. Haven't gone this high in production,
though.
--
Regards,
Bruce McGee
Glooscap Software
 

servers?'
One-thread -per-client servers are on the way out now in favour of
overlapped/IOCP, even at Atozed :)
Rgds,
Martin
 

Martin James writes:
Yup, Indy servers. We'll going to start taking advantage of SuperCore.
Eventually...
--
Regards,
Bruce McGee
Glooscap Software