* Change GetSystemTimes signature to be delphi compatible, implement for linux

This commit is contained in:
Michaël Van Canneyt 2024-01-15 15:38:46 +01:00
parent 81ae7063f3
commit af3ebf1464
3 changed files with 90 additions and 2 deletions

View File

@ -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

View File

@ -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

View File

@ -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}