M2compiler-V3/stdlib/sysclock.mod

IMPLEMENTATION MODULE SysClock;
(* ISO 10514-1 clock interface, bound to the shim's time/clock calls.
   GetClock computes the UTC civil date from the Unix epoch seconds. *)

PROCEDURE m2time() : LONGINT;
  EXTERNAL;

PROCEDURE m2clock() : LONGINT;
  EXTERNAL;

PROCEDURE Time() : LONGINT;
BEGIN
  RETURN m2time()
END Time;

PROCEDURE Clock() : LONGINT;
BEGIN
  RETURN m2clock()
END Clock;

PROCEDURE DaysToDate (days: INTEGER; VAR y, m, d: INTEGER);
(* proleptic Gregorian civil date from days since 1970-01-01
   (Hinnant's algorithm; INTEGER is wide enough for the epoch range). *)
  VAR z, era, doe, yoe, doy, mp: INTEGER;
BEGIN
  z := days + 719468;
  era := z DIV 146097;
  doe := z - era * 146097;
  yoe := (doe - doe DIV 1460 + doe DIV 36524 - doe DIV 146096) DIV 365;
  y := yoe + era * 400;
  doy := doe - (365 * yoe + yoe DIV 4 - yoe DIV 100);
  mp := (5 * doy + 2) DIV 153;
  d := doy - (153 * mp + 2) DIV 5 + 1;
  IF mp < 10 THEN m := mp + 3 ELSE m := mp - 9 END;
  IF m <= 2 THEN INC(y) END
END DaysToDate;

PROCEDURE CanGetClock () : BOOLEAN;
BEGIN
  RETURN TRUE
END CanGetClock;

PROCEDURE CanSetClock () : BOOLEAN;
BEGIN
  RETURN FALSE
END CanSetClock;

PROCEDURE IsValidDateTime (userData: DateTime) : BOOLEAN;
BEGIN
  RETURN (userData.year <= 9999)
     AND (userData.month >= 1) AND (userData.month <= 12)
     AND (userData.day >= 1) AND (userData.day <= 31)
     AND (userData.hour <= 23)
     AND (userData.minute <= 59)
     AND (userData.second <= 59)
     AND (userData.fractions <= maxSecondParts)
     AND (userData.zone >= -780) AND (userData.zone <= 720)
END IsValidDateTime;

PROCEDURE GetClock (VAR userData: DateTime);
  VAR secs, days, sod, y, m, d, hh, mm, ss: INTEGER;
BEGIN
  secs := INTEGER(Time());
  days := secs DIV 86400;
  sod := secs MOD 86400;
  IF sod < 0 THEN
    (* floor division for times before 1970 *)
    DEC(days); INC(sod, 86400)
  END;
  DaysToDate(days, y, m, d);
  hh := sod DIV 3600;
  mm := (sod MOD 3600) DIV 60;
  ss := sod MOD 60;
  userData.year := y;
  userData.month := m;
  userData.day := d;
  userData.hour := hh;
  userData.minute := mm;
  userData.second := ss;
  userData.fractions := 0;
  userData.zone := 0;
  userData.summerTimeFlag := FALSE
END GetClock;

PROCEDURE SetClock (userData: DateTime);
BEGIN
  (* unsupported: CanSetClock is FALSE *)
END SetClock;

END SysClock.