IMPLEMENTATION MODULE PascalS; (* Scanner generated by Coco/R - using the FileIO library supplied with this project. *) IMPORT FileIO, Storage; CONST noSYMB = 62; (*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; LOOP IF (ch = "}") THEN DEC(level); oldEols := curLine - startLine; NextCh; IF level = 0 THEN RETURN TRUE END; ELSIF ch = EOF THEN RETURN FALSE ELSE NextCh END; END; (* LOOP *) END; 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 = 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 := 59; ELSIF Equal("ARRAY") THEN sym := 20; END | "B": IF Equal("BEGIN") THEN sym := 34; END | "C": IF Equal("CASE") THEN sym := 29; ELSIF Equal("CONST") THEN sym := 12; END | "D": IF Equal("DIV") THEN sym := 57; ELSIF Equal("DO") THEN sym := 38; ELSIF Equal("DOWNTO") THEN sym := 46; END | "E": IF Equal("ELSE") THEN sym := 43; ELSIF Equal("END") THEN sym := 25; END | "F": IF Equal("FILE") THEN sym := 27; ELSIF Equal("FOR") THEN sym := 44; ELSIF Equal("FORWARD") THEN sym := 33; ELSIF Equal("FUNCTION") THEN sym := 32; END | "G": IF Equal("GOTO") THEN sym := 36; END | "I": IF Equal("IF") THEN sym := 41; ELSIF Equal("IN") THEN sym := 53; END | "L": IF Equal("LABEL") THEN sym := 10; END | "M": IF Equal("MOD") THEN sym := 58; END | "N": IF Equal("NIL") THEN sym := 61; ELSIF Equal("NOT") THEN sym := 60; END | "O": IF Equal("OF") THEN sym := 23; ELSIF Equal("OR") THEN sym := 54; END | "P": IF Equal("PACKED") THEN sym := 17; ELSIF Equal("PROCEDURE") THEN sym := 31; ELSIF Equal("PROGRAM") THEN sym := 5; END | "R": IF Equal("RECORD") THEN sym := 24; ELSIF Equal("REPEAT") THEN sym := 39; END | "S": IF Equal("SET") THEN sym := 26; END | "T": IF Equal("THEN") THEN sym := 42; ELSIF Equal("TO") THEN sym := 45; ELSIF Equal("TYPE") THEN sym := 16; END | "U": IF Equal("UNTIL") THEN sym := 40; END | "V": IF Equal("VAR") THEN sym := 30; END | "W": IF Equal("WHILE") THEN sym := 37; ELSIF Equal("WITH") THEN sym := 47; END ELSE END END CheckLiteral; BEGIN (*Get*) WHILE (ch = ' ') OR ((ch >= CHR(9)) & (ch <= CHR(13))) DO NextCh END; IF ((ch = "{") OR (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")) THEN ELSE sym := 1; CheckLiteral; RETURN END; | 2: bp := bp - apx - Long1; DEC(nextLen, ORDL(apx)); NextCh; sym := 2; RETURN | 3: IF ((ch >= "0") & (ch <= "9")) THEN ELSIF (ch = "E") THEN state := 4; ELSE sym := 3; RETURN END; | 4: IF ((ch >= "0") & (ch <= "9")) THEN state := 6; ELSIF ((ch = "+") OR (ch = "-")) THEN state := 5; ELSE sym := noSYMB; RETURN END; | 5: IF ((ch >= "0") & (ch <= "9")) THEN state := 6; ELSE sym := noSYMB; RETURN END; | 6: IF ((ch >= "0") & (ch <= "9")) THEN ELSE sym := 3; RETURN END; | 7: IF ((ch >= "0") & (ch <= "9")) THEN state := 9; ELSIF ((ch = "+") OR (ch = "-")) THEN state := 8; ELSE sym := noSYMB; RETURN END; | 8: IF ((ch >= "0") & (ch <= "9")) THEN state := 9; ELSE sym := noSYMB; RETURN END; | 9: IF ((ch >= "0") & (ch <= "9")) THEN ELSE sym := 3; RETURN END; | 10: IF ((ch <= CHR(12)) OR (ch >= CHR(14)) & (ch <= "&") OR (ch >= "(")) THEN ELSIF (ch = "'") THEN state := 12; ELSE sym := noSYMB; RETURN END; | 11: IF ((ch >= "0") & (ch <= "9")) THEN ELSIF (ch = ".") THEN state := 13; INC(apx) ELSIF (ch = "E") THEN state := 7; ELSE sym := 2; RETURN END; | 12: IF (ch = "'") THEN state := 10; ELSE sym := 4; RETURN END; | 13: IF ((ch >= "0") & (ch <= "9")) THEN state := 3; apx := Long0 ELSIF (ch = ".") THEN state := 2; INC(apx) ELSE sym := noSYMB; RETURN END; | 14: sym := 6; RETURN | 15: IF (ch = ".") THEN state := 23; ELSE sym := 7; RETURN END; | 16: sym := 8; RETURN | 17: sym := 9; RETURN | 18: sym := 11; RETURN | 19: sym := 13; RETURN | 20: sym := 14; RETURN | 21: sym := 15; RETURN | 22: sym := 18; RETURN | 23: sym := 19; RETURN | 24: sym := 21; RETURN | 25: sym := 22; RETURN | 26: IF (ch = "=") THEN state := 27; ELSE sym := 28; RETURN END; | 27: sym := 35; RETURN | 28: IF (ch = "=") THEN state := 30; ELSIF (ch = ">") THEN state := 32; ELSE sym := 48; RETURN END; | 29: IF (ch = "=") THEN state := 31; ELSE sym := 49; RETURN END; | 30: sym := 50; RETURN | 31: sym := 51; RETURN | 32: sym := 52; RETURN | 33: sym := 55; RETURN | 34: sym := 56; RETURN | 35: 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 := CapChAt; start[ 0] := 35; start[ 1] := 36; start[ 2] := 36; start[ 3] := 36; start[ 4] := 36; start[ 5] := 36; start[ 6] := 36; start[ 7] := 36; start[ 8] := 36; start[ 9] := 36; start[ 10] := 36; start[ 11] := 36; start[ 12] := 36; start[ 13] := 36; start[ 14] := 36; start[ 15] := 36; start[ 16] := 36; start[ 17] := 36; start[ 18] := 36; start[ 19] := 36; start[ 20] := 36; start[ 21] := 36; start[ 22] := 36; start[ 23] := 36; start[ 24] := 36; start[ 25] := 36; start[ 26] := 36; start[ 27] := 36; start[ 28] := 36; start[ 29] := 36; start[ 30] := 36; start[ 31] := 36; start[ 32] := 36; start[ 33] := 36; start[ 34] := 36; start[ 35] := 36; start[ 36] := 36; start[ 37] := 36; start[ 38] := 36; start[ 39] := 10; start[ 40] := 16; start[ 41] := 17; start[ 42] := 33; start[ 43] := 20; start[ 44] := 18; start[ 45] := 21; start[ 46] := 15; start[ 47] := 34; start[ 48] := 11; start[ 49] := 11; start[ 50] := 11; start[ 51] := 11; start[ 52] := 11; start[ 53] := 11; start[ 54] := 11; start[ 55] := 11; start[ 56] := 11; start[ 57] := 11; start[ 58] := 26; start[ 59] := 14; start[ 60] := 28; start[ 61] := 19; start[ 62] := 29; start[ 63] := 36; start[ 64] := 36; 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] := 24; start[ 92] := 36; start[ 93] := 25; start[ 94] := 22; start[ 95] := 36; start[ 96] := 36; start[ 97] := 36; start[ 98] := 36; start[ 99] := 36; start[100] := 36; start[101] := 36; start[102] := 36; start[103] := 36; start[104] := 36; start[105] := 36; start[106] := 36; start[107] := 36; start[108] := 36; start[109] := 36; start[110] := 36; start[111] := 36; start[112] := 36; start[113] := 36; start[114] := 36; start[115] := 36; start[116] := 36; start[117] := 36; start[118] := 36; start[119] := 36; start[120] := 36; start[121] := 36; start[122] := 36; start[123] := 36; start[124] := 36; start[125] := 36; start[126] := 36; start[127] := 36; start[128] := 36; start[129] := 36; start[130] := 36; start[131] := 36; start[132] := 36; start[133] := 36; start[134] := 36; start[135] := 36; start[136] := 36; start[137] := 36; start[138] := 36; start[139] := 36; start[140] := 36; start[141] := 36; start[142] := 36; start[143] := 36; start[144] := 36; start[145] := 36; start[146] := 36; start[147] := 36; start[148] := 36; start[149] := 36; start[150] := 36; start[151] := 36; start[152] := 36; start[153] := 36; start[154] := 36; start[155] := 36; start[156] := 36; start[157] := 36; start[158] := 36; start[159] := 36; start[160] := 36; start[161] := 36; start[162] := 36; start[163] := 36; start[164] := 36; start[165] := 36; start[166] := 36; start[167] := 36; start[168] := 36; start[169] := 36; start[170] := 36; start[171] := 36; start[172] := 36; start[173] := 36; start[174] := 36; start[175] := 36; start[176] := 36; start[177] := 36; start[178] := 36; start[179] := 36; start[180] := 36; start[181] := 36; start[182] := 36; start[183] := 36; start[184] := 36; start[185] := 36; start[186] := 36; start[187] := 36; start[188] := 36; start[189] := 36; start[190] := 36; start[191] := 36; start[192] := 36; start[193] := 36; start[194] := 36; start[195] := 36; start[196] := 36; start[197] := 36; start[198] := 36; start[199] := 36; start[200] := 36; start[201] := 36; start[202] := 36; start[203] := 36; start[204] := 36; start[205] := 36; start[206] := 36; start[207] := 36; start[208] := 36; start[209] := 36; start[210] := 36; start[211] := 36; start[212] := 36; start[213] := 36; start[214] := 36; start[215] := 36; start[216] := 36; start[217] := 36; start[218] := 36; start[219] := 36; start[220] := 36; start[221] := 36; start[222] := 36; start[223] := 36; start[224] := 36; start[225] := 36; start[226] := 36; start[227] := 36; start[228] := 36; start[229] := 36; start[230] := 36; start[231] := 36; start[232] := 36; start[233] := 36; start[234] := 36; start[235] := 36; start[236] := 36; start[237] := 36; start[238] := 36; start[239] := 36; start[240] := 36; start[241] := 36; start[242] := 36; start[243] := 36; start[244] := 36; start[245] := 36; start[246] := 36; start[247] := 36; start[248] := 36; start[249] := 36; start[250] := 36; start[251] := 36; start[252] := 36; start[253] := 36; start[254] := 36; start[255] := 36; Error := Err; lastCh := EOF; END PascalS.