Board index » delphi » Fastcode MM B&V 0.29

Fastcode MM B&V 0.29


2005-04-07 03:45:51 AM
delphi2
Hi
Here is the new DoubleFP benchmark
unit DoubleFPBenchmarkUnit;
interface
uses Windows, BenchmarkClassUnit, Classes, Math;
type
TDoubleFPThreads = class(TFastcodeMMBenchmark)
public
procedure RunBenchmark; override;
class function GetBenchmarkName: string; override;
class function GetBenchmarkDescription: string; override;
class function GetCategory: TBenchmarkCategory; override;
end;
implementation
uses SysUtils;
type
TDoubleFPThread = class(TThread)
FBenchmark: TFastcodeMMBenchmark;
procedure Execute; override;
end;
TRegtangularComplexD = packed record
RealPart, ImaginaryPart : Double;
end;
function RegtAddDKCPas1(const X, Y : TRegtangularComplexD) :
TRegtangularComplexD; overload;
begin
Result.RealPart := X.RealPart + Y.RealPart;
Result.ImaginaryPart := X.ImaginaryPart + Y.ImaginaryPart;
end;
procedure TDoubleFPThread.Execute;
var
I1, I2, I5: Integer;
//Need many arrays because a 4 byte aligned array can be 8 byte aligned by
pure chance
Src1Array1 : array of TRegtangularComplexD;
Src2Array1 : array of TRegtangularComplexD;
ResultArray1 : array of TRegtangularComplexD;
Src1Array2 : array of TRegtangularComplexD;
Src2Array2 : array of TRegtangularComplexD;
ResultArray2 : array of TRegtangularComplexD;
Src1Array3 : array of TRegtangularComplexD;
Src2Array3 : array of TRegtangularComplexD;
ResultArray3 : array of TRegtangularComplexD;
Src1Array4 : array of TRegtangularComplexD;
Src2Array4 : array of TRegtangularComplexD;
ResultArray4 : array of TRegtangularComplexD;
const
BENCHARRAYSIZE : Integer = 45000;
NOOFRUNS : Integer = 1000;
begin
SetLength(Src1Array1, BENCHARRAYSIZE);
SetLength(Src2Array1, BENCHARRAYSIZE);
SetLength(ResultArray1, BENCHARRAYSIZE);
SetLength(Src1Array2, BENCHARRAYSIZE);
SetLength(Src2Array2, BENCHARRAYSIZE);
SetLength(ResultArray2, BENCHARRAYSIZE);
SetLength(Src1Array3, BENCHARRAYSIZE);
SetLength(Src2Array3, BENCHARRAYSIZE);
SetLength(ResultArray3, BENCHARRAYSIZE);
SetLength(Src1Array4, BENCHARRAYSIZE);
SetLength(Src2Array4, BENCHARRAYSIZE);
SetLength(ResultArray4, BENCHARRAYSIZE);
FBenchmark.UpdateUsageStatistics;
//Fill source arrays
for I1 := 0 to BENCHARRAYSIZE-1 do
begin
Src1Array1[I1].RealPart := 1;
Src1Array1[I1].ImaginaryPart := 1;
Src2Array1[I1].RealPart := 1;
Src2Array1[I1].ImaginaryPart := 1;
Src1Array2[I1].RealPart := 1;
Src1Array2[I1].ImaginaryPart := 1;
Src2Array2[I1].RealPart := 1;
Src2Array2[I1].ImaginaryPart := 1;
Src1Array3[I1].RealPart := 1;
Src1Array3[I1].ImaginaryPart := 1;
Src2Array3[I1].RealPart := 1;
Src2Array3[I1].ImaginaryPart := 1;
Src1Array4[I1].RealPart := 1;
Src1Array4[I1].ImaginaryPart := 1;
Src2Array4[I1].RealPart := 1;
Src2Array4[I1].ImaginaryPart := 1;
end;
for I2 := 0 to NOOFRUNS do
begin
for I5 := 0 to BENCHARRAYSIZE-1 do
begin
//ResultArray1[I5] := RegtAddDKCPas1(Src1Array1[I5], Src2Array1[I5]);
ResultArray1[I5].RealPart := Src1Array1[I5].RealPart +
Src2Array1[I5].RealPart;
ResultArray1[I5].ImaginaryPart := Src1Array1[I5].ImaginaryPart +
Src2Array1[I5].ImaginaryPart;
//ResultArray2[I5] := RegtAddDKCPas1(Src1Array2[I5], Src2Array2[I5]);
ResultArray2[I5].RealPart := Src1Array2[I5].RealPart +
Src2Array2[I5].RealPart;
ResultArray2[I5].ImaginaryPart := Src1Array2[I5].ImaginaryPart +
Src2Array2[I5].ImaginaryPart;
//ResultArray3[I5] := RegtAddDKCPas1(Src1Array3[I5], Src2Array3[I5]);
ResultArray3[I5].RealPart := Src1Array3[I5].RealPart +
Src2Array3[I5].RealPart;
ResultArray3[I5].ImaginaryPart := Src1Array3[I5].ImaginaryPart +
Src2Array3[I5].ImaginaryPart;
//ResultArray4[I5] := RegtAddDKCPas1(Src1Array4[I5], Src2Array4[I5]);
ResultArray4[I5].RealPart := Src1Array4[I5].RealPart +
Src2Array4[I5].RealPart;
ResultArray4[I5].ImaginaryPart := Src1Array4[I5].ImaginaryPart +
Src2Array4[I5].ImaginaryPart;
end;
end;
end;
class function TDoubleFPThreads.GetBenchmarkDescription: string;
begin
Result := 'A benchmark that tests access to Double FP variables '
+ 'in a dynamic array '
+ 'Benchmark submitted by Dennis Kjaer Christensen.';
end;
class function TDoubleFPThreads.GetBenchmarkName: string;
begin
Result := 'Double Variables Access';
end;
class function TDoubleFPThreads.GetCategory: TBenchmarkCategory;
begin
Result := bmSingleThreadAlloc;
end;
procedure TDoubleFPThreads.RunBenchmark;
var
DoubleFPThread : TDoubleFPThread;
begin
inherited;
DoubleFPThread := TDoubleFPThread.Create(True);
DoubleFPThread.FreeOnTerminate := False;
DoubleFPThread.FBenchmark := Self;
DoubleFPThread.Resume;
DoubleFPThread.WaitFor;
DoubleFPThread.Free;
end;
end.
Best regards
Dennis
 
 

Re:Fastcode MM B&V 0.29

Hi
Here is the modified Validate18. BYTESTOALLOCATEMIN is changed
function TMMValidation.Validate18 : Boolean;
var
SomeArray : array of Byte;
MemoryStatus : TMemoryStatus;
BytesToAllocate, I, StartAddress : Cardinal;
const
BYTESTOALLOCATESTEPSIZE : Cardinal = 11;
BYTESTOALLOCATEMIN : Cardinal = 16;//
BYTESTOALLOCATEMAX : Cardinal = 100000000;//100 Mbyte
Regards
Dennis
 

Re:Fastcode MM B&V 0.29

Hi
A new version of Validate18. This code
//16 byte alignment?
//Add 8 byte offset to compensate for refcount and size data
StartAddress := Cardinal(@SomeArray[8]);
if StartAddress mod 16 <>0 then
was changed to compensate for refcount and size data in front of dynamic
arrays.
It would perhaps be better to remove the dyn array and simply use GetMem?
Regards
Dennis
function TMMValidation.Validate18 : Boolean;
var
SomeArray : array of Byte;
MemoryStatus : TMemoryStatus;
BytesToAllocate, I, StartAddress : Cardinal;
const
BYTESTOALLOCATESTEPSIZE : Cardinal = 11;
BYTESTOALLOCATEMIN : Cardinal = 16;//
BYTESTOALLOCATEMAX : Cardinal = 100000000;//100 Mbyte
begin
GlobalMemoryStatus(MemoryStatus);
try
Result := True;
BytesToAllocate := BYTESTOALLOCATEMIN;
while BytesToAllocate <= BYTESTOALLOCATEMAX do
begin
if MemoryStatus.dwAvailVirtual>= BytesToAllocate then
begin
//Allocate
SetLength(SomeArray, BytesToAllocate);
//16 byte alignment?
//Add 8 byte offset to compensate for refcount and size data
StartAddress := Cardinal(@SomeArray[8]);
if StartAddress mod 16 <>0 then
begin
Result := False;
Exit;
end;
//Write with 4 byte granularity
I := 0;
while (I < BytesToAllocate) do
begin
SomeArray[I] := 255;
SomeArray[I+1] := 255;
SomeArray[I+2] := 255;
SomeArray[I+3] := 255;
Inc(I,4);
end;
//Free
SetLength(SomeArray, 0);
BytesToAllocate := BytesToAllocate * BYTESTOALLOCATESTEPSIZE;
end;
end;
except
Result := False;
end;
end;
 

Re:Fastcode MM B&V 0.29

Hi Again
I have made a draft to the "Total Validate" function. I'd like to have
it under Validate in a multithreaded version. Give it a review.
//Allocates XX pointers up to BYTESTOALLOCATEMAX per pointer
//Validate 4 byte alignment, unique pointers, non overlapping blocks,
//read and write to block with 4 byte granularity
function TMMValidation.Validate19 : Boolean;
var
I1, I2, I3, J1, J2, J3, BytesToAllocate, RunNo, IntegersToFill : Cardinal;
pMem : Pointer;
PointerArray : array[1..1250] of Pointer;
MemoryStatus : TMemoryStatus;
pInt : pInteger;
RefData, MemBlockSize : Integer;
const
BYTESTOALLOCATEMAX : Cardinal = 250000;//250 Kbyte per pointer
RUNNOMAX : Cardinal = 600;
begin
Result := True;
try
for RunNo := 1 to RUNNOMAX do
begin
for I1 := 1 to Length(PointerArray) do
PointerArray[I1] := nil;
for I2 := 1 to Length(PointerArray) do
begin
if I2 = 1 then
BytesToAllocate := RunNo * 100000//Allocate one big block that grows
linearily
else
BytesToAllocate := Random(BYTESTOALLOCATEMAX-1)+1;//Always allocate
Quote
= 4 byte
GlobalMemoryStatus(MemoryStatus);
if MemoryStatus.dwAvailVirtual>= BytesToAllocate then
begin
//Allocate all pointers
GetMem(pMem, BytesToAllocate);
if Integer(pMem) mod 4 <>0 then
begin
//Pointer not 4 byte aligned
Result := False;
Exit;
end;
PointerArray[I2] := pMem;
//Fill allocated memory with unique data = Pointer
pInt := pMem;
IntegersToFill := (BytesToAllocate+3) div 4;//Write past end
//But write size in integers in first 4 bytes
pInt^ := IntegersToFill;
Inc(pInt);
for J1 := 1 to IntegersToFill-1 do
begin
//Write with 4 byte granularity
pInt^ := Integer(pMem);
Inc(pInt);
end;
end;
end;
//No mem overwritten
for J2 := 1 to Length(PointerArray) do
begin
pInt := PointerArray[J2];
RefData := Integer(PointerArray[J2]);
MemBlockSize := pInt^;//Size in first 4 bytes
Inc(pInt);
for J3 := 1 to MemBlockSize-1 do
begin
if pInt^ <>RefData then
begin
//Memory block is overwritten
Result := False;
Exit;
end;
Inc(pInt);
end;
end;
//Free all pointers
for I3 := 1 to Length(PointerArray) do
begin
pMem := PointerArray[I3];
FreeMem(pMem);
PointerArray[I3] := nil;
end;
end;
except
Result := False;
end;
end;
Regards
Dennis
 

Re:Fastcode MM B&V 0.29

Hi
Forget this post. I think that I messed around ;-(
Regards
Dennis
 

Re:Fastcode MM B&V 0.29