X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/70e049261c2b49411fbc9cefc737bc18ee6c4365..71f094bad8c68b2a3d096b436dc74cf4d9e2895a:/btime.pas?ds=sidebyside diff --git a/btime.pas b/btime.pas index 54deae5..8826a4d 100644 --- a/btime.pas +++ b/btime.pas @@ -9,6 +9,11 @@ works on windows/delphi, and on freepascal on unix. unit btime; +{$ifdef fpc} + {$mode delphi} +{$endif} + +{$include lcoreconfig.inc} interface @@ -31,6 +36,7 @@ var tickcount:integer; settimebias:tunixtimeint; performancecountfreq:extended; + btimenowin8:boolean; function irctimefloat:float; function irctimeint:tunixtimeint; @@ -55,6 +61,9 @@ function timestrshort(i:tunixtimeint):string; // Wed Aug 15 16:21:09 2012 function timestriso(i:tunixtimeint):string; // 2012-08-15 16:21:09 function timestrisoutc(i:float):string; // 2012-08-15T14:21:09.255553Z +procedure beginhightimerrate; +procedure endhightimerrate; + {$ifdef mswindows} function unixtimefloat_systemtime:float; {$endif} @@ -105,20 +114,17 @@ var implementation -{$ifdef fpc} - {$mode delphi} -{$endif} + uses {$ifdef UNIX} {$ifdef VER1_0} linux, {$else} + {$ifdef linux}linux,{$endif} //for clock_gettime + {$ifdef freebsd}freebsd,{$endif} //for clock_gettime baseunix,unix,unixutil,sockets, {unixutil and sockets needed by unixstuff.inc on some compiler versions} {$endif} - {$ifdef linux} - dl, - {$endif} {$else} windows,unitsettc,mmsystem, {$endif} @@ -138,7 +144,7 @@ end; function oletounix(t:tdatetime):tunixtimeint; begin - result := trunc(oletounixfloat(t)); + result := round(oletounixfloat(t)); end; function unixtoole(i:float):tdatetime; @@ -169,49 +175,37 @@ end; function unixtimefloat:float; var tv:ttimeval; + sec:tunixtimeint; begin gettimeofday(tv); - result := tv.tv_sec+(tv.tv_usec/1000000); + sec := tv.tv_sec; + {$ifndef cpu64} + if (sec < -1) then inc(sec,$100000000); //tv_sec is 32 bits. allow -1 for invalid result + {$endif} + result := sec+(tv.tv_usec/1000000); end; -{$ifdef linux} - {$define monotimefloat_implemented} - const - CLOCK_MONOTONIC = 1; - type - ptimeval = ^ttimeval; - tclock_gettime = function(clk_id: integer; tp: ptimeval): integer; cdecl; +{$ifdef linux}{$define have_clock_gettime}{$endif} +{$ifdef freebsd}{$define have_clock_gettime}{$endif} - var - librt_handle:pointer; - librt_inited:boolean; - clock_gettime: tclock_gettime; +{$ifdef have_clock_gettime} + {$define monotimefloat_implemented} function monotimefloat:float; var - ts: ttimeval; + ts: ttimespec; begin - if not librt_inited then begin - librt_inited := true; - clock_gettime := nil; - librt_handle := dlopen('librt.so', RTLD_LAZY); - if assigned(librt_handle) then begin - clock_gettime := dlsym(librt_handle, 'clock_gettime'); - end; - end; - if assigned(clock_gettime) then begin - if clock_gettime(CLOCK_MONOTONIC, @ts) = 0 then begin - //note this really returns nanoseconds - result := ts.tv_sec + ts.tv_usec / 1000000000.0; - exit; - end; + if clock_gettime(CLOCK_MONOTONIC, @ts) = 0 then begin + //note this really returns nanoseconds + result := ts.tv_sec + ts.tv_nsec / 1000000000.0; + exit; end; //fallback result := unixtimefloat; end; -{$endif} {linux} +{$endif} {$ifdef darwin} {mac OS X} {$define monotimefloat_implemented} @@ -256,9 +250,14 @@ end; function unixtimeint:tunixtimeint; var tv:ttimeval; + sec:tunixtimeint; begin gettimeofday(tv); - result := tv.tv_sec; + sec := tv.tv_sec; + {$ifndef cpu64} + if (sec < -1) then inc(sec,$100000000); //tv_sec is 32 bits. allow -1 for invalid result + {$endif} + result := sec; end; {------------------------------ end of *nix/freepascal section} @@ -592,10 +591,12 @@ const var f,g,h:float; begin - if not win8inited then initwin8; - if assigned(@GetSystemTimePreciseAsFileTime) then begin - result := unixtimefloat_win8; - exit; + if not btimenowin8 then begin + if not win8inited then initwin8; + if assigned(@GetSystemTimePreciseAsFileTime) then begin + result := unixtimefloat_win8; + exit; + end; end; result := monotimefloat+timefloatbias; @@ -762,10 +763,19 @@ begin end; +procedure beginhightimerrate; +begin + {$ifdef mswindows}timebeginperiod(1);{$endif} +end; + +procedure endhightimerrate; +begin + {$ifdef mswindows}timeendperiod(1);{$endif} +end; procedure init; begin - {$ifdef mswindows}timebeginperiod(1);{$endif} //ensure stable unchanging clock + {$ifdef btimehighrate}beginhightimerrate;{$endif} fillchar(mmtime_driftavg,sizeof(mmtime_driftavg),0); settimebias := 0; gettimezone;