mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-12-05 17:27:26 +01:00
* Change GetSystemTimes signature to be delphi compatible, implement for linux
This commit is contained in:
parent
81ae7063f3
commit
af3ebf1464
@ -898,13 +898,34 @@ end;
|
||||
|
||||
|
||||
{$ifndef HAS_TTHREAD_GETSYSTEMTIMES}
|
||||
class procedure TThread.GetSystemTimes(out aSystemTimes: TSystemTimes);
|
||||
class function TThread.GetSystemTimes(out aSystemTimes: TSystemTimes) : Boolean;
|
||||
begin
|
||||
{ by default we just return a zeroed out record }
|
||||
FillChar(aSystemTimes, SizeOf(aSystemTimes), 0);
|
||||
Result:=False;
|
||||
end;
|
||||
{$endif}
|
||||
|
||||
class function TThread.GetCPUUsage(var Previous: TSystemTimes): Integer;
|
||||
|
||||
var
|
||||
Act : TSystemTimes;
|
||||
Load,Idle: QWord;
|
||||
|
||||
begin
|
||||
Result:=0;
|
||||
if not GetSystemTimes(Act) then
|
||||
exit;
|
||||
Load:=(Act.UserTime-Previous.UserTime) +
|
||||
(Act.KernelTime-Previous.KernelTime) +
|
||||
(Act.NiceTime-Previous.NiceTime);
|
||||
Idle:=Act.IdleTime-Previous.IdleTime;
|
||||
Previous:=Act;
|
||||
if (Load<>0) and (Load>Idle) then
|
||||
Result:=100*Trunc(1-(Idle/Load));
|
||||
end;
|
||||
|
||||
|
||||
|
||||
class function TThread.GetTickCount: LongWord;
|
||||
begin
|
||||
|
||||
@ -2313,7 +2313,8 @@ type
|
||||
class procedure Yield; static;
|
||||
{ use HAS_TTHREAD_GETSYSTEMTIMES to implement a platform specific variant
|
||||
which does not return a zeroed record }
|
||||
class procedure GetSystemTimes(out aSystemTimes: TSystemTimes); static;
|
||||
class function GetSystemTimes(out aSystemTimes: TSystemTimes) : boolean; static;
|
||||
class function GetCPUUsage(var Previous: TSystemTimes): Integer;
|
||||
class function GetTickCount: LongWord; static; deprecated 'Use TThread.GetTickCount64 instead';
|
||||
class function GetTickCount64: QWord; static;
|
||||
// Object based
|
||||
|
||||
@ -66,6 +66,72 @@ uses
|
||||
;
|
||||
{$ENDIF FPC_DOTTEDUNITS}
|
||||
|
||||
{$IFDEF LINUX}
|
||||
{$DEFINE HAS_TTHREAD_GETSYSTEMTIMES}
|
||||
class function TThread.GetSystemTimes(out aSystemTimes : TSystemTimes) : Boolean;
|
||||
|
||||
const
|
||||
StatFile = '/proc/stat';
|
||||
CPULine = 'cpu';
|
||||
|
||||
var
|
||||
Line: string;
|
||||
aFile : Text;
|
||||
Idle : Int64;
|
||||
|
||||
Function GetNextWord(var l : String) : String;
|
||||
|
||||
var
|
||||
P : Integer;
|
||||
|
||||
begin
|
||||
P:=Pos(' ',L);
|
||||
if P=0 then
|
||||
P:=Length(L)+1;
|
||||
Result:=Copy(L,1,P-1);
|
||||
Delete(L,1,P);
|
||||
L:=Trim(L);
|
||||
end;
|
||||
|
||||
Function GetNextInt : Int64; inline;
|
||||
|
||||
begin
|
||||
Result:=StrToint64(GetNextWord(Line));
|
||||
end;
|
||||
|
||||
begin
|
||||
Result := False;
|
||||
aSystemTimes:=Default(TThread.TSystemTimes);
|
||||
{$i-}
|
||||
AssignFile(aFile,StatFile);
|
||||
Reset(aFile);
|
||||
if IOResult<>0 then
|
||||
exit;
|
||||
{$i+}
|
||||
While not EOF(aFile) do
|
||||
begin
|
||||
ReadLn(aFile,Line);
|
||||
if Pos(CPULine,Line)>0 then
|
||||
begin
|
||||
GetNextWord(Line); // Skip "cpu"
|
||||
// cpuN usertime nicetime kerneltime idletime
|
||||
With aSystemTimes do
|
||||
begin
|
||||
Inc(UserTime, GetNextInt);
|
||||
Inc(NiceTime, GetNextInt);
|
||||
Inc(KernelTime, GetNextInt);
|
||||
Idle:=GetNextInt;
|
||||
Inc(KernelTime,Idle); // windows seems to count idle as kernel
|
||||
Inc(IdleTime,Idle);
|
||||
end;
|
||||
Result:=True;
|
||||
end
|
||||
end;
|
||||
CloseFile(aFile);
|
||||
end;
|
||||
{$ENDIF}
|
||||
|
||||
|
||||
{ OS - independent class implementations are in /inc directory. }
|
||||
{$i classes.inc}
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user