Утилита диагностики компьютера

could be use to get current counter

published

property ClockPriority:TClockPriority read FClockPriority write

SetClockPriority default cpNormal;

property Calibration:int64 read FCalibration; // this is used to nullify

self code execution timing

property OnPrecizeProc:TPrecizeProc read FPrecizeProc write

FPrecizeProc; // user can define it for testing part of code inside it

property CounterSupported:boolean read FCounterSupported;

end;

procedure Register;

implementation

procedure Register;

begin

RegisterComponents('ASM Utils', [TProcessorClockCounter]);

end;

constructor TProcessorClockCounter.Create(AOwner: TComponent);

var n:integer;

begin

inherited create(AOwner);

FCounterSupported:=CheckCounterSupported;

for n:=0 to High(FCache)-1 do FCache[n]:=$90; // fill with NOP

instructions

FCache[High(FCache)]:=$C3; // the last is the RET

instruction

FClockPriority:=cpNormal;

FStarted:=0;

FDesiredProcessPriority:=NORMAL_PRIORITY_CLASS;

FDesiredThreadPriority :=THREAD_PRIORITY_NORMAL;

AdjustPriority;

Calibrate;

FStartValue:=0;

FStopValue:=0;

FDeltaValue:=0;

end;

destructor TProcessorClockCounter.Destroy;

begin

inherited destroy;

end;

procedure TProcessorClockCounter.GetProcInf;

begin

FProcessHandle:=GetCurrentProcess;

FCurrentProcessPriority:=GetPriorityClass(FProcessHandle);

FThreadHandle:=GetCurrentThread;

FCurrentThreadPriority:=GetThreadPriority(FThreadHandle);

end;

procedure TProcessorClockCounter.AdjustPriority;

begin

GetProcInf;

case FDesiredProcessPriority of

IDLE_PRIORITY_CLASS: FClockPriority:=cpIdle;

NORMAL_PRIORITY_CLASS: FClockPriority:=cpNormal;

HIGH_PRIORITY_CLASS: FClockPriority:=cpHigh;

REALTIME_PRIORITY_CLASS: FClockPriority:=cpRealTime;

end;

end;

procedure TProcessorClockCounter.SetClockPriority(Value: TClockPriority);

begin

if Value<>FClockPriority then

begin

FClockPriority:=Value;

case FClockPriority of

cpIdle: begin

FDesiredProcessPriority:=IDLE_PRIORITY_CLASS;

FDesiredThreadPriority :=THREAD_PRIORITY_IDLE;

end;

cpNormal: begin

FDesiredProcessPriority:=NORMAL_PRIORITY_CLASS;

FDesiredThreadPriority :=THREAD_PRIORITY_NORMAL;

end;

cpHigh: begin

FDesiredProcessPriority:=HIGH_PRIORITY_CLASS;

FDesiredThreadPriority :=THREAD_PRIORITY_HIGHEST;

end;

cpRealTime:begin

FDesiredProcessPriority:=REALTIME_PRIORITY_CLASS;

FDesiredThreadPriority :=THREAD_PRIORITY_TIME_CRITICAL;

end;

cpProcessDefined:

begin

FDesiredProcessPriority:=FCurrentProcessPriority;

FDesiredThreadPriority :=FCurrentThreadPriority;

end;

end;

Calibrate;

end;

end;

procedure TProcessorClockCounter.TestPrecizeProc;

// This procedure is intended for testing small block of

// code when it must be put in the processor cache

begin

FDeltaValue:=0;

if FCounterSupported and assigned(FPrecizeProc) then

begin

PrecizeStart; // start test

end;

end;

procedure TProcessorClockCounter.TestPrecizeProcInCache;

// This procedure is intended for testing small block of

// code when it is already in the processor cache

begin

FDeltaValue:=0;

if FCounterSupported and assigned(FPrecizeProc) then

begin

EraseCache;

PrecizeStartInCache; // first test will fill processor cache

PrecizeStartInCache; // second test

// generate calibration value for

// code already put in the cache

end;

end;

procedure TProcessorClockCounter.ProcedureWithoutInstruction;

// this is used for calibration! DO NOT CHANGE

asm

ret

end;

procedure TProcessorClockCounter.EraseCache; register;

asm

push ebx

lea ebx,[eax + FCache]

call ebx // force call to code in array :)

pop ebx // this will fill level2 cache with NOPs (For

motherboards with 1 Mb level 2 cache,

ret // size of array should be increased to 1 Mb)

// next instructions are never executed but need for proper align of 16

byte.

// Some processors has different execution times when code is not 16 byte

aligned

// Actually, (on some processors), internal mechanism of level 1 cache

(cache built

// in processor) filling is designed to catch memory block faster, when

// it is 16 byte aligned !!!

nop

nop

nop

nop

nop

nop

end;

function TProcessorClockCounter.GetClock: Int64; register;

asm

push edx

push ebx

push eax

mov ebx,eax

xor eax,eax // EAX & EDX are initialized to

zero for

mov edx,eax // testing counter support

DW $310f // This instruction will make

exception

sub eax,dword ptr [ebx+FStartValue] // or do nothing on processors

wthout

sbb edx,dword ptr [ebx+FStartValue+4] // counter support

sub eax,dword ptr [ebx+FCalibration]

sbb edx,dword ptr [ebx+FCalibration+4]

mov dword ptr [esp + $10],eax

mov dword ptr [esp + $14],edx

pop eax

pop ebx

pop edx

ret

end;

procedure TProcessorClockCounter.PrecizeStartInCache; register;

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 г.

-----------------------

1

[pic]

[pic]

[pic]

[pic]

[pic]

[pic]

[pic]

Страницы: 1, 2, 3, 4