scanner.frm

一个Modula-2语言分析器

IMPLEMENTATION MODULE -->modulename;

(* Scanner generated by Coco/R - assuming FileIO library will be available. *)
(* allows extraction of comments *)

IMPORT FileIO, Storage, SYSTEM (* TSIZE only *);

CONST
  noSym   = -->unknownsym; (*error token code*)
  (* not only for errors but also for not finished states of scanner analysis *)
  eof     = 32C (* MS-DOS Keyboard eof char *);
  EOF     = FileIO.EOF;
  EOL     = FileIO.CR;
  CR      = FileIO.CR;
  LF      = FileIO.LF;
  Long0   = FileIO.Long0;
  Long1   = FileIO.Long1;
  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;
  CommentPtr = POINTER TO CommentRec;
  CommentRec = RECORD
                 begCom, endCom: INT32;
                 next: CommentPtr;
               END;
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)*)
  LBlkSize:  INT32;      (*BlkSize*)
  inputLen:  INT32;      (*source file size*)
  buf:       Buffer;     (*source buffer for low-level access*)
  start:     StartTable; (*start state for every character*)
  CurrentCh: GetCH;
  firstComment, lastComment: CommentPtr;

PROCEDURE ORDL (n: INT32): CARDINAL;
 BEGIN
   RETURN FileIO.ORDL(n)
 END ORDL;

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 = FileIO.LF) AND (lastCh # EOL) THEN
      INC(curLine); lineStart := bp
    END
  END NextCh;

PROCEDURE HaveComment (): BOOLEAN;
  VAR
    level, startLine: INTEGER;
    oldLineStart: INT32;
  BEGIN
    level := 1; startLine := curLine; oldLineStart := lineStart;
    -->commentRETURN FALSE;
  END HaveComment;

PROCEDURE Comment (): BOOLEAN;
  VAR
    SeenComment: BOOLEAN;
    beginC, endC: INT32;
    nextComment: CommentPtr;
  BEGIN
    beginC := bp;
    SeenComment := HaveComment();
    endC := bp; DEC(endC);
    IF endC > beginC THEN
      seenComment := TRUE;
      Storage.ALLOCATE(nextComment, SYSTEM.TSIZE(CommentRec));
      nextComment^.begCom := beginC;
      nextComment^.endCom := endC;
      nextComment^.next := NIL;
      IF firstComment = NIL
        THEN firstComment := nextComment
        ELSE lastComment^.next := nextComment
      END;
    lastComment := nextComment;
    END;
    RETURN SeenComment;
  END Comment;

PROCEDURE GetComment (VAR comment: ARRAY OF CHAR; pos: CARDINAL; VAR length: CARDINAL);
  VAR
    this: CommentPtr;
  BEGIN
    length := 0;
    WHILE firstComment # NIL DO
      this := firstComment;
      WHILE (pos + length <= HIGH(comment)) AND (this^.begCom <= this^.endCom) DO
        comment[pos + length] := CharAt(this^.begCom);
        INC(length); INC(this^.begCom);
      END;
      firstComment := firstComment^.next;
      Storage.DEALLOCATE(this, SYSTEM.TSIZE(CommentRec))
    END;
    seenComment := FALSE;
  END GetComment;

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

  PROCEDURE Equal (s: ARRAY OF CHAR): BOOLEAN;
    VAR
      i: CARDINAL;
      q: INT32;
    BEGIN
      IF nextLen # FileIO.SLENGTH(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 := FileIO.INTL(bp - lineStart);
    line := nextLine; nextLine := curLine;
    len := nextLen;   nextLen := 0;
    apx := FileIO.Long0; state := start[ORD(ch)]; bp0 := bp;
    LOOP
      NextCh; INC(nextLen);
      CASE state OF
      -->GetSy2
      ELSE sym := noSym; 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 FileIO.EOF END;
    ch := buf[FileIO.ORDL(pos DIV LBlkSize)]^[FileIO.ORDL(pos MOD LBlkSize)];
    IF ch # eof THEN RETURN ch ELSE RETURN FileIO.EOF END
  END CharAt;

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

PROCEDURE Reset;
  VAR
    len: INT32;
    i, read: CARDINAL;
  BEGIN (*assert: src has been opened*)
    len := FileIO.Length(src); i := 0; inputLen := len;
    WHILE len > LBlkSize DO
      Storage.ALLOCATE(buf[i], BlkSize);
      read := BlkSize; FileIO.ReadBytes(src, buf[i]^, read);
      len := len - FileIO.INT(read); INC(i)
    END;
    Storage.ALLOCATE(buf[i], FileIO.ORDL(len) + 1);
    read := FileIO.ORDL(len); FileIO.ReadBytes(src, buf[i]^, read);
    buf[i]^[read] := EOF;
    curLine := 1; lineStart := -FileIO.Long2; bp := -FileIO.Long1;
    oldEols := 0; apx := FileIO.Long0; errors := 0;
    NextCh;
  END Reset;

BEGIN
  -->initializations
  Error := Err; LBlkSize := FileIO.INT(BlkSize); lastCh := EOF;
  firstComment := NIL; seenComment := FALSE;
END -->modulename.
-->definitionDEFINITION MODULE -->modulename;

(* Scanner generated by Coco/R - assuming FileIO library will be available. *)

IMPORT FileIO;

TYPE
  INT32 = FileIO.INT32;

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*)
  seenComment: BOOLEAN;      (*TRUE if comments have been registered*)
  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 GetComment (VAR comment: ARRAY OF CHAR; pos: CARDINAL; VAR length: CARDINAL);
(* IF seenComment
     THEN concatenates and extracts previously scanned comments into comment,
          starting at comment[pos], and computes length; seenComment := FALSE
     ELSE returns length := 0 *)

PROCEDURE Reset;
(* Reads and stores source file internally *)

END -->modulename.