program project1;
{$mode objfpc}{$H+}
{$LONGSTRINGS ON}
{$APPTYPE CONSOLE}
uses
SysUtils, {$IfDef UNIX}UnixType{$EndIf} {$IfDef Windows} Windows{$EndIf};
{$IfDef WINDOWS}
const LIBC = 'msvcrt';
{$IFDEF FPC}
{$LINKLIB libmsvcrt.a} // Taken from ZenGL. The program on Windows did not start without them.
{$ENDIF}
{$Else}
const LIBC = 'libc';
{$ENDIF WINDOWS}
var
timeStart, timeEnd, timerStart: Double;
{$IfDef UNIX}{$IfNDef MAC_COCOA}
timerTimeVal: TimeVal;
{$Else}
timerTimebaseInfo: mach_timebase_info_t;
{$ENDIF}
{$ENDIF}
{$IFDEF WINDOWS}
timerFrequency: Int64;
{$ENDIF}
timeOld, timeNew: Double;
{$IfDef UNIX}{$IfNDef MAC_COCOA}
function fpGetTimeOfDay(val: PTimeVal; tzp: Pointer): Integer; cdecl; external 'libc' name 'gettimeofday';
{$Else}
type
mach_timebase_info_t = record
numer: LongWord;
denom: LongWord;
end;
function mach_timebase_info(var info: mach_timebase_info_t): Integer; cdecl; external 'libc';
function mach_absolute_time: QWORD; cdecl; external 'libc';
{$ENDIF}{$EndIf}
// LibC memset linking
function libc_memset(destpp: pointer; c: Integer; len: SizeUInt): Pointer; external LIBC name 'memset';
// запрос таймера, оставляю для всех систем
function timer_GetTicks: Double;
{$IFDEF WINDOWS}
var
t: int64;
m: LongWord;
{$EndIf}
begin
{$IfDef UNIX}{$IfNDef MAC_COCOA}
fpGetTimeOfDay(@timerTimeVal, nil);
{$Q-}
// FIXME: почему-то overflow вылетает с флагом -Co
Result := timerTimeVal.tv_sec * 1000 + timerTimeVal.tv_usec / 1000 - timerStart;
{$Q+}
{$Else}
Result := mach_absolute_time() * timerTimebaseInfo.numer / timerTimebaseInfo.denom / 1000000 - timerStart;
{$ENDIF}{$EndIf}
{$IFDEF WINDOWS}
m := SetThreadAffinityMask(GetCurrentThread(), 1);
QueryPerformanceCounter(t);
Result := 1000 * t / timerFrequency - timerStart;
SetThreadAffinityMask(GetCurrentThread(), m);
{$ENDIF}
end;
procedure memset(dstpp: Pointer; c: byte; len: SizeInt); // replaced, only for i386/x86_64 processors!!!
begin
{$IfDef cpui386}
asm
movl dstpp,%edi
movl len,%ecx
dec %ecx
cld
movb c,%al
rep stosb
end;
{$Else}
asm
movq dstpp,%rdi
movq len,%rcx
dec %ecx
cld
movb c,%al
rep stosb
end;
{$EndIf}
end;
procedure TestFillChar(Buff: PByte; Size: SizeInt; Iterations: Integer);
var
i: Integer;
sidx, eidx: Int64;
begin
for i:=1 to Iterations do
begin
sidx := 33; // Random(64);
eidx := size - 1;// - Random(64);
FillChar(Buff[sidx], eidx - sidx, {Random(256)}67);
end;
end;
procedure TestMemset(Buff: PByte; Size: SizeInt; Iterations: Integer);
var
i: Integer;
sidx, eidx: Int64;
begin
for i:=1 to Iterations do
begin
sidx := 33; // Random(64);
eidx := size - 1;// - Random(64);
memset(@Buff[sidx], {Random(256)}67, eidx - sidx);
end;
end;
procedure TestCMemset(Buff: PByte; Size: SizeInt; Iterations: Integer);
var
i: Integer;
sidx, eidx: Int64;
begin
for i:=1 to Iterations do
begin
sidx := 33; // Random(64);
eidx := size - 1;// - Random(64);
libc_memset(@Buff[sidx], {Random(256)}67, eidx - sidx);
end;
end;
const
bsize = 1024*32;
iters = 1000000;
var
start: Double;
buff: array[0..bsize-1] of byte;
i: Integer;
begin
{$IFDEF WINDOWS}
SetThreadAffinityMask(GetCurrentThread(), 1);
QueryPerformanceFrequency(timerFrequency);
{$ENDIF}
timerStart := timer_GetTicks();
Randomize;
timerStart := timer_GetTicks();
timeOld := 0;
timeNew := 0;
start := timer_GetTicks;
TestFillChar(@buff, bsize, iters);
WriteLn('FillChar: ', timer_GetTicks - start);
start := timer_GetTicks;
TestMemset(@buff, bsize, iters);
WriteLn('Memset: ', timer_GetTicks - start);
start := timer_GetTicks;
TestCMemset(@buff, bsize, iters);
WriteLn('LibC Memset: ', timer_GetTicks - start);
ReadLn;
end.