btime.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 this unit returns unix timestamp with seconds and microseconds (as float)\r
   7 works on windows/delphi, and on freepascal on unix.\r
   8 }\r
   9 \r
  10 \r
  11 unit btime;\r
  12 {$ifdef fpc}\r
  13   {$mode delphi}\r
  14 {$endif}\r
  15 \r
  16 {$include lcoreconfig.inc}\r
  17 \r
  18 interface\r
  19 \r
  20 {$ifdef mswindows}\r
  21 uses\r
  22   ltimevalstuff;\r
  23 {$endif}  \r
  24 \r
  25 type\r
  26   float=extended;\r
  27   tunixtimeint={$ifdef ver100}longint;{$else}int64;{$endif}\r
  28 \r
  29 const\r
  30   colorburst=39375000/11;  {3579545.4545....}\r
  31 \r
  32 var\r
  33   timezone:integer;\r
  34   timezonestr:string;\r
  35   irctime,unixtime:tunixtimeint;\r
  36   tickcount:integer;\r
  37   settimebias:tunixtimeint;\r
  38   performancecountfreq:extended;\r
  39   btimenowin8:boolean;\r
  40 \r
  41 function irctimefloat:float;\r
  42 function irctimeint:tunixtimeint;\r
  43 \r
  44 //unix timestamp (UTC) float seconds\r
  45 function unixtimefloat:float;\r
  46 function unixtimeint:tunixtimeint;\r
  47 \r
  48 //monotonic float seconds\r
  49 function monotimefloat:float;\r
  50 \r
  51 //monotonic (alias, old function name)\r
  52 function wintimefloat:float;\r
  53 \r
  54 procedure settime(newtime:tunixtimeint);\r
  55 procedure gettimezone;\r
  56 procedure timehandler;\r
  57 procedure init;\r
  58 \r
  59 function timestring(i:tunixtimeint):string;      // Wednesday August 15 2012 -- 16:21:09 +02:00\r
  60 function timestrshort(i:tunixtimeint):string;    // Wed Aug 15 16:21:09 2012\r
  61 function timestriso(i:tunixtimeint):string;      // 2012-08-15 16:21:09\r
  62 function timestrisoutc(i:float):string;          // 2012-08-15T14:21:09.255553Z\r
  63 \r
  64 procedure beginhightimerrate;\r
  65 procedure endhightimerrate;\r
  66 \r
  67 {$ifdef mswindows}\r
  68 function unixtimefloat_systemtime:float;\r
  69 {$endif}\r
  70 \r
  71 function oletounixfloat(t:float):float;\r
  72 function oletounix(t:tdatetime):tunixtimeint;\r
  73 function unixtoole(i:float):tdatetime;\r
  74 \r
  75 {$ifdef mswindows}\r
  76 function mmtimefloat:float;\r
  77 function qpctimefloat:float;\r
  78 {$endif}\r
  79 \r
  80 {$ifdef mswindows}\r
  81 procedure gettimeofday(var tv:ttimeval);\r
  82 {$endif}\r
  83 \r
  84 \r
  85 const\r
  86   mmtime_driftavgsize=32;\r
  87   mmtime_warmupnum=4;\r
  88   mmtime_warmupcyclelength=15;\r
  89 var\r
  90   //this flag is to be set when btime has been running long enough to stabilise\r
  91   warmup_finished:boolean;\r
  92 \r
  93   timefloatbias:float;\r
  94   ticks_freq:float=0;\r
  95   ticks_freq2:float=0;\r
  96   ticks_freq_known:boolean=false;\r
  97   lastunixtimefloat:float=0;\r
  98   lastsynctime:float=0;\r
  99   lastsyncbias:float=0;\r
 100 \r
 101   mmtime_last:integer=0;\r
 102   mmtime_wrapadd:float;\r
 103   mmtime_lastsyncmm:float=0;\r
 104   mmtime_lastsyncqpc:float=0;\r
 105   mmtime_drift:float=1;\r
 106   mmtime_lastresult:float;\r
 107   mmtime_nextdriftcorrection:float;\r
 108   mmtime_driftavg:array[0..mmtime_driftavgsize] of float;\r
 109   mmtime_synchedqpc:boolean;\r
 110 \r
 111   mmtime_prev_drift:float;\r
 112   mmtime_prev_lastsyncmm:float;\r
 113   mmtime_prev_lastsyncqpc:float;\r
 114 \r
 115 implementation\r
 116 \r
 117 \r
 118 \r
 119 uses\r
 120   {$ifdef UNIX}\r
 121     {$ifdef VER1_0}\r
 122       linux,\r
 123     {$else}\r
 124       baseunix,unix,unixutil,sockets, {unixutil and sockets needed by unixstuff.inc on some compiler versions}\r
 125     {$endif}\r
 126     {$ifdef linux}\r
 127       dl,\r
 128     {$endif}\r
 129   {$else}\r
 130     windows,unitsettc,mmsystem,\r
 131   {$endif}\r
 132   sysutils;\r
 133 \r
 134   {$include unixstuff.inc}\r
 135 \r
 136 \r
 137 const\r
 138   daysdifference=25569;\r
 139 \r
 140 function oletounixfloat(t:float):float;\r
 141 begin\r
 142   t := (t - daysdifference) * 86400;\r
 143   result := t;\r
 144 end;\r
 145 \r
 146 function oletounix(t:tdatetime):tunixtimeint;\r
 147 begin\r
 148   result := round(oletounixfloat(t));\r
 149 end;\r
 150 \r
 151 function unixtoole(i:float):tdatetime;\r
 152 begin\r
 153   result := ((i)/86400)+daysdifference;\r
 154 end;\r
 155 \r
 156 const\r
 157   highdwordconst=65536.0 * 65536.0;\r
 158 \r
 159 function utrunc(f:float):integer;\r
 160 {converts float to integer, in 32 bits unsigned range}\r
 161 begin\r
 162   if f >= (highdwordconst/2) then f := f - highdwordconst;\r
 163   result := trunc(f);\r
 164 end;\r
 165 \r
 166 function uinttofloat(i:integer):float;\r
 167 {converts 32 bits unsigned integer to float}\r
 168 begin\r
 169   result := i;\r
 170   if result < 0 then result := result + highdwordconst;\r
 171 end;\r
 172 \r
 173 {$ifdef unix}\r
 174 {-----------------------------------------*nix/freepascal code to read time }\r
 175 \r
 176 function unixtimefloat:float;\r
 177 var\r
 178   tv:ttimeval;\r
 179   sec:tunixtimeint;\r
 180 begin\r
 181   gettimeofday(tv);\r
 182   sec := tv.tv_sec;\r
 183   {$ifndef cpu64}\r
 184   if (sec < 0) then inc(sec,$100000000); //tv_sec is 32 bits\r
 185   {$endif}\r
 186   result := sec+(tv.tv_usec/1000000);\r
 187 end;\r
 188 \r
 189 {$ifdef linux}\r
 190   {$define monotimefloat_implemented}\r
 191   const\r
 192     CLOCK_MONOTONIC = 1;\r
 193   type \r
 194     ptimeval = ^ttimeval;\r
 195     tclock_gettime = function(clk_id: integer; tp: ptimeval): integer; cdecl;\r
 196 \r
 197   var\r
 198     librt_handle:pointer;\r
 199     librt_inited:boolean;\r
 200     clock_gettime: tclock_gettime;\r
 201 \r
 202   function monotimefloat:float;\r
 203   var\r
 204     ts: ttimeval;\r
 205   begin\r
 206     if not librt_inited then begin\r
 207       librt_inited := true;\r
 208       clock_gettime := nil;\r
 209       librt_handle := dlopen('librt.so', RTLD_LAZY);\r
 210       if assigned(librt_handle) then begin\r
 211         clock_gettime := dlsym(librt_handle, 'clock_gettime');\r
 212       end;\r
 213     end;\r
 214     if assigned(clock_gettime) then begin\r
 215       if clock_gettime(CLOCK_MONOTONIC, @ts) = 0 then begin\r
 216         //note this really returns nanoseconds\r
 217         result := ts.tv_sec + ts.tv_usec / 1000000000.0;\r
 218         exit;\r
 219       end;\r
 220     end;\r
 221     //fallback\r
 222     result := unixtimefloat;\r
 223   end;\r
 224 \r
 225 \r
 226 {$endif} {linux}\r
 227 \r
 228 {$ifdef darwin} {mac OS X}\r
 229 {$define monotimefloat_implemented}\r
 230 \r
 231   type\r
 232     tmach_timebase_info = packed record\r
 233       numer: longint;\r
 234       denom: longint;\r
 235     end;\r
 236     pmach_timebase_info = ^tmach_timebase_info;\r
 237      \r
 238     function mach_absolute_time: int64; cdecl; external;\r
 239     function mach_timebase_info(info: pmach_timebase_info): integer; cdecl; external;\r
 240 \r
 241   var\r
 242     timebase_info: tmach_timebase_info;\r
 243 \r
 244   function monotimefloat:float;\r
 245   var\r
 246     i:int64;\r
 247   begin\r
 248     if timebase_info.denom = 0 then begin\r
 249       mach_timebase_info(@timebase_info);\r
 250     end;\r
 251     i := mach_absolute_time;\r
 252     result := (i * timebase_info.numer div timebase_info.denom) / 1000000000.0;\r
 253   end;\r
 254 \r
 255 {$endif} {darwin, mac OS X}\r
 256 \r
 257 \r
 258 {$ifndef monotimefloat_implemented} {fallback}\r
 259   \r
 260   function monotimefloat:extended;\r
 261   begin\r
 262     result := unixtimefloat;\r
 263   end;\r
 264 \r
 265 {$endif} {monotimefloat fallback}\r
 266 \r
 267 \r
 268 function unixtimeint:tunixtimeint;\r
 269 var\r
 270   tv:ttimeval;\r
 271   sec:tunixtimeint;\r
 272 begin\r
 273   gettimeofday(tv);\r
 274   sec := tv.tv_sec;\r
 275   {$ifndef cpu64}\r
 276   if (sec < 0) then inc(sec,$100000000); //tv_sec is 32 bits\r
 277   {$endif}\r
 278   result := sec;\r
 279 end;\r
 280 \r
 281 {------------------------------ end of *nix/freepascal section}\r
 282 \r
 283 {$else} {delphi 3}\r
 284 {------------------------------ windows/delphi code to read time}\r
 285 \r
 286 \r
 287 {simulate gettimeofday on windows so one can always use gettimeofday if preferred}\r
 288 \r
 289 procedure gettimeofday(var tv:ttimeval);\r
 290 var\r
 291   e:extended;\r
 292 begin\r
 293   e := unixtimefloat;\r
 294   tv.tv_sec := round(int(e));\r
 295   tv.tv_usec := trunc(frac(e)*1000000);\r
 296   {just in case}\r
 297   if (tv.tv_usec < 0) then tv.tv_usec := 0;\r
 298   if (tv.tv_usec > 999999) then tv.tv_usec := 999999;\r
 299 end;\r
 300 \r
 301 \r
 302 {\r
 303 time float: gettickcount\r
 304 resolution: 9x: ~55 ms NT: 1/64th of a second\r
 305 guarantees: continuous without any jumps\r
 306 frequency base: same as system clock.\r
 307 epoch: system boot\r
 308 note: if called more than once per 49.7 days, 32 bits wrapping is compensated for and it keeps going on.\r
 309 note: i handle the timestamp as signed integer, but with the wrap compensation that works as well, and is faster\r
 310 }\r
 311 \r
 312 function mmtimefloat:float;\r
 313 const\r
 314   wrapduration=highdwordconst * 0.001;\r
 315 var\r
 316   i:integer;\r
 317   temp:float;\r
 318 begin\r
 319   i := gettickcount; {timegettime}\r
 320   if i < mmtime_last then begin\r
 321     mmtime_wrapadd := mmtime_wrapadd + wrapduration;\r
 322   end;\r
 323   mmtime_last := i;\r
 324   result := mmtime_wrapadd + i * 0.001;\r
 325 \r
 326   if (ticks_freq <> 0) and ticks_freq_known then begin\r
 327     {the value we get is rounded to 1 ms, but the ticks are not a multiple of 1 ms\r
 328     this makes the value noisy. use the known ticks frequency to restore the original value}\r
 329     temp := int((result / ticks_freq)+0.5) * ticks_freq;\r
 330 \r
 331     {if the known ticks freq is wrong (can happen), disable the un-rounding behavior\r
 332     this will be a bit less accurate but it prevents problems}\r
 333     if abs(temp - result) > 0.002 then begin\r
 334       ticks_freq := 0;\r
 335     end else result := temp;\r
 336   end;\r
 337 end;\r
 338 \r
 339 procedure measure_ticks_freq;\r
 340 var\r
 341   f,g:float;\r
 342   o:tosversioninfo;\r
 343   isnt:boolean;\r
 344 {  is9x:boolean;}\r
 345   adjust1,adjust2:cardinal;\r
 346   adjustbool:longbool;\r
 347 begin\r
 348   if (performancecountfreq = 0) then qpctimefloat;\r
 349   ticks_freq_known := false;\r
 350   settc;\r
 351   f := mmtimefloat;\r
 352   repeat g := mmtimefloat until g > f;\r
 353   unsettc;\r
 354   f := g - f;\r
 355   fillchar(o,sizeof(o),0);\r
 356   o.dwOSVersionInfoSize := sizeof(o);\r
 357   getversionex(o);\r
 358   isnt := o.dwPlatformId = VER_PLATFORM_WIN32_NT;\r
 359 {  is9x := o.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS;}\r
 360 \r
 361   ticks_freq2 := f;\r
 362   mmtime_synchedqpc := false;\r
 363 \r
 364   if (isnt and (o.dwMajorVersion >= 5)) then begin\r
 365     {windows 2000 and later: query tick rate from OS in 100 ns units\r
 366     typical rates: XP: 156250 or 100144, windows 7: 156001}\r
 367     if GetSystemTimeAdjustment(adjust1,adjust2,adjustbool) then begin\r
 368       ticks_freq := adjust1 / 10000000.0;\r
 369       ticks_freq_known := true;\r
 370       mmtime_synchedqpc := false;\r
 371     end;\r
 372   end;\r
 373 \r
 374   {9x}\r
 375   if (performancecountfreq = 1193182) and (f >= 0.050) and (f <= 0.060) then begin\r
 376     ticks_freq_known := true;\r
 377     ticks_freq := 65536 / (colorburst / 3);\r
 378     mmtime_synchedqpc := true;\r
 379   end;\r
 380   ticks_freq_known := true;\r
 381   if ticks_freq <> 0 then ticks_freq2 := ticks_freq;\r
 382 //  writeln(formatfloat('0.000000',ticks_freq));\r
 383 end;\r
 384 \r
 385 {\r
 386 time float: QueryPerformanceCounter\r
 387 resolution: <1us\r
 388 guarantees: can have forward jumps depending on hardware. can have forward and backwards jitter on dual core.\r
 389 frequency base: on NT, not the system clock, drifts compared to it.\r
 390 epoch: system boot\r
 391 }\r
 392 function qpctimefloat:extended;\r
 393 var\r
 394   p:packed record\r
 395     lowpart:longint;\r
 396     highpart:longint\r
 397   end;\r
 398   p2:tlargeinteger absolute p;\r
 399   e:extended;\r
 400 begin\r
 401   if performancecountfreq = 0 then begin\r
 402     QueryPerformancefrequency(p2);\r
 403     e := p.lowpart;\r
 404     if e < 0 then e := e + highdwordconst;\r
 405     performancecountfreq := ((p.highpart*highdwordconst)+e);\r
 406   end;\r
 407   queryperformancecounter(p2);\r
 408   e := p.lowpart;\r
 409   if e < 0 then e := e + highdwordconst;\r
 410 \r
 411   result := ((p.highpart*highdwordconst)+e)/performancecountfreq;\r
 412 end;\r
 413 \r
 414 {\r
 415 time float: QPC locked to gettickcount\r
 416 resolution: <1us\r
 417 guarantees: continuous without any jumps\r
 418 frequency base: same as system clock.\r
 419 epoch: system boot\r
 420 }\r
 421 \r
 422 function mmqpctimefloat:float;\r
 423 const\r
 424   maxretries=5;\r
 425   margin=0.002;\r
 426 var\r
 427 {  jump:float;}\r
 428   mm,f,qpc,newdrift:float;\r
 429   qpcjumped:boolean;\r
 430   a,b:integer;\r
 431 {  retrycount:integer;}\r
 432 begin\r
 433   if not ticks_freq_known then measure_ticks_freq;\r
 434 {  retrycount := maxretries;}\r
 435 \r
 436   qpc := qpctimefloat;\r
 437   mm := mmtimefloat;\r
 438   f := (qpc - mmtime_lastsyncqpc) * mmtime_drift + mmtime_lastsyncmm;\r
 439   //writeln('XXXX ',formatfloat('0.000000',qpc-mm));\r
 440   qpcjumped := ((f-mm) > ticks_freq2+margin) or ((f-mm) < -margin);\r
 441 //  if qpcjumped then writeln('qpc jumped ',(f-mm));\r
 442   if ((qpc > mmtime_nextdriftcorrection) and not mmtime_synchedqpc) or qpcjumped then begin\r
 443 \r
 444     mmtime_nextdriftcorrection := qpc + 1;\r
 445     repeat\r
 446       mmtime_prev_drift := mmtime_drift;\r
 447       mmtime_prev_lastsyncmm := mmtime_lastsyncmm;\r
 448       mmtime_prev_lastsyncqpc := mmtime_lastsyncqpc;\r
 449 \r
 450       mm := mmtimefloat;\r
 451     {  dec(retrycount);}\r
 452       settc;\r
 453       result := qpctimefloat;\r
 454       f := mmtimefloat;\r
 455       repeat\r
 456         if f = mm then result := qpctimefloat;\r
 457         f := mmtimefloat\r
 458       until f > mm;\r
 459       qpc := qpctimefloat;\r
 460 \r
 461       unsettc;\r
 462       if (qpc > result + 0.0001) then begin\r
 463         continue;\r
 464       end;\r
 465       mm := f;\r
 466 \r
 467       if (mmtime_lastsyncqpc <> 0) and not qpcjumped then begin\r
 468         newdrift := (mm - mmtime_lastsyncmm) / (qpc - mmtime_lastsyncqpc);\r
 469         mmtime_drift := newdrift;\r
 470      {   writeln('raw drift: ',formatfloat('0.00000000',mmtime_drift));}\r
 471         move(mmtime_driftavg[0],mmtime_driftavg[1],sizeof(mmtime_driftavg[0])*high(mmtime_driftavg));\r
 472         mmtime_driftavg[0] := mmtime_drift;\r
 473 \r
 474 {        write('averaging drift ',formatfloat('0.00000000',mmtime_drift),' -> ');}\r
 475 {        mmtime_drift := 0;}\r
 476         b := 0;\r
 477         for a := 0 to high(mmtime_driftavg) do begin\r
 478           if mmtime_driftavg[a] <> 0 then inc(b);\r
 479 {          mmtime_drift := mmtime_drift + mmtime_driftavg[a];}\r
 480         end;\r
 481 {        mmtime_drift := mmtime_drift / b;}\r
 482         a := 5;\r
 483         if (b = 1) then a := 5 else if (b = 2) then a := 15 else if (b = 3) then a := 30 else if (b = 4) then a := 60 else if (b = 5) then a := 120 else if (b >= 5) then a := 120;\r
 484         mmtime_nextdriftcorrection := qpc + a;\r
 485         if (b >= 2) then warmup_finished := true;\r
 486 {        writeln(formatfloat('0.00000000',mmtime_drift));}\r
 487        if mmtime_synchedqpc then mmtime_drift := 1;\r
 488       end;\r
 489 \r
 490       mmtime_lastsyncqpc := qpc;\r
 491       mmtime_lastsyncmm := mm;\r
 492   {   writeln(formatfloat('0.00000000',mmtime_drift));}\r
 493       break;\r
 494     until false;\r
 495 \r
 496 \r
 497     qpc := qpctimefloat;\r
 498 \r
 499     result := (qpc - mmtime_lastsyncqpc) * mmtime_drift + mmtime_lastsyncmm;\r
 500 \r
 501     {f := (qpc - mmtime_prev_lastsyncqpc) * mmtime_prev_drift + mmtime_prev_lastsyncmm;\r
 502     jump := result-f;\r
 503     writeln('jump ',formatfloat('0.000000',jump),'   drift ',formatfloat('0.00000000',mmtime_drift),' duration ',formatfloat('0.000',(mmtime_lastsyncqpc-mmtime_prev_lastsyncqpc)),' ',formatfloat('0.00000000',jump/(mmtime_lastsyncqpc-mmtime_prev_lastsyncqpc)));}\r
 504 \r
 505     f := result;\r
 506   end;\r
 507 \r
 508   result := f;\r
 509 \r
 510   if (result < mmtime_lastresult) then result := mmtime_lastresult;\r
 511   mmtime_lastresult := result;\r
 512 end;\r
 513 \r
 514 { free pascals tsystemtime is incompatible with windows api calls\r
 515  so we declare it ourselves - plugwash\r
 516 }\r
 517 {$ifdef fpc}\r
 518 type\r
 519   TSystemTime = record\r
 520      wYear: Word;\r
 521      wMonth: Word;\r
 522      wDayOfWeek: Word;\r
 523      wDay: Word;\r
 524      wHour: Word;\r
 525      wMinute: Word;\r
 526      wSecond: Word;\r
 527      wMilliseconds: Word;\r
 528   end;\r
 529  {$endif}\r
 530 function Date_utc: extended;\r
 531 var\r
 532   SystemTime: TSystemTime;\r
 533 begin\r
 534   {$ifdef fpc}\r
 535     GetsystemTime(@SystemTime);\r
 536   {$else}\r
 537     GetsystemTime(SystemTime);\r
 538   {$endif}\r
 539   with SystemTime do Result := EncodeDate(wYear, wMonth, wDay);\r
 540 end;\r
 541 \r
 542 function Time_utc: extended;\r
 543 var\r
 544   SystemTime: TSystemTime;\r
 545 begin\r
 546   {$ifdef fpc}\r
 547     GetsystemTime(@SystemTime);\r
 548   {$else}\r
 549     GetsystemTime(SystemTime);\r
 550   {$endif}\r
 551   with SystemTime do\r
 552     Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);\r
 553 end;\r
 554 \r
 555 function Now_utc: extended;\r
 556 begin\r
 557   Result := round(Date_utc) + Time_utc;\r
 558 end;\r
 559 \r
 560 function unixtimefloat_systemtime:float;\r
 561 begin\r
 562   {result := oletounixfloat(now_utc);}\r
 563 \r
 564   {this method gives exactly the same result with extended precision, but is less sensitive to float rounding in theory}\r
 565   result := oletounixfloat(int(date_utc+0.5))+time_utc*86400;\r
 566 end;\r
 567 \r
 568 function monotimefloat:extended;\r
 569 begin\r
 570   result := mmqpctimefloat;\r
 571 end;\r
 572 \r
 573 \r
 574 \r
 575 var\r
 576   GetSystemTimePreciseAsFileTime:procedure(var v:tfiletime); stdcall;\r
 577   win8inited:boolean;\r
 578 \r
 579 procedure initwin8;\r
 580 var\r
 581   dllhandle:thandle;\r
 582 \r
 583 begin\r
 584   win8inited := true;\r
 585   dllhandle := loadlibrary('kernel32.dll');\r
 586   if (dllhandle <> 0) then begin\r
 587     GetSystemTimePreciseAsFileTime := getprocaddress(dllhandle,'GetSystemTimePreciseAsFileTime');\r
 588   end;\r
 589 end;\r
 590 \r
 591 \r
 592 function unixtimefloat_win8:float;\r
 593 var\r
 594   ft:tfiletime;\r
 595   i:int64 absolute ft;\r
 596 begin\r
 597   GetSystemTimePreciseAsFileTime(ft);\r
 598   {change from windows 1601-01-01 to unix 1970-01-01.\r
 599   use integer math for this, to preserve precision}\r
 600   dec(i, 116444736000000000);\r
 601   result := (i / 10000000);\r
 602 end;\r
 603 \r
 604 \r
 605 \r
 606 function unixtimefloat:float;\r
 607 const\r
 608   margin = 0.0012;\r
 609 var\r
 610   f,g,h:float;\r
 611 begin\r
 612   if not btimenowin8 then begin\r
 613     if not win8inited then initwin8;\r
 614     if assigned(@GetSystemTimePreciseAsFileTime) then begin\r
 615       result := unixtimefloat_win8;\r
 616       exit;\r
 617     end;  \r
 618   end;\r
 619 \r
 620   result := monotimefloat+timefloatbias;\r
 621   f := result-unixtimefloat_systemtime;\r
 622   if ((f > ticks_freq2+margin) or (f < -margin)) or (timefloatbias = 0) then begin\r
 623 //    writeln('unixtimefloat init');\r
 624     f := unixtimefloat_systemtime;\r
 625     settc;\r
 626     repeat g := unixtimefloat_systemtime; h := monotimefloat until g > f;\r
 627     unsettc;\r
 628     timefloatbias := g-h;\r
 629     result := unixtimefloat;\r
 630   end;\r
 631 \r
 632   {for small changes backwards, guarantee no steps backwards}\r
 633   if (result <= lastunixtimefloat) and (result > lastunixtimefloat-1.5) then result := lastunixtimefloat + 0.0000001;\r
 634   lastunixtimefloat := result;\r
 635 end;\r
 636 \r
 637 function unixtimeint:tunixtimeint;\r
 638 begin\r
 639   result := trunc(unixtimefloat);\r
 640 end;\r
 641 \r
 642 {$endif}\r
 643 {-----------------------------------------------end of platform specific}\r
 644 \r
 645 function wintimefloat:float;\r
 646 begin\r
 647   result := monotimefloat;\r
 648 end;\r
 649 \r
 650 function irctimefloat:float;\r
 651 begin\r
 652   result := unixtimefloat+settimebias;\r
 653 end;\r
 654 \r
 655 function irctimeint:tunixtimeint;\r
 656 begin\r
 657   result := unixtimeint+settimebias;\r
 658 end;\r
 659 \r
 660 \r
 661 procedure settime(newtime:tunixtimeint);\r
 662 var\r
 663   a:tunixtimeint;\r
 664 begin\r
 665   a := irctimeint-settimebias;\r
 666   if newtime = 0 then settimebias := 0 else settimebias := newtime-a;\r
 667 \r
 668   irctime := irctimeint;\r
 669 end;\r
 670 \r
 671 procedure timehandler;\r
 672 begin\r
 673   if unixtime = 0 then init;\r
 674   unixtime := unixtimeint;\r
 675   irctime := irctimeint;\r
 676   if unixtime and 63 = 0 then begin\r
 677     {update everything, apply timezone changes, clock changes, etc}\r
 678     gettimezone;\r
 679     timefloatbias := 0;\r
 680     unixtime := unixtimeint;\r
 681     irctime := irctimeint;\r
 682   end;\r
 683 end;\r
 684 \r
 685 \r
 686 procedure gettimezone;\r
 687 var\r
 688   {$ifdef UNIX}\r
 689     {$ifndef ver1_9_4}\r
 690       {$ifndef ver1_0}\r
 691         {$define above194}\r
 692       {$endif}\r
 693     {$endif}\r
 694     {$ifndef above194}\r
 695       hh,mm,ss:word;\r
 696     {$endif}\r
 697   {$endif}\r
 698   l:integer;\r
 699 begin\r
 700   {$ifdef UNIX}\r
 701     {$ifdef above194}\r
 702       timezone := tzseconds;\r
 703     {$else}\r
 704       gettime(hh,mm,ss);\r
 705       timezone := (longint(hh) * 3600 + mm * 60 + ss) - (unixtimeint mod 86400);\r
 706     {$endif}\r
 707   {$else}\r
 708   timezone := round((now-now_utc)*86400);\r
 709   {$endif}\r
 710 \r
 711   while timezone > 43200 do dec(timezone,86400);\r
 712   while timezone < -43200 do inc(timezone,86400);\r
 713 \r
 714   if timezone >= 0 then timezonestr := '+' else timezonestr := '-';\r
 715   l := abs(timezone) div 60;\r
 716   timezonestr := timezonestr + char(l div 600 mod 10+48)+char(l div 60 mod 10+48)+':'+char(l div 10 mod 6+48)+char(l mod 10+48);\r
 717 end;\r
 718 \r
 719 function timestrshort(i:tunixtimeint):string;\r
 720 const\r
 721   weekday:array[0..6] of string[4]=('Thu','Fri','Sat','Sun','Mon','Tue','Wed');\r
 722   month:array[0..11] of string[4]=('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');\r
 723 var\r
 724   y,m,d,h,min,sec,ms:word;\r
 725   t:tdatetime;\r
 726 begin\r
 727   t := unixtoole(i+timezone);\r
 728   decodedate(t,y,m,d);\r
 729   decodetime(t,h,min,sec,ms);\r
 730   result := weekday[(i+timezone) div 86400 mod 7]+' '+month[m-1]+' '+inttostr(d)+' '+\r
 731   inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10)+' '+\r
 732   inttostr(y);\r
 733 end;\r
 734 \r
 735 function timestring(i:tunixtimeint):string;\r
 736 const\r
 737   weekday:array[0..6] of string[10]=('Thursday','Friday','Saturday','Sunday','Monday','Tuesday','Wednesday');\r
 738   month:array[0..11] of string[10]=('January','February','March','April','May','June','July','August','September','October','November','December');\r
 739 var\r
 740   y,m,d,h,min,sec,ms:word;\r
 741   t:tdatetime;\r
 742 begin\r
 743   t := unixtoole(i+timezone);\r
 744   decodedate(t,y,m,d);\r
 745   decodetime(t,h,min,sec,ms);\r
 746   result := weekday[(i+timezone) div 86400 mod 7]+' '+month[m-1]+' '+inttostr(d)+' '+inttostr(y)+' -- '+\r
 747   inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10)+' '+\r
 748   timezonestr;\r
 749 end;\r
 750 \r
 751 function timestriso(i:tunixtimeint):string;\r
 752 var\r
 753   y,m,d,h,min,sec,ms:word;\r
 754   t:tdatetime;\r
 755 begin\r
 756   t := unixtoole(i+timezone);\r
 757   decodedate(t,y,m,d);\r
 758   decodetime(t,h,min,sec,ms);\r
 759   result := inttostr(y)+'-'+inttostr(m div 10)+inttostr(m mod 10)+'-'+inttostr(d div 10)+inttostr(d mod 10)+' '+inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10);\r
 760 end;\r
 761 \r
 762 function timestrisoutc(i:float):string;\r
 763 var\r
 764   y,m,d,h,min,sec,ms:word;\r
 765   t:tdatetime;\r
 766   fr:float;\r
 767 begin\r
 768   t := unixtoole(i);\r
 769   decodedate(t,y,m,d);\r
 770   decodetime(t,h,min,sec,ms);\r
 771   result := inttostr(y)+'-'+inttostr(m div 10)+inttostr(m mod 10)+'-'+inttostr(d div 10)+inttostr(d mod 10)+'T'+inttostr(h div 10)+inttostr(h mod 10)+':'+inttostr(min div 10)+inttostr(min mod 10)+':'+inttostr(sec div 10)+inttostr(sec mod 10);\r
 772   fr := frac(i);\r
 773 \r
 774   result := result + '.'+\r
 775   inttostr(trunc(fr*10) mod 10)+\r
 776   inttostr(trunc(fr*100) mod 10)+\r
 777   inttostr(trunc(fr*1000) mod 10)+\r
 778   inttostr(trunc(fr*10000) mod 10)+\r
 779   inttostr(trunc(fr*100000) mod 10)+\r
 780   inttostr(trunc(fr*1000000) mod 10)+'Z';\r
 781 \r
 782 end;\r
 783 \r
 784 procedure beginhightimerrate;\r
 785 begin\r
 786   {$ifdef mswindows}timebeginperiod(1);{$endif}\r
 787 end;\r
 788 \r
 789 procedure endhightimerrate;\r
 790 begin\r
 791   {$ifdef mswindows}timeendperiod(1);{$endif}\r
 792 end;\r
 793 \r
 794 procedure init;\r
 795 begin\r
 796   {$ifdef btimehighrate}beginhightimerrate;{$endif}\r
 797   fillchar(mmtime_driftavg,sizeof(mmtime_driftavg),0);\r
 798   settimebias := 0;\r
 799   gettimezone;\r
 800   unixtime := unixtimeint;\r
 801   irctime := irctimeint;\r
 802 end;\r
 803 \r
 804 initialization init;\r
 805 \r
 806 end.\r