/[lcore]/trunk/ltimevalstuff.pas
ViewVC logotype

Contents of /trunk/ltimevalstuff.pas

Parent Directory Parent Directory | Revision Log Revision Log


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

Properties

Name Value
svn:eol-style CRLF
svn:mergeinfo

No admin address has been configured">No admin address has been configured
ViewVC Help
Powered by ViewVC 1.1.26