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.