IMPLEMENTATION MODULE M2cS; (* Scanner generated by Coco/R - using the FileIO library supplied with this project. *) IMPORT FileIO, Storage; CONST noSYMB = 77; (*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 "A": IF Equal("AND") THEN sym := 68; ELSIF Equal("ARRAY") THEN sym := 26; END | "B": IF Equal("BEGIN") THEN sym := 9; ELSIF Equal("BY") THEN sym := 46; END | "C": IF Equal("CASE") THEN sym := 38; ELSIF Equal("CONST") THEN sym := 11; END | "D": IF Equal("DEFINITION") THEN sym := 75; ELSIF Equal("DISPOSE") THEN sym := 51; ELSIF Equal("DIV") THEN sym := 66; ELSIF Equal("DO") THEN sym := 41; END | "E": IF Equal("ELSE") THEN sym := 37; ELSIF Equal("ELSIF") THEN sym := 36; ELSIF Equal("END") THEN sym := 10; ELSIF Equal("EXIT") THEN sym := 32; ELSIF Equal("EXPORT") THEN sym := 21; END | "F": IF Equal("FOR") THEN sym := 45; ELSIF Equal("FORWARD") THEN sym := 19; ELSIF Equal("FROM") THEN sym := 5; END | "H": IF Equal("HIGH") THEN sym := 70; END | "I": IF Equal("IF") THEN sym := 34; ELSIF Equal("IMPLEMENTATION") THEN sym := 76; ELSIF Equal("IMPORT") THEN sym := 6; ELSIF Equal("IN") THEN sym := 61; END | "L": IF Equal("LOOP") THEN sym := 44; END | "M": IF Equal("MOD") THEN sym := 67; ELSIF Equal("MODULE") THEN sym := 20; END | "N": IF Equal("NEW") THEN sym := 50; ELSIF Equal("NOT") THEN sym := 71; END | "O": IF Equal("OF") THEN sym := 27; ELSIF Equal("OR") THEN sym := 63; END | "P": IF Equal("POINTER") THEN sym := 30; ELSIF Equal("PROCEDURE") THEN sym := 16; END | "R": IF Equal("RECORD") THEN sym := 28; ELSIF Equal("REPEAT") THEN sym := 42; ELSIF Equal("RETURN") THEN sym := 49; END | "S": IF Equal("SET") THEN sym := 29; END | "T": IF Equal("THEN") THEN sym := 35; ELSIF Equal("TO") THEN sym := 31; ELSIF Equal("TYPE") THEN sym := 12; END | "U": IF Equal("UNTIL") THEN sym := 43; END | "V": IF Equal("VAR") THEN sym := 13; END | "W": IF Equal("WHILE") THEN sym := 40; ELSIF Equal("WITH") THEN sym := 48; ELSIF Equal("WriteInt") THEN sym := 52; ELSIF Equal("WriteString") THEN sym := 53; 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: IF ((ch >= "0") & (ch <= "9") OR (ch >= "A") & (ch <= "F")) THEN ELSIF (ch = "H") THEN state := 4; ELSE sym := noSYMB; RETURN END; | 3: bp := bp - apx - Long1; DEC(nextLen, ORDL(apx)); NextCh; sym := 2; RETURN | 4: sym := 2; RETURN | 5: IF ((ch >= "0") & (ch <= "9")) THEN ELSIF (ch = "E") THEN state := 6; ELSE sym := 3; RETURN END; | 6: IF ((ch >= "0") & (ch <= "9")) THEN state := 8; ELSIF ((ch = "+") OR (ch = "-")) THEN state := 7; ELSE sym := noSYMB; RETURN END; | 7: IF ((ch >= "0") & (ch <= "9")) THEN state := 8; ELSE sym := noSYMB; RETURN END; | 8: IF ((ch >= "0") & (ch <= "9")) THEN ELSE sym := 3; RETURN END; | 9: IF ((ch <= CHR(12)) OR (ch >= CHR(14)) & (ch <= "&") OR (ch >= "(")) THEN ELSIF (ch = "'") THEN state := 11; ELSE sym := noSYMB; RETURN END; | 10: IF ((ch <= CHR(12)) OR (ch >= CHR(14)) & (ch <= "!") OR (ch >= "#")) THEN ELSIF (ch = '"') THEN state := 11; ELSE sym := noSYMB; RETURN END; | 11: sym := 4; RETURN | 12: IF ((ch >= "0") & (ch <= "9")) THEN ELSIF ((ch >= "A") & (ch <= "F")) THEN state := 2; ELSIF (ch = ".") THEN state := 13; INC(apx) ELSIF (ch = "H") THEN state := 4; ELSE sym := 2; RETURN END; | 13: IF ((ch >= "0") & (ch <= "9")) THEN state := 5; apx := Long0 ELSIF (ch = ".") THEN state := 3; INC(apx) ELSIF (ch = "E") THEN state := 6; apx := Long0 ELSE sym := 3; RETURN END; | 14: sym := 7; RETURN | 15: sym := 8; RETURN | 16: sym := 14; RETURN | 17: IF (ch = "=") THEN state := 24; ELSE sym := 15; RETURN END; | 18: sym := 17; RETURN | 19: sym := 18; RETURN | 20: IF (ch = ".") THEN state := 22; ELSE sym := 22; RETURN END; | 21: sym := 23; RETURN | 22: sym := 24; RETURN | 23: sym := 25; RETURN | 24: sym := 33; RETURN | 25: sym := 39; RETURN | 26: sym := 47; RETURN | 27: sym := 54; RETURN | 28: sym := 55; RETURN | 29: IF (ch = ">") THEN state := 30; ELSIF (ch = "=") THEN state := 31; ELSE sym := 57; RETURN END; | 30: sym := 56; RETURN | 31: sym := 58; RETURN | 32: IF (ch = "=") THEN state := 33; ELSE sym := 59; RETURN END; | 33: sym := 60; RETURN | 34: sym := 62; RETURN | 35: sym := 64; RETURN | 36: sym := 65; RETURN | 37: sym := 69; RETURN | 38: sym := 72; RETURN | 39: sym := 73; RETURN | 40: sym := 74; RETURN | 41: 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] := 41; start[ 1] := 42; start[ 2] := 42; start[ 3] := 42; start[ 4] := 42; start[ 5] := 42; start[ 6] := 42; start[ 7] := 42; start[ 8] := 42; start[ 9] := 42; start[ 10] := 42; start[ 11] := 42; start[ 12] := 42; start[ 13] := 42; start[ 14] := 42; start[ 15] := 42; start[ 16] := 42; start[ 17] := 42; start[ 18] := 42; start[ 19] := 42; start[ 20] := 42; start[ 21] := 42; start[ 22] := 42; start[ 23] := 42; start[ 24] := 42; start[ 25] := 42; start[ 26] := 42; start[ 27] := 42; start[ 28] := 42; start[ 29] := 42; start[ 30] := 42; start[ 31] := 42; start[ 32] := 42; start[ 33] := 42; start[ 34] := 10; start[ 35] := 28; start[ 36] := 42; start[ 37] := 42; start[ 38] := 37; start[ 39] := 9; start[ 40] := 18; start[ 41] := 19; start[ 42] := 35; start[ 43] := 34; start[ 44] := 14; start[ 45] := 26; start[ 46] := 20; start[ 47] := 36; start[ 48] := 12; start[ 49] := 12; start[ 50] := 12; start[ 51] := 12; start[ 52] := 12; start[ 53] := 12; start[ 54] := 12; start[ 55] := 12; start[ 56] := 12; start[ 57] := 12; start[ 58] := 17; start[ 59] := 15; start[ 60] := 29; start[ 61] := 16; start[ 62] := 32; start[ 63] := 42; start[ 64] := 42; 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] := 21; start[ 92] := 42; start[ 93] := 23; start[ 94] := 27; start[ 95] := 42; start[ 96] := 42; 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] := 39; start[124] := 25; start[125] := 40; start[126] := 38; start[127] := 42; start[128] := 42; start[129] := 42; start[130] := 42; start[131] := 42; start[132] := 42; start[133] := 42; start[134] := 42; start[135] := 42; start[136] := 42; start[137] := 42; start[138] := 42; start[139] := 42; start[140] := 42; start[141] := 42; start[142] := 42; start[143] := 42; start[144] := 42; start[145] := 42; start[146] := 42; start[147] := 42; start[148] := 42; start[149] := 42; start[150] := 42; start[151] := 42; start[152] := 42; start[153] := 42; start[154] := 42; start[155] := 42; start[156] := 42; start[157] := 42; start[158] := 42; start[159] := 42; start[160] := 42; start[161] := 42; start[162] := 42; start[163] := 42; start[164] := 42; start[165] := 42; start[166] := 42; start[167] := 42; start[168] := 42; start[169] := 42; start[170] := 42; start[171] := 42; start[172] := 42; start[173] := 42; start[174] := 42; start[175] := 42; start[176] := 42; start[177] := 42; start[178] := 42; start[179] := 42; start[180] := 42; start[181] := 42; start[182] := 42; start[183] := 42; start[184] := 42; start[185] := 42; start[186] := 42; start[187] := 42; start[188] := 42; start[189] := 42; start[190] := 42; start[191] := 42; start[192] := 42; start[193] := 42; start[194] := 42; start[195] := 42; start[196] := 42; start[197] := 42; start[198] := 42; start[199] := 42; start[200] := 42; start[201] := 42; start[202] := 42; start[203] := 42; start[204] := 42; start[205] := 42; start[206] := 42; start[207] := 42; start[208] := 42; start[209] := 42; start[210] := 42; start[211] := 42; start[212] := 42; start[213] := 42; start[214] := 42; start[215] := 42; start[216] := 42; start[217] := 42; start[218] := 42; start[219] := 42; start[220] := 42; start[221] := 42; start[222] := 42; start[223] := 42; start[224] := 42; start[225] := 42; start[226] := 42; start[227] := 42; start[228] := 42; start[229] := 42; start[230] := 42; start[231] := 42; start[232] := 42; start[233] := 42; start[234] := 42; start[235] := 42; start[236] := 42; start[237] := 42; start[238] := 42; start[239] := 42; start[240] := 42; start[241] := 42; start[242] := 42; start[243] := 42; start[244] := 42; start[245] := 42; start[246] := 42; start[247] := 42; start[248] := 42; start[249] := 42; start[250] := 42; start[251] := 42; start[252] := 42; start[253] := 42; start[254] := 42; start[255] := 42; Error := Err; lastCh := EOF; END M2cS.