-- 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

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


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.


(635)\f7 4813b2B