Browse Source

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

Michaël Van Canneyt 1 year ago
parent
commit
af3ebf1464
3 changed files with 90 additions and 2 deletions
  1. 22 1
      rtl/objpas/classes/classes.inc
  2. 2 1
      rtl/objpas/classes/classesh.inc
  3. 66 0
      rtl/unix/classes.pp

+ 22 - 1
rtl/objpas/classes/classes.inc

@@ -898,13 +898,34 @@ end;
 
 
 
 
 {$ifndef HAS_TTHREAD_GETSYSTEMTIMES}
 {$ifndef HAS_TTHREAD_GETSYSTEMTIMES}
-class procedure TThread.GetSystemTimes(out aSystemTimes: TSystemTimes);
+class function TThread.GetSystemTimes(out aSystemTimes: TSystemTimes) : Boolean;
 begin
 begin
   { by default we just return a zeroed out record }
   { by default we just return a zeroed out record }
   FillChar(aSystemTimes, SizeOf(aSystemTimes), 0);
   FillChar(aSystemTimes, SizeOf(aSystemTimes), 0);
+  Result:=False;
 end;
 end;
 {$endif}
 {$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;
 class function TThread.GetTickCount: LongWord;
 begin
 begin

+ 2 - 1
rtl/objpas/classes/classesh.inc

@@ -2313,7 +2313,8 @@ type
     class procedure Yield; static;
     class procedure Yield; static;
     { use HAS_TTHREAD_GETSYSTEMTIMES to implement a platform specific variant
     { use HAS_TTHREAD_GETSYSTEMTIMES to implement a platform specific variant
       which does not return a zeroed record }
       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 GetTickCount: LongWord; static; deprecated 'Use TThread.GetTickCount64 instead';
     class function GetTickCount64: QWord; static;
     class function GetTickCount64: QWord; static;
     // Object based
     // Object based

+ 66 - 0
rtl/unix/classes.pp

@@ -66,6 +66,72 @@ uses
   ;
   ;
 {$ENDIF FPC_DOTTEDUNITS}
 {$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. }
 { OS - independent class implementations are in /inc directory. }
 {$i classes.inc}
 {$i classes.inc}