classes.pp 2.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149
  1. {
  2. This file is part of the Free Component Library (FCL)
  3. Copyright (c) 1999-2000 by Michael Van Canneyt and Florian Klaempfl
  4. Classes unit for linux
  5. See the file COPYING.FPC, included in this distribution,
  6. for details about the copyright.
  7. This program is distributed in the hope that it will be useful,
  8. but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  10. **********************************************************************}
  11. {$mode objfpc}
  12. {$h+}
  13. {$modeswitch advancedrecords}
  14. {$IF FPC_FULLVERSION>=30301}
  15. {$modeswitch FUNCTIONREFERENCES}
  16. {$define FPC_HAS_REFERENCE_PROCEDURE}
  17. {$endif}
  18. { determine the type of the resource/form file }
  19. {$define Win16Res}
  20. {$IFNDEF FPC_DOTTEDUNITS}
  21. unit Classes;
  22. {$ENDIF FPC_DOTTEDUNITS}
  23. {$INLINE ON}
  24. interface
  25. {$IFDEF FPC_DOTTEDUNITS}
  26. uses
  27. System.SysUtils,
  28. System.Types,
  29. System.TypInfo,
  30. {$ifdef FPC_TESTGENERICS}
  31. System.FGL,
  32. {$endif}
  33. System.RtlConsts,
  34. System.SortBase;
  35. {$ELSE FPC_DOTTEDUNITS}
  36. uses
  37. sysutils,
  38. types,
  39. typinfo,
  40. {$ifdef FPC_TESTGENERICS}
  41. fgl,
  42. {$endif}
  43. rtlconsts,
  44. {$IF DEFINED(CPUARM) or DEFINED(CPUAARCH64) }
  45. intrinsics,
  46. {$ENDIF}
  47. sortbase;
  48. {$ENDIF FPC_DOTTEDUNITS}
  49. {$i classesh.inc}
  50. implementation
  51. {$IFDEF FPC_DOTTEDUNITS}
  52. uses
  53. UnixApi.Base,UnixApi.Unix
  54. ;
  55. {$ELSE FPC_DOTTEDUNITS}
  56. uses
  57. BaseUnix,unix
  58. ;
  59. {$ENDIF FPC_DOTTEDUNITS}
  60. {$IFDEF LINUX}
  61. {$DEFINE HAS_TTHREAD_GETSYSTEMTIMES}
  62. class function TThread.GetSystemTimes(out aSystemTimes : TSystemTimes) : Boolean;
  63. const
  64. StatFile = '/proc/stat';
  65. CPULine = 'cpu';
  66. var
  67. Line: string;
  68. aFile : Text;
  69. Idle : Int64;
  70. Function GetNextWord(var l : String) : String;
  71. var
  72. P : Integer;
  73. begin
  74. P:=Pos(' ',L);
  75. if P=0 then
  76. P:=Length(L)+1;
  77. Result:=Copy(L,1,P-1);
  78. Delete(L,1,P);
  79. L:=Trim(L);
  80. end;
  81. Function GetNextInt : Int64; inline;
  82. begin
  83. Result:=StrToint64(GetNextWord(Line));
  84. end;
  85. begin
  86. Result := False;
  87. aSystemTimes:=Default(TThread.TSystemTimes);
  88. {$i-}
  89. AssignFile(aFile,StatFile);
  90. Reset(aFile);
  91. if IOResult<>0 then
  92. exit;
  93. {$i+}
  94. While not EOF(aFile) do
  95. begin
  96. ReadLn(aFile,Line);
  97. if Pos(CPULine,Line)>0 then
  98. begin
  99. GetNextWord(Line); // Skip "cpu"
  100. // cpuN usertime nicetime kerneltime idletime
  101. With aSystemTimes do
  102. begin
  103. Inc(UserTime, GetNextInt);
  104. Inc(NiceTime, GetNextInt);
  105. Inc(KernelTime, GetNextInt);
  106. Idle:=GetNextInt;
  107. Inc(KernelTime,Idle); // windows seems to count idle as kernel
  108. Inc(IdleTime,Idle);
  109. end;
  110. Result:=True;
  111. end
  112. end;
  113. CloseFile(aFile);
  114. end;
  115. {$ENDIF}
  116. { OS - independent class implementations are in /inc directory. }
  117. {$i classes.inc}
  118. initialization
  119. CommonInit;
  120. finalization
  121. CommonCleanup;
  122. if ThreadsInited then
  123. DoneThreads;
  124. end.