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.