ltimevalstuff.pas

   1 { Copyright (C) 2005 Bas Steendijk and Peter Green\r
   2   For conditions of distribution and use, see copyright notice in zlib_license.txt\r
   3   which is included in the package\r
   4   ----------------------------------------------------------------------------- }\r
   5 \r
   6 {$ifdef fpc}\r
   7   {$mode delphi}\r
   8 {$endif}\r
   9 \r
  10 unit ltimevalstuff;\r
  11 interface\r
  12 \r
  13 {$ifdef mswindows}\r
  14   type\r
  15     ttimeval = record\r
  16       tv_sec : longint; \r
  17       tv_usec : longint; \r
  18     end;\r
  19 {$else}\r
  20   {$ifdef ver1_0}\r
  21     uses linux;\r
  22   {$else}\r
  23     uses \r
  24       {$ifdef linux}linux,{$endif} //for clock_gettime\r
  25       {$ifdef freebsd}freebsd,{$endif} //for clock_gettime      \r
  26       baseunix,unix,unixutil,sockets;\r
  27   {$endif}\r
  28 {$endif}\r
  29                                 \r
  30 \r
  31 procedure tv_add(var tv:ttimeval;msec:integer);\r
  32 function tv_compare(const tv1,tv2:ttimeval):boolean;\r
  33 procedure tv_subtract(var tv:ttimeval;const tv2:ttimeval);\r
  34 procedure msectotimeval(var tv:ttimeval;msec:integer);\r
  35 \r
  36 {$ifdef unix}\r
  37 //for internal use by lcore as a replacement for gettimeofday -beware\r
  38 procedure gettimemonotonic(var tv:ttimeval);\r
  39 {$endif}\r
  40 \r
  41 //tv_invalidtimebig will always compare as greater than any valid timeval\r
  42 //unfortunately unixstuff.inc hasn't worked it's magic yet so we\r
  43 //have to ifdef this manually.\r
  44 const\r
  45   {$ifdef ver1_0}\r
  46     tv_invalidtimebig : ttimeval = (sec:maxlongint;usec:maxlongint);\r
  47   {$else}\r
  48     tv_invalidtimebig : ttimeval = (tv_sec:maxlongint;tv_usec:maxlongint);\r
  49   {$endif}\r
  50 implementation\r
  51 \r
  52 {$i unixstuff.inc}\r
  53 \r
  54 {add nn msec to tv}\r
  55 procedure tv_add(var tv:ttimeval;msec:integer);\r
  56 begin\r
  57   inc(tv.tv_usec,msec*1000);\r
  58   inc(tv.tv_sec,tv.tv_usec div 1000000);\r
  59   tv.tv_usec := tv.tv_usec mod 1000000;\r
  60 end;\r
  61 \r
  62 {tv1 >= tv2}\r
  63 function tv_compare(const tv1,tv2:ttimeval):boolean;\r
  64 begin\r
  65   if tv1.tv_sec = tv2.tv_sec then begin\r
  66     result := tv1.tv_usec >= tv2.tv_usec;\r
  67   end else result := tv1.tv_sec > tv2.tv_sec;\r
  68 end;\r
  69 \r
  70 procedure tv_subtract(var tv:ttimeval;const tv2:ttimeval);\r
  71 begin\r
  72   dec(tv.tv_usec,tv2.tv_usec);\r
  73   if tv.tv_usec < 0 then begin\r
  74     inc(tv.tv_usec,1000000);\r
  75     dec(tv.tv_sec)\r
  76   end;\r
  77   dec(tv.tv_sec,tv2.tv_sec);\r
  78 end;\r
  79 \r
  80 procedure msectotimeval(var tv:ttimeval;msec:integer);\r
  81 begin\r
  82   tv.tv_sec := msec div 1000;\r
  83   tv.tv_usec := (msec mod 1000)*1000;\r
  84 end;\r
  85 \r
  86 \r
  87 {$ifdef unix}\r
  88 {$ifdef linux}{$define have_clock_gettime}{$endif}\r
  89 {$ifdef freebsd}{$define have_clock_gettime}{$endif}\r
  90 \r
  91 procedure gettimemonotonic(var tv:ttimeval);\r
  92 var\r
  93   ts:ttimespec;\r
  94 begin\r
  95   {$ifdef have_clock_gettime}\r
  96   if (clock_gettime(CLOCK_MONOTONIC, @ts) = 0) then begin\r
  97     tv.tv_sec := ts.tv_sec;\r
  98     tv.tv_usec := ts.tv_nsec div 1000;\r
  99     exit;\r
 100   end;\r
 101   {$endif}\r
 102   gettimeofday(tv);\r
 103 end;\r
 104 {$endif}\r
 105 \r
 106 end.\r