-- Last edited by Barth, December 6, 1981 5:36 PM
-- Last edited by Chi Yung, February 25, 1982 4:33 PM
-- Last edited by Chi Yung, March 30, 1982 2:13 PM
-- Last edited by Chi Yung, April 27, 1982 6:57 PM
-- Last edited by Chi Yung, April 30, 1982 2:37 PM
-- Last edited by Chi Yung, September 1, 1983 11:31 AM
-- Last edited by JWHITE, 25-Apr-85 12:41:54
DIRECTORY
Ascii,
MachineParseDefs,
String,
InlineDefs: FROM "inlinedefs",
vmD: FROM "VirtualMgrDefs";
MachineParse: PROGRAM
IMPORTS String, vmD, InlineDefs
EXPORTS MachineParseDefs =
BEGIN
OPEN MachineParseDefs;
ParseFault: PUBLIC ERROR [why:STRING, pfBegin:vmD.CharIndex,
pfEnd:vmD.CharIndex] = CODE;
ParseMessage: PUBLIC PROCEDURE [ph:ParseHandle,
fields:DESCRIPTOR FOR ARRAY OF FieldRec]=
BEGIN
word: STRING ← [MaxFieldNameLength];
fieldName: STRING ← [MaxFieldNameLength];
fieldBegin: vmD.CharIndex;
ph.currentChar ← 0;
[] ← ParseToLeadingChar[ph];
-- loop invariant is final CR of previous field has just been eaten
UNTIL vmD.GetMessageSize[ph.message]=ph.currentChar DO
fieldName.length ← 0;
fieldBegin ← ph.currentChar;
-- InlineDefs.BITAND is a procedure that performs an AND function between
-- the 8 bits correspond to the character obtained by the
-- vmD.GetMessageChar[ph.message,ph.currentChar] with the character
-- correspond to 177C which is 01111111 (8 bits) in binary. This AND action
-- will change the bits patent of the character in such a way that the
-- first bit is always 0. The rest of the bits are the same. In this way we
-- will only read in the character we put in. Those pseudo characters, with
-- the first bit in their binary form which is not 0, put
-- in automatically by the laurel,such as the character corresponds to the
-- auto line feed, will not be read.
UNTIL InlineDefs.BITAND[vmD.GetMessageChar[ph.message,ph.currentChar],
177C]=': DO
IF ~ParseToLeadingChar[ph] THEN
IF ph.currentChar=vmD.GetMessageSize[ph.message] THEN GOTO
endOfMessage;
ParseWord[ph,word];
IF word[0]=': AND fieldName.length = 0 THEN ERROR
ParseFault["Null field name illegal",
fieldBegin, ph.currentChar];
IF word[0]=': AND fieldName.length # 0 THEN BEGIN
ph.currentChar ← ph.currentChar-word.length;
word.length ← 0;
END;
IF fieldName.length + word.length > fieldName.maxlength THEN ERROR
ParseFault["fieldName too long!", ph.currentChar, ph.currentChar];
String.AppendString[fieldName, word];
IF vmD.GetMessageSize[ph.message]=ph.currentChar THEN
ERROR ParseFault["Field name has no terminating colon", fieldBegin,
ph.currentChar];
ENDLOOP;
ph.currentChar ← ph.currentChar+1; -- eat colon
FOR i:CARDINAL IN [0..LENGTH[fields]) DO
IF String.EquivalentString[fieldName, fields[i].name] THEN BEGIN
IF fields[i].found THEN
ERROR ParseFault["Multiply defined field illegal",
fieldBegin, ph.currentChar];
fields[i].found ← TRUE;
fields[i].parseProc[ph];
EXIT;
END;
REPEAT
FINISHED => DO
IF ph.currentChar=vmD.GetMessageSize[ph.message]
THEN GOTO endOfMessage;
IF InlineDefs.BITAND[vmD.GetMessageChar[ph.message,ph.currentChar],
177C]=Ascii.CR THEN BEGIN
ph.currentChar ← ph.currentChar+1;
IF ph.currentChar=vmD.GetMessageSize[ph.message]
THEN GOTO endOfMessage;
IF ~IsBlank[ph, vmD.GetMessageChar[ph.message, ph.currentChar]]
THEN EXIT;
END;
ph.currentChar ← ph.currentChar+1;
ENDLOOP;
ENDLOOP;
REPEAT
endOfMessage => NULL;
ENDLOOP;
FOR i:CARDINAL IN [0..LENGTH[fields]) DO
IF fields[i].mustExist AND ~fields[i].found THEN BEGIN
errorString: STRING ← [MaxFieldNameLength+20];
String.AppendString[errorString, "Field "];
String.AppendString[errorString, fields[i].name];
String.AppendString[errorString, " is missing"];
ERROR ParseFault[errorString, 0, 0];
END;
ENDLOOP;
END; -- of ParseMessage
IsBlank: PUBLIC PROCEDURE [ph:ParseHandle, c:CHARACTER] RETURNS [BOOLEAN]=
BEGIN
FOR i:CARDINAL IN [0..ph.blankSet.length) DO
IF c=ph.blankSet[i] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
END; -- of IsBlank
IsBreak: PUBLIC PROCEDURE [ph:ParseHandle, c:CHARACTER] RETURNS [BOOLEAN]=
BEGIN
FOR i:CARDINAL IN [0..ph.breakSet.length) DO
IF c=ph.breakSet[i] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
END; -- of IsBreak
CheckChar: PUBLIC PROCEDURE[ph:ParseHandle, c:CHARACTER]=
BEGIN
ErrorString: STRING ← [100];
IF String.UpperCase[ParseChar[ph]]#c THEN BEGIN
ErrorString.length ← 0;
String.AppendString[ErrorString, "Selected char doesn't match expected char which should be "];
String.AppendChar[ErrorString, c];
ERROR ParseFault[ErrorString, ph.currentChar-1, ph.currentChar-1];
END;
END; -- of CheckChar
ParseChar: PUBLIC PROCEDURE[ph:ParseHandle] RETURNS [c:CHARACTER]=
BEGIN
IF ph.currentChar=vmD.GetMessageSize[ph.message] THEN
ERROR ParseFault["Field ends too soon",ph.currentChar,ph.currentChar];
c ← InlineDefs.BITAND[vmD.GetMessageChar[ph.message,ph.currentChar],
177C];
ph.currentChar ← ph.currentChar+1;
END; -- of ParseChar
ParseCharIfCharIs: PUBLIC PROCEDURE[ph:ParseHandle, c:CHARACTER]
RETURNS [BOOLEAN]=
BEGIN
IF ph.currentChar=vmD.GetMessageSize[ph.message] THEN RETURN[FALSE];
IF c=String.UpperCase[InlineDefs.BITAND
[vmD.GetMessageChar[ph.message,ph.currentChar],177C]]
THEN {ph.currentChar ← ph.currentChar+1; RETURN[TRUE]};
RETURN[FALSE];
END; -- of ParseCharIfCharIs
ParseToEndOfField: PUBLIC PROCEDURE[ph:ParseHandle]=
BEGIN
curPos:vmD.CharIndex ← ph.currentChar;
IF ParseToLeadingChar[ph] THEN
ERROR ParseFault
["Selected text not recognised", ph.currentChar, ph.currentChar];
END; -- of ParseToEndOfField
ParseToEndOfLine: PUBLIC PROCEDURE[ph:ParseHandle]=
BEGIN
curPos:vmD.CharIndex ← ph.currentChar;
IF ParseToLeadingCharOnLine[ph] THEN
ERROR ParseFault["Selected text not recognised", curPos, ph.currentChar];
END; -- of ParseToEndOfLine
ParseToNonWhite: PUBLIC PROCEDURE[ph:ParseHandle]=
BEGIN
IF ~ParseToLeadingCharOnLine[ph] THEN
ERROR ParseFault["Line ends too soon",ph.currentChar,ph.currentChar];
END; -- of ParseToNonWhite
ParseToLeadingChar: PUBLIC PROCEDURE[ph:ParseHandle]
RETURNS[isThere: BOOLEAN]=
BEGIN
c:CHARACTER;
DO
IF ParseToLeadingCharOnLine[ph] THEN RETURN[TRUE];
IF ph.currentChar=vmD.GetMessageSize[ph.message] THEN RETURN[FALSE];
c ← InlineDefs.BITAND[vmD.GetMessageChar[ph.message,ph.currentChar],
177C];
WHILE c=Ascii.CR DO
ph.currentChar ← ph.currentChar+1;
IF ph.currentChar=vmD.GetMessageSize[ph.message] THEN RETURN[FALSE];
c ← InlineDefs.BITAND[vmD.GetMessageChar[ph.message,ph.currentChar],
177C];
IF c= '! THEN EXIT;
IF ~IsBlank[ph, c] THEN RETURN[FALSE];
ENDLOOP;
IF c= '! THEN LOOP;
IF ~IsBlank[ph, c] THEN RETURN[TRUE];
ph.currentChar ← ph.currentChar+1;
ENDLOOP;
END; -- of ParseToLeadingChar
ParseToLeadingCharOnLine: PUBLIC PROCEDURE[ph:ParseHandle]
RETURNS[isThere: BOOLEAN]=
BEGIN
c:CHARACTER;
DO
IF ph.currentChar=vmD.GetMessageSize[ph.message] THEN RETURN[FALSE];
c ← InlineDefs.BITAND[vmD.GetMessageChar[ph.message,ph.currentChar],
177C];
IF c='! THEN DO
ph.currentChar ← ph.currentChar+1;
IF ph.currentChar=vmD.GetMessageSize[ph.message] THEN RETURN[FALSE];
c ← InlineDefs.BITAND[vmD.GetMessageChar[ph.message,ph.currentChar],
177C];
IF c=Ascii.CR THEN RETURN[FALSE];
ENDLOOP;
IF c=Ascii.CR THEN RETURN[FALSE];
IF ~IsBlank[ph, c] THEN RETURN[TRUE];
ph.currentChar ← ph.currentChar+1;
ENDLOOP;
END; -- of ParseToLeadingCharOnLine
ParseWord: PUBLIC PROCEDURE[ph:ParseHandle, s:STRING]=
BEGIN
c:CHARACTER;
ParseToNonWhite[ph];
s.length ← 0;
DO
c ← InlineDefs.BITAND[vmD.GetMessageChar[ph.message,ph.currentChar],
177C];
IF IsBlank[ph, c] OR IsBreak[ph, c] THEN EXIT;
IF s.length=s.maxlength THEN ERROR ParseFault["Word too long",
ph.currentChar-s.length, ph.currentChar];
s[s.length] ← c;
s.length ← s.length+1;
ph.currentChar ← ph.currentChar+1;
IF ph.currentChar=vmD.GetMessageSize[ph.message] THEN EXIT;
ENDLOOP;
IF s.length=0 THEN BEGIN
s[0] ← c;
s.length ← 1;
ph.currentChar ← ph.currentChar+1;
END;
END; -- of ParseWord
ParseDecimal: PUBLIC PROCEDURE [ph:ParseHandle, lBound:CARDINAL ← 0,
uBound:CARDINAL ← LAST[CARDINAL]] RETURNS [n:CARDINAL]=
BEGIN
s:STRING ← [8];
OutOfBoundString: STRING ← [100];
ParseWord[ph, s];
DO
IF s[s.length-1] ~ IN ['0..'9] THEN BEGIN
s.length ← s.length -1;
ph.currentChar ← ph.currentChar - 1;
END ELSE EXIT;
ENDLOOP;
n ← String.StringToNumber[s,10 ! String.InvalidNumber =>
ParseFault["Invalid number", ph.currentChar-s.length, ph.currentChar]];
IF n<lBound THEN BEGIN
String.AppendString
[OutOfBoundString, "Number is out of the lower bound, which is "];
String.AppendNumber[OutOfBoundString, lBound , 10];
ParseFault[OutOfBoundString, ph.currentChar-s.length, ph.currentChar];
END;
IF n>uBound THEN BEGIN
String.AppendString
[OutOfBoundString, "Number is out of the upper bound, which is "];
String.AppendNumber[OutOfBoundString, uBound , 10];
ParseFault[OutOfBoundString, ph.currentChar-s.length, ph.currentChar];
END;
END; -- of ParseDecimal
ParseInteger: PUBLIC PROCEDURE [ph:ParseHandle, lBound:INTEGER ← FIRST[INTEGER], uBound:INTEGER ← LAST[INTEGER]] RETURNS [n:INTEGER]=
BEGIN
s:STRING ← [8];
OutOfBoundString: STRING ← [100];
ParseWord[ph, s];
DO
IF s[s.length-1] ~ IN ['0..'9] THEN BEGIN
s.length ← s.length -1;
ph.currentChar ← ph.currentChar - 1;
END ELSE EXIT;
ENDLOOP;
n ← String.StringToNumber[s,10 ! String.InvalidNumber =>
ParseFault["Invalid number", ph.currentChar-s.length, ph.currentChar]];
IF n<lBound THEN BEGIN
String.AppendString
[OutOfBoundString, "Number is out of the lower bound, which is "];
String.AppendNumber[OutOfBoundString, lBound , 10];
ParseFault[OutOfBoundString, ph.currentChar-s.length, ph.currentChar];
END;
IF n>uBound THEN BEGIN
String.AppendString
[OutOfBoundString, "Number is out of the upper bound, which is "];
String.AppendNumber[OutOfBoundString, uBound , 10];
ParseFault[OutOfBoundString, ph.currentChar-s.length, ph.currentChar];
END;
END; -- of ParseINTEGER
ParseScaledNumber:PUBLIC PROCEDURE[ph:ParseHandle,scale:INTEGER ← 0,
lBound:CARDINAL ← 0, uBound:CARDINAL ← LAST[CARDINAL]] RETURNS [n:CARDINAL ← 0, NumberOfDigitsAndDecimal: CARDINAL ← 0]=
BEGIN
c:CHARACTER;
decimal: INTEGER← 0;
--decimal is the number of digits after the decimal point + the
--decimal point
decimalLoophole: CARDINAL ← 0;
nlong:LONG CARDINAL ← 0;
OutOfBoundString: STRING ← [100];
AccuracyString: STRING ← [100];
ParseToNonWhite[ph];
IF ParseCharIfCharIs[ph, '-] THEN ERROR ParseFault
["Negative number is not allowed",ph.currentChar -1, ph.currentChar];
DO
c ← InlineDefs.BITAND[vmD.GetMessageChar[ph.message,ph.currentChar],
177C];
IF c ~IN ['0..'9] THEN EXIT;
nlong ← nlong*10 +(c -'0);
NumberOfDigitsAndDecimal ← NumberOfDigitsAndDecimal +1;
ph.currentChar ← ph.currentChar+1;
IF ph.currentChar=vmD.GetMessageSize[ph.message] THEN EXIT;
ENDLOOP;
IF ParseCharIfCharIs[ph, '.] THEN BEGIN
NumberOfDigitsAndDecimal ← NumberOfDigitsAndDecimal +1;
decimal ← decimal + 1;
DO
c ← InlineDefs.BITAND[vmD.GetMessageChar[ph.message,ph.currentChar],
177C];
IF c ~IN ['0..'9] THEN EXIT;
nlong ← nlong*10 +(c -'0);
NumberOfDigitsAndDecimal ← NumberOfDigitsAndDecimal +1;
decimal ← decimal + 1;
ph.currentChar ← ph.currentChar+1;
IF ph.currentChar=vmD.GetMessageSize[ph.message] THEN EXIT;
ENDLOOP;
END;
IF (decimal - 1) > scale THEN BEGIN
String.AppendString[AccuracyString,
"Number of decimal places allowed is "];
String.AppendNumber[AccuracyString, scale, 10];
ERROR ParseFault[AccuracyString,
ph.currentChar - NumberOfDigitsAndDecimal,ph.currentChar];
END;
decimalLoophole ← LOOPHOLE [decimal];
IF decimal = 0 AND NumberOfDigitsAndDecimal > 4 OR
decimal # 0 AND NumberOfDigitsAndDecimal - decimalLoophole > 4
THEN ERROR ParseFault
["You are trying to enter an unreasonably large number.",
ph.currentChar -NumberOfDigitsAndDecimal, ph.currentChar];
-- The reason that the above tests is here instead of earlier
-- in the procedure is becuase we need to finish the do loop in
-- order to obtain the value of the NumberOfDigitsAndDecimal so
-- as to display the error message correctly.
IF decimal = 0 THEN decimal ← decimal + 1;
SELECT (decimal-1)-scale FROM
> 0 => THROUGH[1..(decimal-1)-scale] DO
nlong ← nlong/10
ENDLOOP;
< 0 => THROUGH[1..scale-(decimal-1)] DO
nlong ← nlong*10
ENDLOOP;
ENDCASE;
IF nlong<lBound THEN BEGIN
String.AppendString[OutOfBoundString,
"Number is out of the lower bound, which is "];
AppendScaleNumber[lBound, scale, OutOfBoundString];
ParseFault[OutOfBoundString, ph.currentChar-NumberOfDigitsAndDecimal ,
ph.currentChar];
END;
IF nlong>uBound THEN BEGIN
String.AppendString[OutOfBoundString,
"Number is out of the upper bound, which is "];
AppendScaleNumber[uBound, scale, OutOfBoundString];
ParseFault[OutOfBoundString, ph.currentChar-NumberOfDigitsAndDecimal,
ph.currentChar];
END;
n ← InlineDefs.LowHalf[nlong];
END; -- of ParseScaledNumberNoSpace
AppendScaleNumber: PUBLIC PROCEDURE[n: CARDINAL, scale: CARDINAL,
OutOfBoundString:STRING]=
BEGIN
m: CARDINAL;
m ← n;
THROUGH [1..scale] DO
m ← m/10
ENDLOOP;
String.AppendNumber[OutOfBoundString, m, 10];
String.AppendChar[OutOfBoundString,'.];
THROUGH [1..scale] DO
m ← m*10
ENDLOOP;
m ← n - m;
String.AppendNumber[OutOfBoundString, m, 10];
END;
MissingValueCheck: PUBLIC PROCEDURE[ph:ParseHandle] =
BEGIN
c: CHARACTER;
curPos: vmD.CharIndex;
ParseToNonWhite[ph];
curPos ← ph.currentChar;
c ← ParseChar[ph];
IF c = '- THEN ERROR ParseFault
["Cannot have negative number!", curPos, curPos+ 1];
IF c = '. THEN BEGIN
ParseToNonWhite[ph];
c ← ParseChar[ph];
IF c ~ IN ['0..'9] THEN ParseFault["Value is missing here.", curPos,
curPos+1];
ph.currentChar ← curPos;
END ELSE BEGIN
IF c ~ IN ['0..'9] THEN ERROR ParseFault["Value is missing here.",
curPos-1, curPos-1];
ph.currentChar ← curPos;
END;
END; -- of MissingValueCheck
ParseNibble: PUBLIC PROCEDURE [ph:ParseHandle, lBound:CARDINAL,
uBound:CARDINAL, nullOK:BOOLEAN ← TRUE] RETURNS [n:Nibble]=
BEGIN
c:CHARACTER;
s:STRING ← [8];
ParseWord[ph, s];
n ← 0;
FOR i:CARDINAL IN [0..s.length) DO
c ← s[i];
IF c >= '0 AND c <= '9 THEN n ← n*16 + (c - '0)
ELSE BEGIN
c←String.UpperCase[c];
IF c >= 'A AND c <= 'F THEN n ← n*16 + (c - 'A + 10)
ELSE ERROR ParseFault["Invalid hex digit in number",
ph.currentChar-s.length, ph.currentChar];
END;
ENDLOOP;
IF (n<lBound OR n>uBound) AND (~nullOK OR n#0)
THEN ParseFault["Hex number out of bounds",
ph.currentChar-s.length, ph.currentChar];
END; -- of ParseNibble
ParseBinary: PUBLIC PROCEDURE[ph:ParseHandle] RETURNS[n:CARDINAL]=
BEGIN
c:CHARACTER;
ParseToNonWhite[ph];
c ← InlineDefs.BITAND[vmD.GetMessageChar[ph.message,ph.currentChar],
177C];
ph.currentChar ← ph.currentChar+1;
IF c='0 THEN RETURN[0];
IF c='1 THEN RETURN[1];
ERROR ParseFault["Illegal binary value",ph.currentChar,ph.currentChar+1];
END; -- of ParseBinary
ParseTime: PUBLIC PROCEDURE[ph:ParseHandle] RETURNS[h,m,s:CARDINAL]=
BEGIN
h ← ParseDecimal[ph,0,99]; CheckChar[ph, ':];
m ← ParseDecimal[ph,0,59]; CheckChar[ph, ':];
s ← ParseDecimal[ph,0,59];
END; -- of ParseTime
END.