scanner.frm

一个Pascal语言分析器

UNIT -->modulename;
(* Scanner generated by Coco/R (Pascal version) *)

INTERFACE

CONST
  CommentMax = 10000;
TYPE
  CommentStr = ARRAY [0 .. CommentMax] OF CHAR;
VAR
  src:         FILE;         (*source/list files. To be opened by the main pgm*)
  lst:         TEXT;
  directory:   STRING;       (*of source file*)
  line, col:   INTEGER;      (*line and column of current symbol*)
  len:         INTEGER;      (*length of current symbol*)
  pos:         LONGINT;      (*file position of current symbol*)
  nextLine:    INTEGER;      (*line of lookahead symbol*)
  nextCol:     INTEGER;      (*column of lookahead symbol*)
  nextLen:     INTEGER;      (*length of lookahead symbol*)
  nextPos:     LONGINT;      (*file position of lookahead symbol*)
  errors:      INTEGER;      (*number of detected errors*)
  seenComment: BOOLEAN;      (*TRUE if comments have been registered*)
  Error:       PROCEDURE (nr, line, col: INTEGER; pos: LONGINT);

PROCEDURE Get (VAR sym: INTEGER);
(* Gets next symbol from source file *)

PROCEDURE GetString (pos: LONGINT; len: INTEGER; VAR s: STRING);
(* Retrieves exact string of max length len from position pos in source file *)

PROCEDURE GetName (pos: LONGINT; len: INTEGER; VAR s: STRING);
(* Retrieves name of symbol of length len at position pos in source file *)

FUNCTION CharAt (pos: LONGINT): CHAR;
(* Returns exact character at position pos in source file *)

PROCEDURE GetComment (VAR comment: CommentStr; pos: INTEGER; VAR length: INTEGER);
(* 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 *)

IMPLEMENTATION
-->unitname
CONST
  noSym   = -->unknownsym; (*error token code*)
  (* not only for errors but also for not finished states of scanner analysis *)
  eof   = #26; (*MS-DOS eof*)
  LF    = #10;
  CR    = #13;
  EF    = #0;
  EL    = CR;
  BlkSize = 16384;
TYPE
  BufBlock   = ARRAY [0 .. BlkSize-1] OF CHAR;
  Buffer     = ARRAY [0 .. 31] OF ^BufBlock;
  StartTable = ARRAY [0 .. 255] OF INTEGER;
  GetCH      = FUNCTION (pos: LONGINT) : CHAR;
  CommentPtr = ^ CommentRec;
  CommentRec = RECORD
                 begCom, endCom : LONGINT;
                 next : CommentPtr;
               END;
VAR
  lastCh,
  ch:        CHAR;       (*current input character*)
  curLine:   INTEGER;    (*current input line (may be higher than line)*)
  lineStart: LONGINT;    (*start position of current line*)
  apx:       LONGINT;    (*length of appendix (CONTEXT phrase)*)
  oldEols:   INTEGER;    (*number of _EOLs in a comment*)
  bp, bp0:   LONGINT;    (*current position in buf
                           (bp0: position of current token)*)
  LBlkSize:  LONGINT;    (*BlkSize*)
  inputLen:  LONGINT;    (*source file size*)
  buf:       Buffer;     (*source buffer for low-level access*)
  start:     StartTable; (*start state for every character*)
  CurrentCh: GetCH;
  firstComment, lastComment: CommentPtr;

PROCEDURE Err (nr, line, col: INTEGER; pos: LONGINT); FAR;
  BEGIN
    INC(errors)
  END;

PROCEDURE NextCh;
(* Return global variable ch *)
  BEGIN
    lastCh := ch; INC(bp); ch := CurrentCh(bp);
    IF (ch = EL) OR (ch = LF) AND (lastCh <> EL) THEN BEGIN
      INC(curLine); lineStart := bp
    END
  END;

FUNCTION Comment: BOOLEAN;
  LABEL
    999;
  VAR
    level, startLine: INTEGER;
    oldLineStart : LONGINT;
    beginC, endC : LONGINT;
    nextComment : CommentPtr;
  BEGIN
    beginC := bp;
    level := 1; startLine := curLine; oldLineStart := lineStart;
    -->comment
    Comment := FALSE;
    999:
    endC := bp; DEC(endC);
    IF endC > beginC THEN BEGIN
      seenComment := TRUE;
      NEW(nextComment);
      nextComment^.begCom := beginC;
      nextComment^.endCom := endC;
      nextComment^.next := NIL;
      IF firstComment = NIL
        THEN firstComment := nextComment
        ELSE lastComment^.next := nextComment;
      lastComment := nextComment
    END
  END;

PROCEDURE GetComment (VAR comment: CommentStr; pos: INTEGER; VAR length: INTEGER);
  VAR
    this : CommentPtr;
  BEGIN
    length := 0;
    WHILE firstComment <> NIL DO BEGIN
      this := firstComment;
      WHILE (pos + length <= CommentMax) AND (this^.begCom <= this^.endCom) DO
        BEGIN
          comment[pos + length] := CharAt(this^.begCom);
          INC(length); INC(this^.begCom);
        END;
      firstComment := firstComment^.next;
      DISPOSE(this)
    END;
    seenComment := FALSE;
  END;

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

  FUNCTION Equal (s: STRING): BOOLEAN;
    VAR
      i: INTEGER;
      q: LONGINT;
    BEGIN
      IF nextLen <> Length(s) THEN BEGIN Equal := FALSE; EXIT END;
      i := 1; q := bp0;
      WHILE i <= nextLen DO BEGIN
        IF CurrentCh(q) <> s[i] THEN BEGIN Equal := FALSE; EXIT END;
        INC(i); INC(q)
      END;
      Equal := TRUE
    END;

  PROCEDURE CheckLiteral;
    BEGIN
      -->literals
    END;

  BEGIN (*Get*)
    -->GetSy1
    pos := nextPos;   nextPos := bp;
    col := nextCol;   nextCol := bp - lineStart;
    line := nextLine; nextLine := curLine;
    len := nextLen;   nextLen := 0;
    apx := 0; state := start[ORD(ch)]; bp0 := bp;
    WHILE TRUE DO BEGIN
      NextCh; INC(nextLen);
      CASE state OF
      -->GetSy2
      ELSE BEGIN sym := noSym; EXIT (*NextCh already done*) END;
      END
    END
  END;

PROCEDURE GetString (pos: LONGINT; len: INTEGER; VAR s: STRING);
  VAR
    i: INTEGER;
    p: LONGINT;
  BEGIN
    IF len > 255 THEN len := 255;
    p := pos; i := 1;
    WHILE i <= len DO BEGIN
      s[i] := CharAt(p); INC(i); INC(p)
    END;
    s[0] := CHR(len);
  END;

PROCEDURE GetName (pos: LONGINT; len: INTEGER; VAR s: STRING);
  VAR
    i: INTEGER;
    p: LONGINT;
  BEGIN
    IF len > 255 THEN len := 255;
    p := pos; i := 1;
    WHILE i <= len DO BEGIN
      s[i] := CurrentCh(p); INC(i); INC(p)
    END;
    s[0] := CHR(len);
  END;

FUNCTION CharAt (pos: LONGINT): CHAR;
  VAR
    ch : CHAR;
  BEGIN
    IF pos >= inputLen THEN BEGIN CharAt := EF; EXIT; END;
    ch := buf[pos DIV LBlkSize]^[pos MOD LBlkSize];
    IF ch <> eof THEN CharAt := ch ELSE CharAt := EF
  END;

FUNCTION CapChAt (pos: LONGINT): CHAR; FAR;
  VAR
    ch : CHAR;
  BEGIN
    IF pos >= inputLen THEN BEGIN CapChAt := EF; EXIT; END;
    ch := upcase(buf[pos DIV LBlkSize]^[pos MOD LBlkSize]);
    IF ch <> eof THEN CapChAt := ch ELSE CapChAt := EF
  END;

PROCEDURE _Reset;
  VAR
    len: LONGINT;
    i, read: INTEGER;
  BEGIN (*assert: src has been opened*)
    len := FileSize(src); i := 0; inputLen := len;
    WHILE len > LBlkSize DO BEGIN
      NEW(buf[i]);
      read := BlkSize; BlockRead(src, buf[i]^, read);
      len := len - read; INC(i)
    END;
    NEW(buf[i]);
    read := len; BlockRead(src, buf[i]^, read);
    buf[i]^[read] := EF;
    curLine := 1; lineStart := -2; bp := -1;
    oldEols := 0; apx := 0; errors := 0;
    NextCh;
  END;

BEGIN
  -->initializations
  Error := Err; LBlkSize := BlkSize; lastCh := EF;
  firstComment := NIL; seenComment := FALSE;
END. (* -->modulename *)