program test;
{$mode delphi}
{$optimization on}
uses SysUtils;
type
TValueType = (vtBoolean, vtInteger, vtReal);
PValueNotPacked = ^TValueNotPacked;
TValueNotPacked = record
case Typ: TValueType of
vtBoolean: (BoolVal: Boolean);
vtInteger: (IntVal: Int64);
vtReal: (RealVal: Double);
end;
PValuePacked = ^TValuePacked;
TValuePacked = packed record
case Typ: TValueType of
vtBoolean: (BoolVal: Boolean);
vtInteger: (IntVal: Int64);
vtReal: (RealVal: Double);
end;
const
size = 512*1024*1024;
procedure bench_notpacked1;
var
arr_notpacked: array of TValueNotPacked;
i, s: NativeInt;
t: TDateTime;
begin
Write(SizeOf(TValueNotPacked), ', ');
SetLength(arr_notpacked, size);
t:=Now;
begin
for i:=0 to size-1 do
s+=arr_notpacked[i].IntVal;
end;
WriteLn('Not packed 1: ',(Now-t)*MSecsPerDay:0:0, ' ms.');
SetLength(arr_notpacked, 0);
end;
procedure bench_notpacked2;
var
arr_notpacked: array of TValueNotPacked;
s: NativeInt;
t: TDateTime;
p, pend: PValueNotPacked;
begin
Write(SizeOf(TValueNotPacked), ', ');
SetLength(arr_notpacked, size);
t:=Now;
begin
p:=@arr_notpacked[0];
pend:=@arr_notpacked[size-1];
while p<=pend do
begin
s+=p.IntVal;
inc(p);
end;
end;
WriteLn('Not packed 2: ',(Now-t)*MSecsPerDay:0:0, ' ms.');
SetLength(arr_notpacked, 0);
end;
procedure bench_packed1;
var
arr_packed: array of TValuePacked;
i, s: NativeInt;
t: TDateTime;
begin
Write(SizeOf(TValuePacked), ', ');
SetLength(arr_packed, size);
t:=Now;
begin
for i:=0 to size-1 do
s+=arr_packed[i].IntVal;
end;
WriteLn('Packed 1: ',(Now-t)*MSecsPerDay:0:0, ' ms.');
SetLength(arr_packed, 0);
end;
procedure bench_packed2;
var
arr_packed: array of TValuePacked;
s: NativeInt;
t: TDateTime;
p, pend: PValuePacked;
begin
Write(SizeOf(TValuePacked), ', ');
SetLength(arr_packed, size);
t:=Now;
p:=@arr_packed[0];
pend:=@arr_packed[size-1];
while p<=pend do
begin
s+=p.IntVal;
inc(p);
end;
WriteLn('Packed 2: ',(Now-t)*MSecsPerDay:0:0, ' ms.');
SetLength(arr_packed, 0);
end;
begin
bench_notpacked1;
bench_notpacked2;
bench_packed1;
bench_packed2;
ReadLn;
end.