classes.pp 2.7 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146
  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. sortbase;
  45. {$ENDIF FPC_DOTTEDUNITS}
  46. {$i classesh.inc}
  47. implementation
  48. {$IFDEF FPC_DOTTEDUNITS}
  49. uses
  50. UnixApi.Base,UnixApi.Unix
  51. ;
  52. {$ELSE FPC_DOTTEDUNITS}
  53. uses
  54. BaseUnix,unix
  55. ;
  56. {$ENDIF FPC_DOTTEDUNITS}
  57. {$IFDEF LINUX}
  58. {$DEFINE HAS_TTHREAD_GETSYSTEMTIMES}
  59. class function TThread.GetSystemTimes(out aSystemTimes : TSystemTimes) : Boolean;
  60. const
  61. StatFile = '/proc/stat';
  62. CPULine = 'cpu';
  63. var
  64. Line: string;
  65. aFile : Text;
  66. Idle : Int64;
  67. Function GetNextWord(var l : String) : String;
  68. var
  69. P : Integer;
  70. begin
  71. P:=Pos(' ',L);
  72. if P=0 then
  73. P:=Length(L)+1;
  74. Result:=Copy(L,1,P-1);
  75. Delete(L,1,P);
  76. L:=Trim(L);
  77. end;
  78. Function GetNextInt : Int64; inline;
  79. begin
  80. Result:=StrToint64(GetNextWord(Line));
  81. end;
  82. begin
  83. Result := False;
  84. aSystemTimes:=Default(TThread.TSystemTimes);
  85. {$i-}
  86. AssignFile(aFile,StatFile);
  87. Reset(aFile);
  88. if IOResult<>0 then
  89. exit;
  90. {$i+}
  91. While not EOF(aFile) do
  92. begin
  93. ReadLn(aFile,Line);
  94. if Pos(CPULine,Line)>0 then
  95. begin
  96. GetNextWord(Line); // Skip "cpu"
  97. // cpuN usertime nicetime kerneltime idletime
  98. With aSystemTimes do
  99. begin
  100. Inc(UserTime, GetNextInt);
  101. Inc(NiceTime, GetNextInt);
  102. Inc(KernelTime, GetNextInt);
  103. Idle:=GetNextInt;
  104. Inc(KernelTime,Idle); // windows seems to count idle as kernel
  105. Inc(IdleTime,Idle);
  106. end;
  107. Result:=True;
  108. end
  109. end;
  110. CloseFile(aFile);
  111. end;
  112. {$ENDIF}
  113. { OS - independent class implementations are in /inc directory. }
  114. {$i classes.inc}
  115. initialization
  116. CommonInit;
  117. finalization
  118. CommonCleanup;
  119. if ThreadsInited then
  120. DoneThreads;
  121. end.