|
|
@@ -0,0 +1,331 @@
|
|
|
+IMPLEMENTATION MODULE -->modulename;
|
|
|
+
|
|
|
+(* Scanner generated by Coco/R - using the FileIO library supplied with this project. *)
|
|
|
+
|
|
|
+IMPORT FileIO, Storage;
|
|
|
+FROM Storage IMPORT ALLOCATE; (* gm2 needs this for NEW substitution *)
|
|
|
+
|
|
|
+CONST
|
|
|
+ noSYMB = -->unknownsym; (*error token code*)
|
|
|
+ (* not only for errors but also for not finished states of scanner analysis *)
|
|
|
+ eof = CHR(26) (* MS-DOS Keyboard eof char *);
|
|
|
+ EOF = CHR(0);
|
|
|
+ EOL = CHR(13);
|
|
|
+ CR = CHR(13);
|
|
|
+ LF = CHR(10);
|
|
|
+ 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;
|
|
|
+
|
|
|
+ (* ---- TopSpeed conditional compilation ---- *)
|
|
|
+ condStk: ARRAY [0 .. 31] OF BOOLEAN;
|
|
|
+ nCond: CARDINAL;
|
|
|
+ defs: ARRAY [0 .. 31] OF ARRAY [0 .. 31] OF CHAR;
|
|
|
+ nDefs: CARDINAL;
|
|
|
+ defsInit: BOOLEAN;
|
|
|
+
|
|
|
+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;
|
|
|
+ -->commentRETURN FALSE;
|
|
|
+ END Comment;
|
|
|
+
|
|
|
+
|
|
|
+(* ---- TopSpeed conditional compilation: (*%T cond*) / (*%F cond*) /
|
|
|
+ (*%E*) ---- Blank the inactive regions of the source buffer (CR/LF
|
|
|
+ kept, so line numbers survive) before scanning. Conditions are
|
|
|
+ evaluated against a small define set (see InitDefs); an unknown
|
|
|
+ symbol is 'undefined'. *)
|
|
|
+PROCEDURE CopyStr (s: ARRAY OF CHAR; VAR t: ARRAY OF CHAR);
|
|
|
+ VAR i: CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ i := 0;
|
|
|
+ WHILE (i <= HIGH(t)) AND (i <= HIGH(s)) AND (s[i] # CHR(0)) DO
|
|
|
+ t[i] := s[i]; INC(i)
|
|
|
+ END;
|
|
|
+ IF i <= HIGH(t) THEN t[i] := CHR(0) END
|
|
|
+ END CopyStr;
|
|
|
+
|
|
|
+PROCEDURE Same (a, b: ARRAY OF CHAR): BOOLEAN;
|
|
|
+ VAR i: CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ i := 0;
|
|
|
+ WHILE (a[i] # CHR(0)) AND (b[i] # CHR(0)) AND (a[i] = b[i]) DO INC(i) END;
|
|
|
+ RETURN a[i] = b[i]
|
|
|
+ END Same;
|
|
|
+
|
|
|
+PROCEDURE AddDef (s: ARRAY OF CHAR);
|
|
|
+ BEGIN
|
|
|
+ IF nDefs <= HIGH(defs) THEN CopyStr(s, defs[nDefs]); INC(nDefs) END
|
|
|
+ END AddDef;
|
|
|
+
|
|
|
+PROCEDURE InitDefs;
|
|
|
+(* Define set used to select conditional branches. Tuned for the
|
|
|
+ TS-V3 corpus: the "_fdata"/"_mthread" variants are the plain,
|
|
|
+ parseable ones; "_OS2"/"_fcall"/... are left undefined so the
|
|
|
+ non-OS2 branches are taken. *)
|
|
|
+ BEGIN
|
|
|
+ nDefs := 0;
|
|
|
+ (* DEFINES:BEGIN *)
|
|
|
+ AddDef("_fdata");
|
|
|
+ AddDef("_mthread");
|
|
|
+ AddDef("_fptr");
|
|
|
+ AddDef("_fcall");
|
|
|
+ (* DEFINES:END *)
|
|
|
+ END InitDefs;
|
|
|
+
|
|
|
+PROCEDURE IsDefined (id: ARRAY OF CHAR): BOOLEAN;
|
|
|
+ VAR k: CARDINAL;
|
|
|
+ BEGIN
|
|
|
+ k := 0;
|
|
|
+ WHILE k < nDefs DO
|
|
|
+ IF Same(id, defs[k]) THEN RETURN TRUE END;
|
|
|
+ INC(k)
|
|
|
+ END;
|
|
|
+ RETURN FALSE
|
|
|
+ END IsDefined;
|
|
|
+
|
|
|
+PROCEDURE CondIdent (c: CHAR): BOOLEAN;
|
|
|
+ BEGIN
|
|
|
+ RETURN ((c >= "A") AND (c <= "Z")) OR ((c >= "a") AND (c <= "z"))
|
|
|
+ OR ((c >= "0") AND (c <= "9")) OR (c = "_")
|
|
|
+ END CondIdent;
|
|
|
+
|
|
|
+PROCEDURE CondBlank (p: INT32);
|
|
|
+ VAR c: CHAR;
|
|
|
+ BEGIN
|
|
|
+ IF (p < 0) OR (p >= inputLen) THEN RETURN END;
|
|
|
+ c := buf[ORD(p DIV BlkSize)]^[ORD(p MOD BlkSize)];
|
|
|
+ IF (c # CR) AND (c # LF) THEN
|
|
|
+ buf[ORD(p DIV BlkSize)]^[ORD(p MOD BlkSize)] := " "
|
|
|
+ END
|
|
|
+ END CondBlank;
|
|
|
+
|
|
|
+PROCEDURE CondFilter;
|
|
|
+ VAR p, q, j, b: INT32;
|
|
|
+ c, letter: CHAR;
|
|
|
+ id: ARRAY [0 .. 31] OF CHAR;
|
|
|
+ k: CARDINAL;
|
|
|
+ parentOk, cond, active: BOOLEAN;
|
|
|
+ BEGIN
|
|
|
+ IF NOT defsInit THEN InitDefs; defsInit := TRUE END;
|
|
|
+ nCond := 0;
|
|
|
+ p := 0;
|
|
|
+ WHILE p < inputLen DO
|
|
|
+ c := buf[ORD(p DIV BlkSize)]^[ORD(p MOD BlkSize)];
|
|
|
+ IF (c = "(") AND (p + 3 < inputLen)
|
|
|
+ AND (buf[ORD((p+1) DIV BlkSize)]^[ORD((p+1) MOD BlkSize)] = "*")
|
|
|
+ AND (buf[ORD((p+2) DIV BlkSize)]^[ORD((p+2) MOD BlkSize)] = "%") THEN
|
|
|
+ letter := buf[ORD((p+3) DIV BlkSize)]^[ORD((p+3) MOD BlkSize)];
|
|
|
+ q := p + 4;
|
|
|
+ WHILE (q + 1 < inputLen)
|
|
|
+ AND NOT ((buf[ORD(q DIV BlkSize)]^[ORD(q MOD BlkSize)] = "*")
|
|
|
+ AND (buf[ORD((q+1) DIV BlkSize)]^[ORD((q+1) MOD BlkSize)] = ")")) DO
|
|
|
+ INC(q)
|
|
|
+ END;
|
|
|
+ IF letter = "E" THEN
|
|
|
+ IF nCond > 0 THEN DEC(nCond) END
|
|
|
+ ELSE
|
|
|
+ j := p + 4; k := 0;
|
|
|
+ WHILE (j < q) AND (k <= HIGH(id)) DO
|
|
|
+ c := buf[ORD(j DIV BlkSize)]^[ORD(j MOD BlkSize)];
|
|
|
+ IF CondIdent(c) THEN id[k] := c; INC(k)
|
|
|
+ ELSIF k > 0 THEN j := q (* end of the name *)
|
|
|
+ END;
|
|
|
+ INC(j)
|
|
|
+ END;
|
|
|
+ id[k] := CHR(0);
|
|
|
+ cond := IsDefined(id);
|
|
|
+ IF letter = "F" THEN cond := NOT cond END;
|
|
|
+ parentOk := (nCond = 0) OR condStk[nCond - 1];
|
|
|
+ IF NOT parentOk THEN cond := FALSE END;
|
|
|
+ IF nCond <= HIGH(condStk) THEN condStk[nCond] := cond; INC(nCond) END
|
|
|
+ END;
|
|
|
+ b := p;
|
|
|
+ WHILE b <= q + 1 DO CondBlank(b); INC(b) END;
|
|
|
+ p := q + 2
|
|
|
+ ELSE
|
|
|
+ active := (nCond = 0) OR condStk[nCond - 1];
|
|
|
+ IF active THEN INC(p) ELSE CondBlank(p); INC(p) END
|
|
|
+ END
|
|
|
+ END
|
|
|
+ END CondFilter;
|
|
|
+
|
|
|
+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
|
|
|
+ -->literals
|
|
|
+ END CheckLiteral;
|
|
|
+
|
|
|
+ BEGIN (*Get*)
|
|
|
+ -->GetSy1
|
|
|
+ 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
|
|
|
+ -->GetSy2
|
|
|
+ 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] := CHR(0);
|
|
|
+ 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] := CHR(0);
|
|
|
+ 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
|
|
|
+ NEW(buf[i]); (* typed alloc: sets the block descriptor's count *)
|
|
|
+ read := BlkSize; FileIO.ReadBytes(src, buf[i]^, read);
|
|
|
+ INC(i); INC(inputLen, VAL(INT32, read))
|
|
|
+ UNTIL read # BlkSize;
|
|
|
+ buf[i-1]^[read] := EOF;
|
|
|
+ CondFilter;
|
|
|
+ curLine := 1; lineStart := -2; bp := -1;
|
|
|
+ oldEols := 0; apx := 0; errors := 0;
|
|
|
+ NextCh;
|
|
|
+ END Reset;
|
|
|
+
|
|
|
+BEGIN
|
|
|
+ -->initializations
|
|
|
+ Error := Err; lastCh := EOF;
|
|
|
+END -->modulename.
|
|
|
+-->definitionDEFINITION MODULE -->modulename;
|
|
|
+
|
|
|
+(* Scanner generated by Coco/R - using the FileIO library supplied with this project. *)
|
|
|
+
|
|
|
+IMPORT FileIO;
|
|
|
+
|
|
|
+TYPE
|
|
|
+ INT32 = FileIO.INT32 (* need 32 bit integers *);
|
|
|
+
|
|
|
+VAR
|
|
|
+ src, lst: FileIO.File;(*source/list files. To be opened by the main pgm*)
|
|
|
+ directory: ARRAY [0 .. 255] OF CHAR (*of source file*);
|
|
|
+ line, col: INTEGER; (*line and column of current symbol*)
|
|
|
+ len: CARDINAL; (*length of current symbol*)
|
|
|
+ pos: INT32; (*file position of current symbol*)
|
|
|
+ nextLine: INTEGER; (*line of lookahead symbol*)
|
|
|
+ nextCol: INTEGER; (*column of lookahead symbol*)
|
|
|
+ nextLen: CARDINAL; (*length of lookahead symbol*)
|
|
|
+ nextPos: INT32; (*file position of lookahead symbol*)
|
|
|
+ errors: INTEGER; (*number of detected errors*)
|
|
|
+ Error: PROCEDURE ((*nr*)INTEGER, (*line*)INTEGER, (*col*)INTEGER,
|
|
|
+ (*pos*)INT32);
|
|
|
+
|
|
|
+PROCEDURE Get (VAR sym: CARDINAL);
|
|
|
+(* Gets next symbol from source file *)
|
|
|
+
|
|
|
+PROCEDURE GetString (pos: INT32; len: CARDINAL; VAR name: ARRAY OF CHAR);
|
|
|
+(* Retrieves exact string of max length len from position pos in source file *)
|
|
|
+
|
|
|
+PROCEDURE GetName (pos: INT32; len: CARDINAL; VAR name: ARRAY OF CHAR);
|
|
|
+(* Retrieves name of symbol of length len at position pos in source file *)
|
|
|
+
|
|
|
+PROCEDURE CharAt (pos: INT32): CHAR;
|
|
|
+(* Returns exact character at position pos in source file *)
|
|
|
+
|
|
|
+PROCEDURE Reset;
|
|
|
+(* Reads and stores source file internally *)
|
|
|
+
|
|
|
+END -->modulename.
|
