FPPS4/sys/kern/kern_time.pas

unit kern_time;

{$mode ObjFPC}{$H+}
{$CALLING SysV_ABI_CDecl}

interface

uses
 kern_param,
 time;

Procedure timeinit; //SYSINIT

procedure getmicrouptime(tvp:p_timeval);
procedure getnanotime(tp:p_timespec);
procedure getmicrotime(tvp:p_timeval);

function  sys_clock_gettime(clock_id:Integer;tp:Pointer):Integer;
function  sys_clock_settime(clock_id:Integer;tp:Pointer):Integer;
function  sys_clock_getres(clock_id:Integer;tp:Pointer):Integer;
function  sys_nanosleep(rqtp,rmtp:Pointer):Integer;
function  sys_gettimeofday(tp,tzp:Pointer):Integer;
function  sys_settimeofday(tv,tzp:Pointer):Integer;
function  sys_adjtime(delta,olddelta:Pointer):Integer;

function  sys_localtime_to_utc(time:QWORD;tz_type:Integer;utc_time,tsec:Pointer;dstsec:PInteger):Integer;
function  sys_utc_to_localtime(time:QWORD;local_time,tsec:Pointer;dstsec:PInteger):Integer;
function  sys_set_timezone_info(data_ptr:Pointer;data_count_dw:Integer):Integer;

implementation

uses
 errno,
 systm,
 md_time,
 kern_synch;

Procedure timeinit;
begin
 md_timeinit;
 //
 if strict_ps4_freq then
 begin
  tsc_freq:=PS4_TSC_FREQ;
  rdtsc   :=@md_rdtsc_freq;
 end else
 begin
  tsc_freq:=md_tsc_freq;
  rdtsc   :=@md_rdtsc;
 end;
 //
 getmicrouptime(@boottime);
end;

procedure getmicrouptime(tvp:p_timeval);
var
 time:Int64;
begin
 time:=md_rdtsc_unit();
 tvp^.tv_sec :=(time div UNIT_PER_SEC);
 tvp^.tv_usec:=(time mod UNIT_PER_SEC) div UNIT_PER_USEC;
end;

procedure getnanotime(tp:p_timespec);
var
 time:Int64;
begin
 unittime(@time);
 time:=time-DELTA_EPOCH_IN_UNIT;
 tp^.tv_sec :=(time div UNIT_PER_SEC);
 tp^.tv_nsec:=(time mod UNIT_PER_SEC)*NSEC_PER_UNIT;
end;

procedure getmicrotime(tvp:p_timeval);
var
 time:Int64;
begin
 unittime(@time);
 time:=time-DELTA_EPOCH_IN_UNIT;
 tvp^.tv_sec :=(time div UNIT_PER_SEC);
 tvp^.tv_usec:=(time mod UNIT_PER_SEC) div UNIT_PER_USEC;
end;

function sys_clock_gettime(clock_id:Integer;tp:Pointer):Integer;
var
 ats:timespec;
begin
 Result:=kern_clock_gettime(clock_id,@ats);
 if (Result=0) then
 begin
  Result:=copyout(@ats,tp,sizeof(ats));
 end;
end;

function sys_clock_settime(clock_id:Integer;tp:Pointer):Integer;
var
 ats:timespec;
begin
 Result:=copyin(tp,@ats,sizeof(ats));
 if (Result<>0) then Exit;

 //error:=priv_check(td, PRIV_CLOCK_SETTIME)
 Exit(EPERM);
end;

function sys_clock_getres(clock_id:Integer;tp:Pointer):Integer;
var
 ats:timespec;
begin
 Result:=kern_clock_getres(clock_id,@ats);
 if (Result=0) then
 begin
  Result:=copyout(@ats,tp,sizeof(ats));
 end;
end;

var
 nanowait:Integer=0;

function kern_nanosleep(rqt,rmt:p_timespec):Integer; public;
var
 ts,ts2,tv:Int64;
 error:Integer;
begin
 Result:=0;

 if (rqt^.tv_nsec < 0) or (rqt^.tv_nsec >= 1000000000) then
 begin
  Exit(EINVAL);
 end;

 if (rqt^.tv_sec < 0) or ((rqt^.tv_sec=0) and (rqt^.tv_nsec=0)) then
 begin
  Exit(0);
 end;

 ts:=get_unit_uptime;
 tv:=TIMESPEC_TO_UNIT(rqt);
 ts:=ts+tv;
 repeat
  error:=tsleep(@nanowait, PWAIT or PCATCH, 'nanslp', tvtohz(tv));
  ts2:=get_unit_uptime;
  if (error<>EWOULDBLOCK) then
  begin
   if (error=ERESTART) then error:=EINTR;
   if (rmt<>nil) then
   begin
    ts:=ts-ts2;
    if (ts<0) then
    begin
     ts:=0;
    end;
    UNIT_TO_TIMESPEC(rmt,ts);
   end;
   Exit(error);
  end;
  if (ts2>=ts) then Exit(0);
  tv:=ts-ts2;
 until false;
end;

function sys_nanosleep(rqtp,rmtp:Pointer):Integer;
var
 rmt,rqt:timespec;
 error,error2:Integer;
begin
 error:=copyin(rqtp, @rqt, sizeof(timespec));
 if (error<>0) then Exit(error);

 if (rmtp<>nil) then
 begin
  rmt:=Default(timespec);
  error:=copyout(@rmt, rmtp, sizeof(timespec));
  if (error<>0) then Exit(error);
 end;

 error:=kern_nanosleep(@rqt, @rmt);

 if (error<>0) and (rmtp<>nil) then
 begin
  error2:=copyout(@rmt, rmtp, sizeof(timespec));
  if (error2<>0) then
  begin
   error:=error2;
  end;
 end;
 Exit(error);
end;

function sys_gettimeofday(tp,tzp:Pointer):Integer;
var
 atv:timeval;
 rtz:timezone;
 error:Integer;
begin
 error:=0;

 if (tp<>nil) then
 begin
  getmicrotime(@atv);
  error:=copyout(@atv, tp, sizeof (timeval));
 end;
 if (error=0) and (tzp<>nil) then
 begin
  gettimezone(@rtz);
  error:=copyout(@rtz, tzp, sizeof (rtz));
 end;
 Exit(error);
end;

function sys_settimeofday(tv,tzp:Pointer):Integer;
var
 atv:timeval;
 atz:timezone;
 error:Integer;
begin
 if (tv<>nil) then
 begin
  error:=copyin(tv, @atv, sizeof(timeval));
  if (error<>0) then Exit(error);
 end;

 if (tzp<>nil) then
 begin
  error:=copyin(tzp, @atz, sizeof(timeval));
  if (error<>0) then Exit(error);
 end;

 //error:=priv_check(td, PRIV_SETTIMEOFDAY);
 Exit(EPERM);
end;

function kern_adjtime(delta,olddelta:p_timeval):Integer;
var
 atv:timeval;
begin
 if (olddelta<>nil) then
 begin
  getadjtime(@atv);
  if (atv.tv_usec<0) then
  begin
   Inc(atv.tv_usec,1000000);
   Dec(atv.tv_sec);
  end;
  olddelta^:=atv;
 end;
 if (delta<>nil) then
 begin
  //error:=priv_check(td, PRIV_ADJTIME)
  Exit(EPERM);
 end;
 Exit(0);
end;

function sys_adjtime(delta,olddelta:Pointer):Integer;
var
 _delta,_olddelta:timeval;
 deltap:p_timeval;
 error:Integer;
begin
 if (delta<>nil) then
 begin
  error:=copyin(delta, @_delta, sizeof(timeval));
  if (error<>0) then Exit(error);
  deltap:=@_delta;
 end else
 begin
  deltap:=nil;
 end;

 error:=kern_adjtime(deltap, @_olddelta);

 if (olddelta<>nil) and (error=0) then
 begin
  error:=copyout(@_olddelta, olddelta, sizeof(timeval));
 end;

 Exit(error);
end;

function sys_localtime_to_utc(time:QWORD;tz_type:Integer;utc_time,tsec:Pointer;dstsec:PInteger):Integer;
begin
 Exit(ERANGE); //no time zone info
end;

function sys_utc_to_localtime(time:QWORD;local_time,tsec:Pointer;dstsec:PInteger):Integer;
begin
 Exit(ERANGE); //no time zone info
end;

function sys_set_timezone_info(data_ptr:Pointer;data_count_dw:Integer):Integer;
begin
 Exit(EPERM); //sceSblACMgrIsSystemUcred
end;


end.