asm
//this address should be 16 byte aligned
push edx
push ebx
push eax
mov ebx,eax
push eax
mov dword ptr [ebx + FStarted],1 // started:=true
DW $310f //START
mov dword ptr [ebx + FStartValue],eax // startvalue:=counter
mov dword ptr [ebx + FStartValue + 4],edx
mov edx,[ebx + FPrecizeProc + 4] //time equvialent
mov ebx,ebx
nop
nop
nop
call ProcedureWithoutInstruction // call procedure with immediate back
DW $310f //STOP
mov dword ptr [ebx + FStopValue],eax // stopvalue:=counter
mov dword ptr [ebx + FStopValue + 4],edx
sub eax,dword ptr [ebx + FStartValue]
sbb edx,dword ptr [ebx + FStartValue + 4]
mov dword ptr [ebx + FPrecizeCalibration],eax // calibration:=stopvalue - startvalue
mov dword ptr [ebx + FPrecizeCalibration + 4],edx
nop // need for proper align !!!
nop
nop
nop
nop
nop
nop
nop
nop
nop
nop
nop
DW $310f //START
mov dword ptr [ebx + FStartValue],eax // startvalue:=counter
mov dword ptr [ebx + FStartValue + 4],edx
mov eax,[ebx + FPrecizeProc + 4]
mov edx,ebx
call [ebx + FPrecizeProc]
DW $310f //STOP
pop ebx
mov dword ptr [ebx + FStopValue],eax // stopvalue:=counter
mov dword ptr [ebx + FStopValue + 4],edx
sub eax,dword ptr [ebx + FStartValue]
sbb edx,dword ptr [ebx + FStartValue + 4]
sub eax,dword ptr [ebx + FPrecizeCalibration]
sbb edx,dword ptr [ebx + FPrecizeCalibration + 4]
mov dword ptr [ebx + FDeltaValue],eax // deltavalue:=stopvalue - startvalue - calibration
mov dword ptr [ebx + FDeltaValue + 4],edx
pop eax
pop ebx
pop edx
ret
nop
nop
nop
nop
nop
nop
nop
nop
nop
nop
nop
nop
end;
procedure TProcessorClockCounter.PrecizeStart; register;
asm
//this address should be 16 byte aligned
push edx
push ebx
push eax
call EraseCache // fill cache with NOPs while executing it
mov ebx,eax
push eax
mov dword ptr [ebx + FStarted],1 // started:=true
nop // need for proper align
nop
nop
nop
nop
nop
nop
nop
nop
nop
nop
DW $310f //START
mov dword ptr [ebx + FStartValue],eax // startvalue:=counter
mov dword ptr [ebx + FStartValue + 4],edx
mov edx,[ebx + FPrecizeProc + 4] //time equvivalent
mov ebx,ebx
nop
nop
nop
call ProcedureWithoutInstruction // call procedure with immediate back
DW $310f //STOP
mov dword ptr [ebx + FStopValue],eax // stopvalue:=counter
mov dword ptr [ebx + FStopValue + 4],edx
sub eax,dword ptr [ebx + FStartValue]
sbb edx,dword ptr [ebx + FStartValue + 4]
mov dword ptr [ebx + FPrecizeCalibration],eax // calibration:=stopvalue - startvalue
mov dword ptr [ebx + FPrecizeCalibration + 4],edx
mov eax,ebx
call EraseCache; // fill cache with NOPs while executing it
nop // need for proper align !!!
nop
nop
nop
nop
DW $310f //START
mov dword ptr [ebx + FStartValue],eax // startvalue:=counter
mov dword ptr [ebx + FStartValue + 4],edx
mov eax,[ebx + FPrecizeProc + 4]
mov edx,ebx
call [ebx + FPrecizeProc]
DW $310f //STOP
pop ebx
mov dword ptr [ebx + FStopValue],eax // stopvalue:=counter
mov dword ptr [ebx + FStopValue + 4],edx
sub eax,dword ptr [ebx + FStartValue]
sbb edx,dword ptr [ebx + FStartValue + 4]
sub eax,dword ptr [ebx + FPrecizeCalibration]
sbb edx,dword ptr [ebx + FPrecizeCalibration + 4]
mov dword ptr [ebx + FDeltaValue],eax // deltavalue:=stopvalue - startvalue - calibration
mov dword ptr [ebx + FDeltaValue + 4],edx
pop eax
pop ebx
pop edx
end;
end.
//модуль диагностики
unit Systeminfo;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
Dialogs,extctrls;
type TDialupAdapterInfo = record //Информация о Dialup адаптере
alignment:dword;
buffer:dword;
bytesrecieved:dword;
bytesXmit:dword;
ConnectSpeed:dword;
CRC:dword;
framesrecieved:dword;
FramesXmit:dword;
Framing:dword;
runts:dword;
Overrun:dword;
timeout:dword;
totalbytesrecieved:dword;
totalbytesXmit:dword;
end;
type TKernelInfo = record
CpuUsagePcnt:dword;
Numthreads:dword;
NumVMS:dword;
end;
type TFATInfo = record
BreadsSec:dword;
BwritesSec:dword;
Dirtydata:dword;
ReadsSec:dword;
WritesSec:dword;
end;
type TVMMInfo = record
CDiscards:dword;
CInstancefaults:dword;
CPageFaults:dword;
cPageIns:dword;
cPageOuts:dword;
cpgCommit:dword;
cpgDiskCache:dword;
cpgDiskCacheMac:dword;
cpgDiskCacheMid:dword;
cpgDiskCacheMin:dword;
cpgfree:dword;
cpglocked:dword;
cpglockedNoncache:dword;
cpgother:dword;
cpgsharedpages:dword;
cpgswap:dword;
cpgswapfile:dword;
cpgswapfiledefective:dword;
cpgswapfileinuse:dword;
end;
type
TSysInfo = class(TComponent)
private
fDialupAdapterInfo:TDialupAdapterInfo;
fKernelInfo:TKernelInfo;
fVCACHEInfo:TVCACHEInfo;
fFATInfo:TFATInfo;
fVMMInfo:TVMMInfo;
ftimer:TTimer;
fupdateinterval:integer;
tmp:dword;
vsize:dword;
pkey:hkey;
regtype:pdword;
fstopped:boolean;
procedure fupdatinginfo(sender:tobject);
procedure fsetupdateinterval(aupdateinterval:integer);
protected
fsysInfoChanged:TNotifyEvent;
public
constructor Create(Aowner:Tcomponent);override;
destructor Destroy;override;
property DialupAdapterInfo: TDialupAdapterInfo read fDialupAdapterInfo;
property KernelInfo: TKernelInfo read fKernelInfo;
property VCACHEInfo: TVCACHEInfo read fVCACHEInfo;
property FATInfo: TFATInfo read fFATInfo;
property VMMInfo: TVMMInfo read fVMMInfo;
procedure StartRecievingInfo;
procedure StopRecievingInfo;
published
property SysInfoChanged:TNotifyEvent read fsysInfoChanged write
fsysInfoChanged;//Это событие вызывается после определённого интервала времени.
property UpdateInterval:integer read fupdateInterval write
fsetupdateinterval default 5000;
end;
procedure TSysInfo.startrecievingInfo;
var
res:integer;
begin
res:=RegOpenKeyEx(HKEY_DYN_DATA,'PerfStats\StartStat',0,KEY_ALL_ACCESS,pkey);
if res<>0 then
raise exception.Create('Could not open registry key');
fstopped:=false;
// Для Dial Up Адаптера
RegQueryValueEx(pkey,'Dial-Up Adapter\Alignment',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'Dial-Up Adapter\Buffer',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'Dial-Up Adapter\Framing',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'Dial-Up Adapter\Overrun ',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'Dial-Up Adapter\Timeout',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'Dial-Up Adapter\CRC',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'Dial-Up Adapter\Runts',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'Dial-Up Adapter\FramesXmit',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'Dial-Up Adapter\FramesRecvd',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'Dial-Up Adapter\BytesXmit',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'Dial-Up Adapter\BytesRecvd',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'Dial-Up Adapter\TotalBytesXmit',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'Dial-Up Adapter\TotalBytesRecvd',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'Dial-Up Adapter\ConnectSpeed',nil,regtype,@tmp,@vsize);
// Для VCACHE
RegQueryValueEx(pkey,'VCACHE\LRUBuffers',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VCACHE\FailedRecycles',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VCACHE\RandomRecycles',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VCACHE\LRURecycles',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VCACHE\Misses',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VCACHE\Hits',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VCACHE\cMacPages',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VCACHE\cMinPages',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VCACHE\cCurPages',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'Dial-Up Adapter\BytesXmit',nil,regtype,@tmp,@vsize);
//Для VFAT
RegQueryValueEx(pkey,'VFAT\DirtyData',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VFAT\BReadsSec',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VFAT\BWritesSec',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VFAT\ReadsSec',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VFAT\WritesSec',nil,regtype,@tmp,@vsize);
//Для VMM
RegQueryValueEx(pkey,'VMM\cpgLockedNoncache',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VMM\cpgCommit',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VMM\cpgSharedPages',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VMM\cpgDiskcacheMid',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VMM\cpgDiskcacheMac',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VMM\cpgDiskcacheMin',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VMM\cpgDiskcache',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VMM\cpgSwapfileDefective',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VMM\cpgSwapfileInUse',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VMM\cpgSwapfile',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VMM\cDiscards',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VMM\cPageOuts',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VMM\cPageIns',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VMM\cInstanceFaults',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VMM\cPageFaults',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VMM\cpgOther',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VMM\cpgSwap',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VMM\cpgLocked',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'VMM\cpgFree',nil,regtype,@tmp,@vsize);
//Для KERNEL
RegQueryValueEx(pkey,'KERNEL\CPUUsage',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'KERNEL\VMs',nil,regtype,@tmp,@vsize);
RegQueryValueEx(pkey,'KERNEL\Threads',nil,regtype,@tmp,@vsize);
RegCloseKey(pkey);
ftimer.enabled:=true;
end;
destructor tsysinfo.Destroy;
begin
StopRecievingInfo;
ftimer.Destroy;
inherited;
end;
procedure Register;
begin
RegisterComponents('Samples', [TSysInfo]);
end;
end.
// модуль диагностики процессора
unit example;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ProcessorClockCounter, StdCtrls;
type
TForm1 = class(TForm)
GroupBox1: TGroupBox;
StaticText1: TStaticText;
Button7: TButton;
Button8: TButton;
procedure pcc1PrecizeProc(Sender: TObject);
procedure pcc2PrecizeProc(Sender: TObject);
procedure pcc3PrecizeProc(Sender: TObject);
procedure pcc4PrecizeProc(Sender: TObject);
procedure pcc5PrecizeProc(Sender: TObject);
procedure pcc7PrecizeProc(Sender: TObject);
procedure pcc8PrecizeProc(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
// Тактовая частота
procedure TForm1.pcc1PrecizeProc(Sender: TObject);
begin
sleep(1000); //wait 1 s
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
button1.Caption:='Wait';
button1.Enabled:=false;
pcc1.TestPrecizeProcInCache;
label1.Caption:=IntToStr(pcc1.Counter)+' Hz';
button1.Caption:='Измерить тактовую частоту';
button1.Enabled:=true;
end;
// скорость выполнения арифметических операций
procedure TForm1.pcc2PrecizeProc(Sender: TObject);
var n:integer;
m:integer; // integer variable
begin
for n:=0 to 99 do m:=m+1;
end;
procedure TForm1.pcc3PrecizeProc(Sender: TObject);
var n:integer;
m:Int64; // Int64 variable
begin
for n:=0 to 99 do m:=m+1;
end;
procedure TForm1.pcc4PrecizeProc(Sender: TObject);
var n:integer;
m:single; // single type variable
begin
for n:=0 to 99 do m:=m + 1.0001;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
pcc2.TestPrecizeProcInCache;
label2.Caption:=IntToStr(pcc2.Counter)+' тактов';
pcc3.TestPrecizeProcInCache;
label3.Caption:=IntToStr(pcc3.Counter)+' тактов';
pcc4.TestPrecizeProcInCache;
label4.Caption:=IntToStr(pcc4.Counter)+' тактов';
end;
// скорость системный шины
procedure TForm1.pcc5PrecizeProc(Sender: TObject);
begin
asm
nop; nop; nop; nop; nop; nop; nop; nop;
nop; nop; nop; nop; nop; nop; nop; nop;
nop; nop; nop; nop; nop; nop; nop; nop;
nop; nop; nop; nop; nop; nop; nop; nop;
nop; nop; nop; nop; nop; nop; nop; nop;
nop; nop; nop; nop; nop; nop; nop; nop;
nop; nop; nop; nop; nop; nop; nop; nop;
nop; nop; nop; nop; nop; nop; nop; ret;
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
var cInRAM, cInCache:int64;
begin
pcc5.TestPrecizeProc; // Code is in RAM and will be pulled in cache
cInRAM:=pcc5.Counter;
label5.Caption:=IntToStr(cInRAM)+' тактов';
pcc5.TestPrecizeProcInCache; // Code is already in cache
cInCache:=pcc5.Counter;
label6.Caption:=IntToStr(cInCache)+' тактов';
label7.Caption:=IntToStr(cInRAM-cInCache)+ ' тактов';
end;
// скорость вызова приложений
procedure TForm1.Button4Click(Sender: TObject);
begin
pcc6.Start;
WinExec(PChar('Notepad.exe'),SW_SHOWNORMAL);
pcc6.Stop;
label8.Caption:=IntToStr(pcc6.Counter)+' тактов';
end;
// Example 5
procedure TForm1.pcc7PrecizeProc(Sender: TObject);
begin
refresh;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
pcc7.TestPrecizeProcInCache;
label9.Caption:=IntToStr(pcc7.Counter)+ ' тактов';
end;
// скорость заполнения кэша
procedure TForm1.pcc8PrecizeProc(Sender: TObject);
begin
asm nop end;
end;
procedure TForm1.Button6Click(Sender: TObject);
begin
pcc8.TestPrecizeProcInCache;
label10.Caption:=IntToStr(pcc8.Counter)+ ' тактов';
end;
procedure TForm1.Button7Click(Sender: TObject);
begin
MessageDlg('NOP - Пустая операция'#13 +
'это псевдоним инструкции XCHG (E)AX, (E)AX',
mtInformation,[mbok],0);
end;
procedure TForm1.Button8Click(Sender: TObject);
begin
MessageDlg('процессор Pentium IV'#13 +
'с частотой системной шины 400 МГц',
mtInformation,[mbok],0);
end;
end.
Министерство Образования и Культуры
Кыргызской Республики
Кыргызский Технический Университет
им. И. Раззакова.
Кафедра Информатики и Вычислительной Техники
Выпускная Работа
на тему: _________________________________________________
Выполнил: ст. гр. ЭВМ-1-99
Ыйсаев У.Б.
Принял(а): ______________________________
_________________________________________
Бишкек, 2003 г.