M2compiler-V1/M2cS.mod

IMPLEMENTATION MODULE M2cS;

(* Scanner generated by Coco/R - using the FileIO library supplied with this project. *)

IMPORT FileIO, Storage;

CONST
  noSYMB  = 7; (*error token code*)
  (* not only for errors but also for not finished states of scanner analysis *)
  eof     = 32C (* MS-DOS Keyboard eof char *);
  EOF     = 0C;
  EOL     = 15C;
  CR      = 15C;
  LF      = 12C;
  Long0   = 0;
  Long1   = 1;
  BlkSize = 16384;
TYPE
  BufBlock   = ARRAY [0 .. BlkSize-1] OF CHAR;
  Buffer     = ARRAY [0 .. 31] OF POINTER TO BufBlock;
  StartTable = ARRAY [0 .. 255] OF INTEGER;
  GetCH      = PROCEDURE (INT32): CHAR;
VAR
  lastCh,
  ch:        CHAR;       (*current input character*)
  curLine:   INTEGER;    (*current input line (may be higher than line)*)
  lineStart: INT32;      (*start position of current line*)
  apx:       INT32;      (*length of appendix (CONTEXT phrase)*)
  oldEols:   INTEGER;    (*number of EOLs in a comment*)
  bp, bp0:   INT32;      (*current position in buf
                           (bp0: position of current token)*)
  inputLen:  INT32;      (*source file size*)
  buf:       Buffer;     (*source buffer for low-level access*)
  start:     StartTable; (*start state for every character*)
  CurrentCh: GetCH;

PROCEDURE Err (nr, line, col: INTEGER; pos: INT32);
  BEGIN
    INC(errors)
  END Err;

PROCEDURE NextCh;
(* Return global variable ch *)
  BEGIN
    lastCh := ch; INC(bp); ch := CurrentCh(bp);
    IF (ch = EOL) OR (ch = LF) AND (lastCh # EOL) THEN
      INC(curLine); lineStart := bp
    END
  END NextCh;

PROCEDURE Comment (): BOOLEAN;
  VAR
    level, startLine: INTEGER;
    oldLineStart: INT32;
  BEGIN
    level := 1; startLine := curLine; oldLineStart := lineStart;
    IF (ch = "(") THEN
      NextCh;
      IF (ch = "*") THEN
        NextCh;
        LOOP
          IF (ch = "*") THEN
            NextCh;
            IF (ch = ")") THEN
              DEC(level); NextCh;
              IF level = 0 THEN RETURN TRUE END
            END;
          ELSIF (ch = "(") THEN
            NextCh;
            IF (ch = "*") THEN INC(level); NextCh END;
          ELSIF ch = EOF THEN RETURN FALSE
          ELSE NextCh END;
        END; (* LOOP *)
      ELSE
        IF (ch = CR) OR (ch = LF) THEN
          DEC(curLine); lineStart := oldLineStart
        END;
        DEC(bp); ch := lastCh;
      END;
    END;
    RETURN FALSE;
  END Comment;

PROCEDURE Get (VAR sym: CARDINAL);
  VAR
    state: CARDINAL;

  PROCEDURE Equal (s: ARRAY OF CHAR): BOOLEAN;
    VAR
      i: CARDINAL;
      q: INT32;
    BEGIN
      IF nextLen # LENGTH(s) THEN RETURN FALSE END;
      i := 1; q := bp0; INC(q);
      WHILE i < nextLen DO
        IF CurrentCh(q) # s[i] THEN RETURN FALSE END;
        INC(i); INC(q)
      END;
      RETURN TRUE
    END Equal;

  PROCEDURE CheckLiteral;
    BEGIN
      CASE CurrentCh(bp0) OF
        "B": IF Equal("BEGIN") THEN sym := 4; 
             END
      | "E": IF Equal("END") THEN sym := 5; 
             END
      | "M": IF Equal("MODULE") THEN sym := 2; 
             END
      ELSE
      END
    END CheckLiteral;

  BEGIN (*Get*)
    WHILE (ch = ' ') OR
          ((ch >= CHR(9)) & (ch <= CHR(13))) DO NextCh END;
    IF ((ch = "(")) & Comment() THEN Get(sym); RETURN END;
    pos := nextPos;   nextPos := bp;
    col := nextCol;   nextCol := VAL(INTEGER, bp - lineStart);
    line := nextLine; nextLine := curLine;
    len := nextLen;   nextLen := 0;
    apx := 0; state := start[ORD(ch)]; bp0 := bp;
    LOOP
      NextCh; INC(nextLen);
      CASE state OF
         1: IF ((ch >= "0") & (ch <= "9") OR
               (ch >= "A") & (ch <= "Z") OR
               (ch >= "a") & (ch <= "z")) THEN 
            ELSE sym := 1; CheckLiteral; RETURN
            END;
      |  2: sym := 3; RETURN
      |  3: sym := 6; RETURN
      |  4: sym := 0; ch := 0C; DEC(bp); RETURN
      ELSE sym := noSYMB; RETURN (*NextCh already done*)
      END
    END
  END Get;

PROCEDURE GetString (pos: INT32; len: CARDINAL; VAR s: ARRAY OF CHAR);
  VAR
    i: CARDINAL;
    p: INT32;
  BEGIN
    IF len > HIGH(s) THEN len := HIGH(s) END;
    p := pos; i := 0;
    WHILE i < len DO
      s[i] := CharAt(p); INC(i); INC(p)
    END;
    s[len] := 0C;
  END GetString;

PROCEDURE GetName (pos: INT32; len: CARDINAL; VAR s: ARRAY OF CHAR);
  VAR
    i: CARDINAL;
    p: INT32;
  BEGIN
    IF len > HIGH(s) THEN len := HIGH(s) END;
    p := pos; i := 0;
    WHILE i < len DO
      s[i] := CurrentCh(p); INC(i); INC(p)
    END;
    s[len] := 0C;
  END GetName;

PROCEDURE CharAt (pos: INT32): CHAR;
  VAR
    ch: CHAR;
  BEGIN
    IF pos >= inputLen THEN RETURN EOF END;
    ch := buf[ORD(pos DIV BlkSize)]^[ORD(pos MOD BlkSize)];
    IF ch # eof THEN RETURN ch ELSE RETURN EOF END
  END CharAt;

PROCEDURE CapChAt (pos: INT32): CHAR;
  VAR
    ch: CHAR;
  BEGIN
    IF pos >= inputLen THEN RETURN EOF END;
    ch := CAP(buf[ORD(pos DIV BlkSize)]^[ORD(pos MOD BlkSize)]);
    IF ch # eof THEN RETURN ch ELSE RETURN EOF END
  END CapChAt;

PROCEDURE Reset;
  VAR
    i, read: CARDINAL;
  BEGIN (*assert: src has been opened*)
    i := 0; inputLen := 0;
    REPEAT
      Storage.ALLOCATE(buf[i], BlkSize);
      read := BlkSize; FileIO.ReadBytes(src, buf[i]^, read);
      INC(i); INC(inputLen, VAL(INT32, read))
    UNTIL read # BlkSize;
    buf[i-1]^[read] := EOF;
    curLine := 1; lineStart := -2; bp := -1;
    oldEols := 0; apx := 0; errors := 0;
    NextCh;
  END Reset;

BEGIN
  CurrentCh := CharAt;
  start[  0] :=  4; start[  1] :=  5; start[  2] :=  5; start[  3] :=  5; 
  start[  4] :=  5; start[  5] :=  5; start[  6] :=  5; start[  7] :=  5; 
  start[  8] :=  5; start[  9] :=  5; start[ 10] :=  5; start[ 11] :=  5; 
  start[ 12] :=  5; start[ 13] :=  5; start[ 14] :=  5; start[ 15] :=  5; 
  start[ 16] :=  5; start[ 17] :=  5; start[ 18] :=  5; start[ 19] :=  5; 
  start[ 20] :=  5; start[ 21] :=  5; start[ 22] :=  5; start[ 23] :=  5; 
  start[ 24] :=  5; start[ 25] :=  5; start[ 26] :=  5; start[ 27] :=  5; 
  start[ 28] :=  5; start[ 29] :=  5; start[ 30] :=  5; start[ 31] :=  5; 
  start[ 32] :=  5; start[ 33] :=  5; start[ 34] :=  5; start[ 35] :=  5; 
  start[ 36] :=  5; start[ 37] :=  5; start[ 38] :=  5; start[ 39] :=  5; 
  start[ 40] :=  5; start[ 41] :=  5; start[ 42] :=  5; start[ 43] :=  5; 
  start[ 44] :=  5; start[ 45] :=  5; start[ 46] :=  3; start[ 47] :=  5; 
  start[ 48] :=  5; start[ 49] :=  5; start[ 50] :=  5; start[ 51] :=  5; 
  start[ 52] :=  5; start[ 53] :=  5; start[ 54] :=  5; start[ 55] :=  5; 
  start[ 56] :=  5; start[ 57] :=  5; start[ 58] :=  5; start[ 59] :=  2; 
  start[ 60] :=  5; start[ 61] :=  5; start[ 62] :=  5; start[ 63] :=  5; 
  start[ 64] :=  5; start[ 65] :=  1; start[ 66] :=  1; start[ 67] :=  1; 
  start[ 68] :=  1; start[ 69] :=  1; start[ 70] :=  1; start[ 71] :=  1; 
  start[ 72] :=  1; start[ 73] :=  1; start[ 74] :=  1; start[ 75] :=  1; 
  start[ 76] :=  1; start[ 77] :=  1; start[ 78] :=  1; start[ 79] :=  1; 
  start[ 80] :=  1; start[ 81] :=  1; start[ 82] :=  1; start[ 83] :=  1; 
  start[ 84] :=  1; start[ 85] :=  1; start[ 86] :=  1; start[ 87] :=  1; 
  start[ 88] :=  1; start[ 89] :=  1; start[ 90] :=  1; start[ 91] :=  5; 
  start[ 92] :=  5; start[ 93] :=  5; start[ 94] :=  5; start[ 95] :=  5; 
  start[ 96] :=  5; start[ 97] :=  1; start[ 98] :=  1; start[ 99] :=  1; 
  start[100] :=  1; start[101] :=  1; start[102] :=  1; start[103] :=  1; 
  start[104] :=  1; start[105] :=  1; start[106] :=  1; start[107] :=  1; 
  start[108] :=  1; start[109] :=  1; start[110] :=  1; start[111] :=  1; 
  start[112] :=  1; start[113] :=  1; start[114] :=  1; start[115] :=  1; 
  start[116] :=  1; start[117] :=  1; start[118] :=  1; start[119] :=  1; 
  start[120] :=  1; start[121] :=  1; start[122] :=  1; start[123] :=  5; 
  start[124] :=  5; start[125] :=  5; start[126] :=  5; start[127] :=  5; 
  start[128] :=  5; start[129] :=  5; start[130] :=  5; start[131] :=  5; 
  start[132] :=  5; start[133] :=  5; start[134] :=  5; start[135] :=  5; 
  start[136] :=  5; start[137] :=  5; start[138] :=  5; start[139] :=  5; 
  start[140] :=  5; start[141] :=  5; start[142] :=  5; start[143] :=  5; 
  start[144] :=  5; start[145] :=  5; start[146] :=  5; start[147] :=  5; 
  start[148] :=  5; start[149] :=  5; start[150] :=  5; start[151] :=  5; 
  start[152] :=  5; start[153] :=  5; start[154] :=  5; start[155] :=  5; 
  start[156] :=  5; start[157] :=  5; start[158] :=  5; start[159] :=  5; 
  start[160] :=  5; start[161] :=  5; start[162] :=  5; start[163] :=  5; 
  start[164] :=  5; start[165] :=  5; start[166] :=  5; start[167] :=  5; 
  start[168] :=  5; start[169] :=  5; start[170] :=  5; start[171] :=  5; 
  start[172] :=  5; start[173] :=  5; start[174] :=  5; start[175] :=  5; 
  start[176] :=  5; start[177] :=  5; start[178] :=  5; start[179] :=  5; 
  start[180] :=  5; start[181] :=  5; start[182] :=  5; start[183] :=  5; 
  start[184] :=  5; start[185] :=  5; start[186] :=  5; start[187] :=  5; 
  start[188] :=  5; start[189] :=  5; start[190] :=  5; start[191] :=  5; 
  start[192] :=  5; start[193] :=  5; start[194] :=  5; start[195] :=  5; 
  start[196] :=  5; start[197] :=  5; start[198] :=  5; start[199] :=  5; 
  start[200] :=  5; start[201] :=  5; start[202] :=  5; start[203] :=  5; 
  start[204] :=  5; start[205] :=  5; start[206] :=  5; start[207] :=  5; 
  start[208] :=  5; start[209] :=  5; start[210] :=  5; start[211] :=  5; 
  start[212] :=  5; start[213] :=  5; start[214] :=  5; start[215] :=  5; 
  start[216] :=  5; start[217] :=  5; start[218] :=  5; start[219] :=  5; 
  start[220] :=  5; start[221] :=  5; start[222] :=  5; start[223] :=  5; 
  start[224] :=  5; start[225] :=  5; start[226] :=  5; start[227] :=  5; 
  start[228] :=  5; start[229] :=  5; start[230] :=  5; start[231] :=  5; 
  start[232] :=  5; start[233] :=  5; start[234] :=  5; start[235] :=  5; 
  start[236] :=  5; start[237] :=  5; start[238] :=  5; start[239] :=  5; 
  start[240] :=  5; start[241] :=  5; start[242] :=  5; start[243] :=  5; 
  start[244] :=  5; start[245] :=  5; start[246] :=  5; start[247] :=  5; 
  start[248] :=  5; start[249] :=  5; start[250] :=  5; start[251] :=  5; 
  start[252] :=  5; start[253] :=  5; start[254] :=  5; start[255] :=  5; 
  Error := Err; lastCh := EOF;
END M2cS.