-- DateAndTimeImpl.mesa
-- last edited by Levin on June 8, 1982 11:08 am
-- last edited by Brotz on August 19, 1982 4:12 PM

DIRECTORY
Ascii USING [SP, TAB],
DateAndTime USING [Notes],
Inline USING [COPY, LowHalf],
Storage USING [Free, Node],
String USING [EquivalentSubStrings, SubStringDescriptor, UpperCase],
TimeDefs USING [currentParameters, PackedTime, LocalTimeParameters];

DateAndTimeImpl: PROGRAM
IMPORTS Inline, Storage, String
EXPORTS DateAndTime =

BEGIN

hoursPerDay: LONG CARDINAL = 24;
minutesPerHour: LONG CARDINAL = 60;
secondsPerMinute: LONG CARDINAL = 60;
secondsPerDay: LONG CARDINAL = hoursPerDay * minutesPerHour * secondsPerMinute;
baseYear: LONG CARDINAL = 1968;
baseDay: LONG CARDINAL = 1; -- January 1, 1968 was a Monday (0 = Sunday)
gmtEpoch: LONG CARDINAL = 2114294400;

EpochDays: TYPE = LONG CARDINAL;
lastEpochDays: LONG CARDINAL = LAST[LONG CARDINAL] / secondsPerDay;
YearDays: TYPE = LONG CARDINAL;
lastYearDays: LONG CARDINAL = 366;
Year: TYPE = LONG CARDINAL;
lastYear: LONG CARDINAL = baseYear + (lastEpochDays / (4 * 365 + 1)) * 4;
Month: TYPE = [1 .. 12];
Day: TYPE = [1 .. 31];
Hour: TYPE = LONG CARDINAL;
Minute: TYPE = LONG CARDINAL;
Second: TYPE = LONG CARDINAL;
DeltaMinutes: TYPE = LONG INTEGER;
--(-hoursPerDay*minutesPerHour..hoursPerDay*minutesPerHour)--
ZoneIndex: TYPE = INTEGER[-12 .. 12];
NAZones: TYPE = ZoneIndex[-11 .. -4];


Unintelligible: PUBLIC ERROR = CODE;


Parse: PUBLIC PROCEDURE [s: STRING]
RETURNS [dt: TimeDefs.PackedTime, notes: DateAndTime.Notes] =
BEGIN
TokenCount: TYPE = CARDINAL;
TokenIndex: TYPE = CARDINAL;
CharIndex: TYPE = CARDINAL[0 .. 37777B]; -- this upper bound saves a word in Token
CharCount: TYPE = CARDINAL;
Tokens: TYPE = RECORD
[nTokens: TokenCount ← 0,
length: TokenIndex ← 0,
tokens: ARRAY [0 .. 0) OF Token];
Token: TYPE = RECORD
[SELECT type: * FROM
alpha => [offset: CharIndex, length: CharCount],
num => [offset: CharIndex, length: CharCount],
sep => [char: CHARACTER],
ENDCASE];
sentinel: CHARACTER = 200C;

AddToken: PROCEDURE [t: Token] =
BEGIN
IF input.nTokens = input.length THEN
BEGIN
newInput: POINTER TO Tokens ←
Storage.Node[SIZE[Tokens] + ((input.length*3) / 2) * SIZE[Token]];
newInput.nTokens ← input.nTokens;
newInput.length ← (input.length * 3) / 2;
Inline.COPY
[from: @input.tokens[0], to: @newInput.tokens[0], nwords: input.nTokens*SIZE[Token]];
Storage.Free[input];
input ← newInput;
END;
input.tokens[input.nTokens] ← t;
input.nTokens ← input.nTokens + 1;
END; -- of AddToken --

Tokenize: PROCEDURE RETURNS [ok: BOOLEAN ← TRUE] =
BEGIN
state: {initial, num, alpha} ← initial;
i: CARDINAL ← 0;
tStart: CARDINAL;
AddToken[[sep[sentinel]]];
DO
char: CHARACTER;
SELECT TRUE FROM
i = s.length => char ← sentinel;
s[i] = Ascii.TAB => char ← Ascii.SP;
s[i] IN [40C .. 177C] => char ← s[i];
ENDCASE => RETURN[FALSE];
SELECT char FROM
IN [’0 .. ’9] =>
SELECT state FROM
initial => {state ← num; tStart ← i};
num => NULL;
alpha =>
{AddToken[[alpha[offset: tStart, length: i - tStart]]]; state ← num; tStart ← i};
ENDCASE;
’,, ’., ’:, ’/, ’-, ’+, Ascii.SP, sentinel =>
BEGIN
SELECT state FROM
initial => NULL;
num => {AddToken[[num[offset: tStart, length: i - tStart]]]; state ← initial};
alpha => {AddToken[[alpha[offset: tStart, length: i - tStart]]]; state ← initial};
ENDCASE;
-- The effect of the following is to ignore spaces as separators unless there is
-- nothing else, and to complain if two separator characters are adjacent.
WITH t: input.tokens[input.nTokens - 1] SELECT FROM
sep =>
IF t.char = Ascii.SP THEN t.char ← char
ELSE IF char ~= Ascii.SP THEN RETURN[FALSE];
ENDCASE => AddToken[[sep[char]]];
IF char = sentinel THEN EXIT;
END;
ENDCASE =>
SELECT state FROM
initial => {state ← alpha; tStart ← i};
num => {AddToken[[num[offset: tStart, length: i - tStart]]]; state ← alpha; tStart ← i};
alpha => NULL;
ENDCASE;
i ← i + 1;
ENDLOOP;
END; -- of Tokenize --

year: Year;
month: Month;
day: Day;
hour: Hour;
minute: Minute;
second: Second;
zoneAdjust: DeltaMinutes;
dst: BOOLEAN;

cumDays: ARRAY [FIRST[Month] - 1 .. LAST[Month]] OF CARDINAL
= [0, 31, 60, 91, 121, 152, 182, 213, 244, 274, 305, 335, 366];

OutOfRange: ERROR = CODE;

CollectValue: PROCEDURE [t: num Token, low, high: CARDINAL]
RETURNS [value: CARDINAL ← 0] =
BEGIN
FOR j: CharIndex IN [t.offset .. t.offset + t.length) DO
-- We would like to catch a bounds fault here and turn it into OutOfRange.
-- Unfortunately, the current implementation of catch phrases doesn’t support
-- this, since a catch phrase is only attached to procedure calls. Accordingly,
-- we have to do the test by hand. The actual test is a bit too stringent, but
-- it doesn’t really matter.
IF value > LAST[CARDINAL] / 10 - 1 THEN ERROR OutOfRange;
value ← value * 10 + (s[j] - ’0);
ENDLOOP;
IF ~(value IN [low .. high]) THEN ERROR OutOfRange
END; -- of CollectValue --

ParseDate: PROCEDURE [first: TokenIndex] RETURNS [next: TokenIndex] =
BEGIN
-- The following computation isn’t exactly correct, since it doesn’t account for the
-- absence of leap days in century years not divisible by 400. As it happens, the
-- actual values for baseYear and LAST[EpochDays] are such that there is only one
-- such day, and it doesn’t affect the arithmetic.

BogusMonth: ERROR = CODE;

ParseMonth: PROCEDURE [t: alpha Token] RETURNS [month: Month] =
BEGIN
MonthNames: TYPE = ARRAY Month OF STRING;
english: MonthNames ←
["January"L, "February"L, "March"L, "April"L, "May"L, "June"L,
"July"L, "August"L, "September"L, "October"L, "November"L, "December"L];
roman: MonthNames ←
["I"L, "II"L, "III"L, "IV"L, "V"L, "VI"L, "VII"L, "VIII"L, "IX"L, "X"L, "XI"L, "XII"L];
table: POINTER TO MonthNames =
SELECT String.UpperCase[s[t.offset]] FROM
’I, ’V, ’X => @roman,
ENDCASE => @english;
ss: String.SubStringDescriptor ← [base: s, offset: t.offset, length: t.length];
IF t.length < 3 THEN ERROR BogusMonth;
FOR month IN Month DO
mm: String.SubStringDescriptor ← [base: table[month], offset: 0, length: t.length];
IF String.EquivalentSubStrings[@mm, @ss] THEN EXIT;
REPEAT
FINISHED => ERROR BogusMonth;
ENDLOOP;
END; -- of ParseMonth --

CollectYear: PROCEDURE [y: num Token] RETURNS [Year] =
BEGIN
RETURN[1900 + CollectValue[y, Inline.LowHalf[baseYear - 1900], 99
! OutOfRange => CONTINUE]];
RETURN[CollectValue[y, Inline.LowHalf[baseYear], Inline.LowHalf[lastYear]]];
END; -- of CollectYear --

CollectMonth: PROCEDURE [m: num Token] RETURNS [Month] = INLINE
{RETURN[CollectValue[m, 1, 31]]};

CollectDay: PROCEDURE [d: num Token, m: Month] RETURNS [Day] = INLINE
{RETURN[CollectValue[d, 1, cumDays[m] - cumDays[m - 1]]]};

DO
ENABLE OutOfRange => GO TO bogus;
second, third: TokenIndex;
t: num Token;

GetThird: PROCEDURE =
BEGIN
WITH token: input.tokens[third] SELECT FROM
num => t ← token;
ENDCASE => ERROR Unintelligible;
END; -- of GetThird --

IF input.nTokens < first + 3 OR input.tokens[first].type = sep THEN GO TO bogus;
-- Assert: ’first’ is alpha or num and at least two tokens follow it.
IF input.tokens[second←first+1].type = sep THEN second ← second + 1;
-- Assert: ’second’ is alpha or num.
-- Ergo, second+1 < input.nTokens since input.tokens[input.nTokens-1].type = sep
IF input.tokens[third←second+1].type = sep THEN
{IF third = input.nTokens-1 THEN GO TO bogus; third ← third + 1};
-- Assert: ’third’ is alpha or num. If we are really processing a date, ’third’ will
-- have to be numeric to make sense. However, we might be processing something
-- like Wednesday, 26 May 1981, in which there is a valid date, but
-- ’first’ isn’t pointing to it yet (it’s still on Wednesday). So, we don’t check
-- that ’third’ is numeric until we are sure that ’first’ is pointing to something
-- reasonable.
WITH f: input.tokens[first] SELECT FROM
alpha =>
BEGIN
-- The first token is alpha. If it isn’t a recognizable month, it might be
-- some form of the day of the week. Whatever it is, we simply skip
-- over it (and the separator following it, if any) and try again.
month ← ParseMonth[f ! BogusMonth => {first ← second; LOOP}];
-- ’first’ corresponds to a valid month. We now require that ’second’ be
-- the day of the month and ’third’ be the year.
WITH d: input.tokens[second] SELECT FROM
num => day ← CollectDay[d, month];
ENDCASE => GO TO bogus;
GetThird[];
year ← CollectYear[t];
END;
num =>
BEGIN
GetThird[];
WITH s: input.tokens[second] SELECT FROM
alpha =>
BEGIN
-- The second token is alpha, so we will require it to be the month.
month ← ParseMonth[s ! BogusMonth => GO TO bogus];
-- Now we must decide if we have <day><month><year> or <year><month><day>
day ← CollectDay[f, month ! OutOfRange => GO TO yearFirst];
year ← CollectYear[t];
EXITS
yearFirst => {year ← CollectYear[f]; day ← CollectDay[t, month]};
END;
num =>
BEGIN
-- All three parts are numeric.
year ← CollectYear[t ! OutOfRange => GO TO yearFirst];
month ← CollectMonth[f ! OutOfRange => GO TO dayFirst];
day ← CollectDay[s, month];
EXITS
yearFirst =>
{year ← CollectYear[f]; month ← CollectMonth[s]; day ← CollectDay[t, month]};
dayFirst => {month ← CollectMonth[s]; day ← CollectDay[f, month]};
END;
ENDCASE;
END;
ENDCASE;
next ← third + 1;
EXIT
ENDLOOP;
-- Be sure we weren’t slipped a bogus leap year...
IF month = 2 AND day = 29 AND ~LeapYear[year] THEN GO TO bogus;
EXITS
bogus => ERROR Unintelligible;
END; -- of ParseDate --

ParseTime: PROCEDURE [first: TokenIndex] RETURNS [next: TokenIndex] =
BEGIN
ENABLE OutOfRange => GO TO bogus;

CollectHour: PROCEDURE [h: num Token] RETURNS [Hour] =
{RETURN[CollectValue[h, 0, 23]]};

CollectMinute: PROCEDURE [m: num Token] RETURNS [Minute] = INLINE
{RETURN[CollectValue[m, 0, 59]]};

CollectSecond: PROCEDURE [s: num Token] RETURNS [Second] = INLINE
{RETURN[CollectValue[s, 0, 59]]};

IsAMPM: PROCEDURE [t: TokenIndex] RETURNS [BOOLEAN] =
BEGIN
WITH m: input.tokens[t] SELECT FROM
alpha =>
IF m.length = 2 AND String.UpperCase[s[m.offset+1]] = ’M THEN
BEGIN
offset: Hour ← 0;
SELECT String.UpperCase[s[m.offset]] FROM
’A => offset ← 0;
’P => offset ← 12;
ENDCASE => RETURN [FALSE];
IF ~(hour IN [1 .. 12]) THEN ERROR Unintelligible;
hour ← (hour MOD 12) + offset;
RETURN [TRUE];
END;
ENDCASE;
RETURN [FALSE];
END; -- of IsAMPM --

n: num Token;
next ← first + 1;
hour ← minute ← second ← 0;
WITH f: input.tokens[first] SELECT FROM
num => n ← f;
sep => IF f.char = sentinel THEN {notes ← noTime; RETURN} ELSE GO TO bogus;
ENDCASE => GO TO bogus;
SELECT n.length FROM
1, 2, 4, 6 => NULL;
ENDCASE => GO TO bogus;
hour ← CollectHour[[num[offset: n.offset, length: MIN[n.length, 2]]]];
IF n.length <= 2 THEN
BEGIN
-- A separator must follow a 1- or 2- digit hour field.
IF next + 1 >= input.nTokens OR input.tokens[next].type ~= sep THEN GO TO bogus;
-- Assert: input.tokens[next+1] is alpha or num.
next ← next + 1;
WITH s: input.tokens[next] SELECT FROM
num => n ← s;
ENDCASE => GO TO bogus;
SELECT n.length FROM
2, 4 => next ← next + 1;
ENDCASE => GO TO bogus;
END
ELSE {n.offset ← n.offset + 2; n.length ← n.length - 2};
minute ← CollectMinute[[num[offset: n.offset, length: 2]]];
-- Assert: ’next’ indexes the token following the minutes.
IF n.length > 2 THEN
-- The minutes and seconds are concatenated.
second ← CollectSecond[[num[offset: n.offset+2, length: 2]]]
ELSE
-- Now look for optional seconds field. We assume it is present if there is a
-- colon separator following the minutes.
WITH sep: input.tokens[next] SELECT FROM
sep =>
IF sep.char = ’: THEN
-- Assert: input.tokens[next+1] is alpha or num.
WITH s: input.tokens[next+1] SELECT FROM
num => {second ← CollectSecond[s]; next ← next + 2};
ENDCASE => GO TO bogus;
ENDCASE;
-- Assert: ’next’ indexes the token following the last time part (minutes or seconds).
WITH s: input.tokens[next] SELECT FROM
sep => IF s.char ~= sentinel AND IsAMPM[next+1] THEN next ← next + 2;
alpha => IF IsAMPM[next] THEN next ← next + 1;
ENDCASE;
EXITS
bogus => ERROR Unintelligible;
END; -- of ParseTime --

ParseZone: PROCEDURE [first: TokenIndex] RETURNS [next: TokenIndex] =
BEGIN

BadZone: ERROR = CODE;

CollectSymbolic: PROCEDURE [z: alpha Token] =
BEGIN
char: CHARACTER ← s[z.offset];
SELECT z.length FROM
1 =>
BEGIN
zones: PACKED ARRAY ZoneIndex OF CHARACTER =
[’M, ’L, ’K, ’I, ’H, ’G, ’F, ’E, ’D, ’C, ’B, ’A,
’Z,
’N, ’O, ’P, ’Q, ’R, ’S, ’T, ’U, ’V, ’W, ’X, ’Y];
FOR hour: ZoneIndex IN ZoneIndex DO
IF char = zones[hour] THEN {zoneAdjust ← hour*minutesPerHour; EXIT};
REPEAT
FINISHED => GO TO badZone;
ENDLOOP;
END;
3 =>
BEGIN
naZones: PACKED ARRAY NAZones OF CHARACTER =
[’B, ’H, ’Y, ’P, ’M, ’C, ’E, ’A];
IF String.UpperCase[s[z.offset+2]] ~= ’T THEN GO TO badZone;
SELECT String.UpperCase[s[z.offset+1]] FROM
’S, ’M => NULL; -- treat "mean" same as "standard"
’D => dst ← TRUE;
ENDCASE => GO TO badZone;
SELECT char FROM
’G => IF dst THEN GO TO badZone;
’N => IF dst THEN GO TO badZone ELSE zoneAdjust ← -(3*minutesPerHour+30);
ENDCASE =>
FOR hour: NAZones IN NAZones DO
IF char = naZones[hour] THEN {zoneAdjust ← hour*minutesPerHour; EXIT};
REPEAT
FINISHED => GO TO badZone;
ENDLOOP;
END;
ENDCASE => GO TO badZone;
EXITS
badZone => ERROR BadZone;
END; -- of CollectSymbolic --

CollectAbsolute: PROCEDURE [z: num Token] RETURNS [DeltaMinutes] =
BEGIN
hour: Hour;
minute: Minute;
IF z.length ~= 4 THEN ERROR OutOfRange;
hour ← CollectValue[[num[offset: z.offset, length: 2]], 0, 23];
minute ← CollectValue[[num[offset: z.offset + 2, length: 2]], 0, 59];
RETURN [hour * minutesPerHour + minute];
END; -- of CollectAbsolute --

zoneAdjust ← 0;
dst ← FALSE;
IF notes = noTime THEN RETURN;
next ← first;
WITH z: input.tokens[next] SELECT FROM
sep =>
BEGIN
zone: Token;
SELECT z.char FROM
Ascii.SP, ’+, ’- => zone ← input.tokens[next + 1];
ENDCASE => GO TO noZone; -- includes sentinel
WITH zone: zone SELECT FROM
num =>
SELECT z.char FROM
Ascii.SP => GO TO noZone;
’+ => zoneAdjust ← CollectAbsolute[zone];
’- => zoneAdjust ← -CollectAbsolute[zone];
ENDCASE; -- can’t happen
alpha =>
IF z.char = ’+ THEN GO TO bogus
ELSE CollectSymbolic
[zone ! BadZone => IF z.char = Ascii.SP THEN GO TO noZone ELSE GO TO bogus];
ENDCASE; -- can’t happen
next ← next + 1;
END;
alpha => CollectSymbolic[z ! BadZone => GO TO noZone];
ENDCASE => GO TO noZone;
EXITS
bogus => ERROR Unintelligible;
noZone => notes ← noZone;
END; -- of ParseZone --

ConsumeSpace: PROCEDURE [t: TokenIndex] RETURNS [TokenIndex] =
BEGIN
WITH s: input.tokens[t] SELECT FROM
sep => IF s.char = Ascii.SP THEN RETURN[t + 1];
ENDCASE;
RETURN[t];
END; -- of ConsumeSpace --

LeapYear: PROCEDURE [year: Year] RETURNS [BOOLEAN] =
{RETURN[year MOD 4 = 0 AND (year MOD 100 ~= 0 OR year MOD 400 = 0)]};

YearBoundaries: PROCEDURE [year: Year, span: LONG CARDINAL]
RETURNS [LONG CARDINAL] = INLINE
-- The following expression computes the number of years y in
-- [FIRST[Year]..year) for which y MOD span is 0.
{RETURN[(year + span - 1) / span - (baseYear + span - 1) / span]};

DetermineZoneCorrection: PROCEDURE =
-- We need to compute the local time parameters in effect at this zone on the
-- date in question. Note that this is an imperfect simulation, since it assumes
-- uniform dates and times for start and end of daylight savings time within
-- the local zone.
BEGIN

FirstSundayAfter: PROCEDURE [ed: EpochDays] RETURNS [EpochDays] =
{RETURN [ed+7-((ed+baseDay) MOD 7)]};

ltp: TimeDefs.LocalTimeParameters ←
-- [direction: west, zone: 8, zoneMinutes: 0, beginDST: , endDST: ];
-- ltp ← System.GetLocalTimeParameters
-- [ ! System.LocalTimeParametersUnknown =>
-- {notes←IF notes = noZone THEN zoneGuessed ELSE timeAndZoneGuessed;CONTINUE}];
ltp ← TimeDefs.currentParameters↑;
ltp.beginDST ← Inline.LowHalf[FirstSundayAfter
[epochToJan1 + --Apr23-- (112 + (IF LeapYear[year] THEN 1 ELSE 0))] - epochToJan1];
ltp.endDST ← Inline.LowHalf[FirstSundayAfter
[epochToJan1 + --Oct24-- (294 + (IF LeapYear[year] THEN 1 ELSE 0))] - epochToJan1];
zoneAdjust ← ltp.zone * minutesPerHour + ltp.zoneminutes;
IF ltp.direction = west THEN zoneAdjust ← - zoneAdjust;
dst ← SELECT jan1ToDate FROM
IN (ltp.beginDST .. ltp.endDST) => TRUE,
= ltp.beginDST => (hour >= 2),
= ltp.endDST => (hour < 2),
ENDCASE => FALSE;
END; -- of DetermineZoneCorrection --

-- Main Body of Parse --

nextToken: TokenIndex ← SUCC[FIRST[TokenIndex]];
epochToJan1: EpochDays;
jan1ToDate: YearDays;
input: POINTER TO Tokens ← Storage.Node[SIZE[Tokens] + 20 * SIZE[Token]];
input.nTokens ← 0;
input.length ← 20;
notes ← normal;
IF ~Tokenize[] THEN ERROR Unintelligible;
-- Assert: The input has been tokenized such that:
-- input.tokens[0] = input.tokens[input.nTokens-1] = [sep[sentinel]]
-- for all i IN (0..input.nTokens-1):
-- if input.tokens[i].type = sep, then
-- input.tokens[i-1].type ~= sep and input.tokens[i+1].type ~= sep
BEGIN
nextToken ← ParseDate[nextToken ! Unintelligible => GO TO tryTimeFirst];
nextToken ← ConsumeSpace[nextToken];
nextToken ← ParseTime[nextToken];
[] ← ParseZone[nextToken];
EXITS
tryTimeFirst =>
BEGIN
nextToken ← ParseTime[nextToken];
nextToken ← ParseZone[nextToken];
nextToken ← ConsumeSpace[nextToken];
[] ← ParseDate[nextToken];
END;
END;

epochToJan1 ← (year - baseYear) * 365
+ YearBoundaries[year, 4] - YearBoundaries[year, 100] + YearBoundaries[year, 400];
jan1ToDate ←
cumDays[month - 1] + (day - 1) - (IF ~LeapYear[year] AND month > 2 THEN 1 ELSE 0);
IF notes ~= normal THEN DetermineZoneCorrection[];
-- The following gross arithmetic is required to avoid overflows.
dt ← ((epochToJan1 + jan1ToDate) + (gmtEpoch / secondsPerDay)) * secondsPerDay
+ ((hour - (IF dst THEN 1 ELSE 0)) * minutesPerHour + minute - zoneAdjust)
* secondsPerMinute
+ second;
Storage.Free[input];
END; -- of Parse --

END.