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 \r
  14 {$ifdef CONDITIONALEXPRESSIONS}{$define support_int64}{$endif}    //delphi 6 or later\r
  15 {$ifdef fpc}{$define support_int64}{$endif}\r
  16 \r
  17 {$ifdef mswindows}\r
  18   type\r
  19     ttimeval = record\r
  20       {$IFDEF support_int64}\r
  21       tv_sec : int64;\r
  22       {$ELSE}\r
  23       tv_sec : longint;\r
  24       {$ENDIF}\r
  25       tv_usec : longint;\r
  26     end;\r
  27 {$else}\r
  28   {$ifdef ver1_0}\r
  29     uses linux;\r
  30   {$else}\r
  31     uses \r
  32       {$ifdef linux}linux,{$endif} //for clock_gettime\r
  33       {$ifdef freebsd}freebsd,{$endif} //for clock_gettime      \r
  34       baseunix,unix,unixutil,sockets;\r
  35   {$endif}\r
  36 {$endif}\r
  37                                 \r
  38 \r
  39 procedure tv_add(var tv:ttimeval;msec:integer);\r
  40 function tv_compare(const tv1,tv2:ttimeval):boolean;\r
  41 procedure tv_subtract(var tv:ttimeval;const tv2:ttimeval);\r
  42 procedure msectotimeval(var tv:ttimeval;msec:integer);\r
  43 \r
  44 {$ifdef unix}\r
  45 //for internal use by lcore as a replacement for gettimeofday -beware\r
  46 procedure gettimemonotonic(var tv:ttimeval);\r
  47 {$endif}\r
  48 \r
  49 //tv_invalidtimebig will always compare as greater than any valid timeval\r
  50 //unfortunately unixstuff.inc hasn't worked it's magic yet so we\r
  51 //have to ifdef this manually.\r
  52 const\r
  53   {$ifdef ver1_0}\r
  54     tv_invalidtimebig : ttimeval = (sec:maxlongint;usec:maxlongint);\r
  55   {$else}\r
  56     tv_invalidtimebig : ttimeval = (tv_sec:maxlongint;tv_usec:maxlongint);\r
  57   {$endif}\r
  58 implementation\r
  59 \r
  60 {$i unixstuff.inc}\r
  61 \r
  62 {add nn msec to tv}\r
  63 procedure tv_add(var tv:ttimeval;msec:integer);\r
  64 begin\r
  65   inc(tv.tv_usec,msec*1000);\r
  66   inc(tv.tv_sec,tv.tv_usec div 1000000);\r
  67   tv.tv_usec := tv.tv_usec mod 1000000;\r
  68 end;\r
  69 \r
  70 {tv1 >= tv2}\r
  71 function tv_compare(const tv1,tv2:ttimeval):boolean;\r
  72 begin\r
  73   if tv1.tv_sec = tv2.tv_sec then begin\r
  74     result := tv1.tv_usec >= tv2.tv_usec;\r
  75   end else result := tv1.tv_sec > tv2.tv_sec;\r
  76 end;\r
  77 \r
  78 procedure tv_subtract(var tv:ttimeval;const tv2:ttimeval);\r
  79 begin\r
  80   dec(tv.tv_usec,tv2.tv_usec);\r
  81   if tv.tv_usec < 0 then begin\r
  82     inc(tv.tv_usec,1000000);\r
  83     dec(tv.tv_sec)\r
  84   end;\r
  85   dec(tv.tv_sec,tv2.tv_sec);\r
  86 end;\r
  87 \r
  88 procedure msectotimeval(var tv:ttimeval;msec:integer);\r
  89 begin\r
  90   tv.tv_sec := msec div 1000;\r
  91   tv.tv_usec := (msec mod 1000)*1000;\r
  92 end;\r
  93 \r
  94 \r
  95 {$ifdef unix}\r
  96 {$ifdef linux}{$define have_clock_gettime}{$endif}\r
  97 {$ifdef freebsd}{$define have_clock_gettime}{$endif}\r
  98 \r
  99 procedure gettimemonotonic(var tv:ttimeval);\r
 100 var\r
 101   ts:ttimespec;\r
 102 begin\r
 103   {$ifdef have_clock_gettime}\r
 104   if (clock_gettime(CLOCK_MONOTONIC, @ts) = 0) then begin\r
 105     tv.tv_sec := ts.tv_sec;\r
 106     tv.tv_usec := ts.tv_nsec div 1000;\r
 107     exit;\r
 108   end;\r
 109   {$endif}\r
 110   gettimeofday(tv);\r
 111 end;\r
 112 {$endif}\r
 113 \r
 114 end.\r