X-Git-Url: http://www.lcore.org/git/lcore.git/blobdiff_plain/3dd5a60c6c89a29781e099a9e204b09ffbb2e317..HEAD:/btime.pas
diff --git a/btime.pas b/btime.pas
index 46cdf48..ae6ffa5 100644
--- a/btime.pas
+++ b/btime.pas
@@ -64,6 +64,12 @@ function timestrisoutc(i:float):string; // 2012-08-15T14:21:09.255553Z
procedure beginhightimerrate;
procedure endhightimerrate;
+procedure tzinvalidate;
+
+{$ifdef unix}
+function tzgetoffsetforts(ts:tunixtimeint):integer;
+{$endif}
+
{$ifdef mswindows}
function unixtimefloat_systemtime:float;
{$endif}
@@ -121,11 +127,10 @@ uses
{$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}
@@ -176,49 +181,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}
@@ -263,17 +256,27 @@ 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}
-{$else} {delphi 3}
+{$else} {windows}
{------------------------------ windows/delphi code to read time}
+procedure tzinvalidate;
+begin
+ gettimezone;
+end;
+
{simulate gettimeofday on windows so one can always use gettimeofday if preferred}
procedure gettimeofday(var tv:ttimeval);
@@ -673,6 +676,226 @@ begin
end;
+{$ifdef unix}
+
+var
+ tzerror:boolean;
+ tzfile:ansistring;
+
+function tzgetfilename:ansistring;
+var
+ t:textfile;
+
+ s,tz,tzdir:ansistring;
+begin
+ result := '';
+ filemode := 0;
+ {$ifdef unix}
+ tz := getenv('TZ');
+
+ if (copy(tz,1,1) = ':') then begin
+ tz := copy(tz,2,99999);
+
+ if (copy(tz,1,1) <> '/') then begin
+ tzdir := getenv('TZDIR');
+ if (tzdir = '') then begin
+ tzdir := '/usr/share/zoneinfo/';
+ end else begin
+ if (copy(tzdir,length(tzdir),1) <> '/') then tzdir := tzdir + '/';
+ end;
+ tz := tzdir + tz;
+ end;
+
+ assignfile(t,tz);
+ {$i-}reset(t);{$i+}
+ if (ioresult = 0) then begin
+ closefile(t);
+ result := tz;
+ exit;
+ end;
+
+ end;
+ {$endif}
+
+ assignfile(t,'/etc/localtime');
+ {$i-}reset(t);{$i+}
+ if (ioresult = 0) then begin
+ closefile(t);
+ result := '/etc/localtime';
+ exit;
+ end;
+
+ assignfile(t,'/etc/timezone');
+
+ s := '';
+ {$i-}reset(t);{$i+}
+ if (ioresult = 0) then begin
+ readln(t,s);
+ closefile(t);
+ if (s <> '') then begin
+ result := '/usr/share/zoneinfo/'+s;
+ exit;
+ end;
+ end;
+end;
+
+type
+ dvar=array[0..65535] of byte;
+ pdvar=^dvar;
+
+var
+ tzcache:pdvar;
+ tzsize:integer;
+
+procedure tzinvalidate;
+begin
+ if assigned(tzcache) then freemem(tzcache);
+ tzcache := nil;
+ tzsize := 0;
+ tzfile := '';
+ gettimezone;
+end;
+
+
+function tzgetoffsetforts(ts:tunixtimeint):integer;
+var
+ f:file;
+ buf:pdvar;
+ fs:integer;
+ ofs,ofs2:integer;
+ mode64:boolean;
+ has64:boolean;
+ a,index:integer;
+ //tzstrofs:integer;
+ t:int64;
+ tzh_ttisgmtcnt:integer;
+ tzh_ttisstdcnt:integer;
+ tzh_leapcnt:integer;
+ tzh_timecnt:integer;
+ tzh_typecnt:integer;
+ tzh_charcnt:integer;
+
+
+function getint:integer;
+begin
+ if (ofs < 0) or ((ofs + 4) > fs) then raise exception.create('getint');
+ result := (buf[ofs] shl 24) + (buf[ofs+1] shl 16) + (buf[ofs+2] shl 8) + buf[ofs+3];
+ inc(ofs,4);
+end;
+
+function getint64:int64;
+begin
+ if (ofs < 0) or ((ofs + 8) > fs) then raise exception.create('getint64');
+ result := int64(getint) shl 32;
+ inc(result,cardinal(getint));
+end;
+
+
+function getbyte:byte;
+begin
+ if (ofs < 0) or ((ofs + 1) > fs) then raise exception.create('getbyte');
+ result := buf[ofs];
+ inc(ofs);
+end;
+
+begin
+ result := 0;
+ tzerror := true;
+
+ if not assigned(tzcache) then begin
+
+ if (tzfile = '') then tzfile := tzgetfilename;
+
+ if (tzfile = '') then exit;
+
+ assignfile(f,tzfile);
+ filemode := 0;
+ {$i-}reset(f,1);{$i+}
+ if (ioresult <> 0) then begin
+ exit;
+ end;
+ tzsize := filesize(f);
+ if (tzsize > 65536) then tzsize := 65536;
+ getmem(tzcache,tzsize);
+ blockread(f,tzcache^,tzsize);
+ closefile(f);
+ end;
+ fs := tzsize;
+ buf := tzcache;
+ ofs := 0;
+ mode64 := false;
+
+ try
+ repeat
+ if (getint <> $545a6966) then exit; // 'TZif'
+ has64 := getbyte >= $32; // '2'
+
+ inc(ofs,15);
+
+ tzh_ttisgmtcnt := getint;
+ tzh_ttisstdcnt := getint;
+ tzh_leapcnt := getint;
+ tzh_timecnt := getint;
+ tzh_typecnt := getint;
+ tzh_charcnt := getint;
+
+ if mode64 or (not has64) then break;
+ inc(ofs, 5 * tzh_timecnt + 6 * tzh_typecnt + 8 * tzh_leapcnt + tzh_ttisstdcnt + tzh_ttisgmtcnt + tzh_charcnt);
+ mode64 := true;
+ until false;
+ index := 0;
+
+ if (tzh_timecnt < 0) or (tzh_timecnt > fs) then raise exception.create('tzh_timecnt');
+ ofs2 := ofs;
+
+ for a := 0 to tzh_timecnt -1 do begin
+ if mode64 then t := getint64 else t := getint;
+ if (t > ts) then begin
+ index := a - 1;
+ break;
+ end;
+ if (a = tzh_timecnt -1) and (ts >= t) then index := a;
+ end;
+ ofs := ofs2 + tzh_timecnt * (1 + ord(mode64)) * 4;
+
+ if (cardinal(ofs + index) >= fs) or (index < 0) then raise exception.create('index');
+ index := buf[ofs+index];
+ inc(ofs,tzh_timecnt);
+
+ if (index >= tzh_typecnt) then raise exception.create('type');
+ ofs2 := ofs;
+ // writeln('ofs2 ',inttohex(ofs2,8));
+ inc(ofs,6 * index);
+ result := getint;
+
+ //tzisdst := getbyte;
+
+ //the abbreviation string
+ { tzstrofs := getbyte;
+ tzstr := '';
+ ofs := ofs2 + 6 * tzh_typecnt;
+ inc(ofs, tzstrofs);
+
+ repeat
+ a := getbyte;
+ if (a <> 0) then tzstr := tzstr + chr(a);
+ until (a = 0); }
+
+ tzerror := false;
+ except
+
+ end;
+end;
+
+function tzgetoffset:integer;
+begin
+ tzgetoffsetforts(unixtimeint);
+end;
+
+
+{$endif}
+
+
procedure gettimezone;
var
{$ifdef UNIX}
@@ -689,7 +912,8 @@ var
begin
{$ifdef UNIX}
{$ifdef above194}
- timezone := tzseconds;
+ timezone := tzgetoffset;
+ //freepascal tzseconds is not 2038 safe
{$else}
gettime(hh,mm,ss);
timezone := (longint(hh) * 3600 + mm * 60 + ss) - (unixtimeint mod 86400);
@@ -698,8 +922,8 @@ begin
timezone := round((now-now_utc)*86400);
{$endif}
- while timezone > 43200 do dec(timezone,86400);
- while timezone < -43200 do inc(timezone,86400);
+ while timezone > 50400 do dec(timezone,86400);
+ while timezone < -50400 do inc(timezone,86400);
if timezone >= 0 then timezonestr := '+' else timezonestr := '-';
l := abs(timezone) div 60;