My_Graduate (664911), страница 5

Просмтор этого файла доступен только зарегистрированным пользователям. Но у нас супер быстрая регистрация: достаточно только электронной почты!

Текст из файла (страница 5)

DeviceID : Word;

begin

Result := False;

S := Drive + ':';

Flags := mci_Open_Type or mci_Open_Element;

With OpenParm do begin

dwCallback := 0;

lpstrDeviceType := 'CDAudio';

lpstrElementName := PChar(S);

end;

Res := mciSendCommand(0, mci_Open, Flags, Longint(@OpenParm));

IF Res <> 0 Then Exit;

DeviceID := OpenParm.wDeviceID;

try

Res := mciSendCommand(DeviceID, MCI_SET, MCI_SET_DOOR_CLOSED, 0);

IF Res = 0 Then

Result := True;

finally

mciSendCommand(DeviceID, mci_Close, Flags, Longint(@OpenParm));

end;

end;

procedure Delay(msecs : Longint);

var

FirstTick : Longint;

begin

FirstTick := GetTickCount;

repeat

Application.ProcessMessages;

until GetTickCount - FirstTick >= msecs;

end;

procedure TDiadnostic.Button1Click(Sender: TObject);

var disk1:integer;

begin

for disk1:=0 to diskname.items.count-1 do

begin

if CheckDriveType(diskname.items[disk1][1])='CD-ROM'

then

begin

opencd(diskname.items[disk1][1]);

delay(5000);

closecd(diskname.items[disk1][1]);

end;

end;

end;

procedure TDiadnostic.SpeedButton1Click(Sender: TObject);

begin

form1.show;

end;

procedure TDiadnostic.SpeedButton2Click(Sender: TObject);

begin

//ShellExecute(handle,nil,'mem.exe',nil,nil,sw_restore);

MessageDlg('Тестирующая программа загружена в оперативную память',mtInformation,[mbok],0);

end;

end.

//модуль тестирования процессора

unit ProcessorClockCounter;

interface

uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type

TClockPriority=(cpIdle, cpNormal, cpHigh, cpRealTime, cpProcessDefined);

TPrecizeProc = procedure(Sender: TObject) of Object;

TProcessorClockCounter = class(TComponent)

private

FCache:array[0..(1 shl 19) - 1] of byte; // 512 Kb NOP instructions is enough to clear cache

FStarted:DWORD;

FClockPriority:TClockPriority;

FProcessHandle:HWND;

FCurrentProcessPriority: Integer;

FDesiredProcessPriority: Integer;

FThreadHandle:HWND;

FCurrentThreadPriority: Integer;

FDesiredThreadPriority: Integer;

FCalibration:int64; //used to

FPrecizeCalibration:int64;

FStartValue:int64;

FStopValue:int64;

FDeltaValue:int64;

FPrecizeProc:TPrecizeProc;

FCounterSupported:boolean;

procedure PrecizeStart;

procedure PrecizeStartInCache;

procedure GetProcInf;

procedure SetClockPriority(Value: TClockPriority);

procedure ProcedureWithoutInstruction; //description is in code

function GetClock:Int64; register;

function GetStarted:Boolean;

protected

procedure AdjustPriority; virtual; // internal used in constructor to setup parameters when class is created in RunTime

function CheckCounterSupported:boolean;

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

procedure Calibrate;

procedure Start;

procedure Stop;

procedure EraseCache;

procedure TestPrecizeProc; virtual;

procedure TestPrecizeProcInCache; virtual;

property Counter:int64 read FDeltaValue; // contain the measured test clock pulses (StopValue - StartValue - Calibration)

property StartValue:int64 read FStartValue; // Value on the begining

property StopValue:int64 read FStopValue; // Value on test finished

property Started:Boolean read GetStarted;

property CurrentClock:int64 read GetClock; // for longer tests this 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.

Характеристики

Список файлов реферата