crq.frm

一个Pascal语言分析器

(* CR   Main Module of Coco/R
   ==   =====================

   This is a compiler generator that produces a scanner and a parser
   from an attributed grammar, and optionally a complete small compiler.

   Original code in Oberon by Hanspeter Moessenboeck, ETH Zurich
   Ported at ETH to Apple Modula, and thence to JPI-2 Modula.

   JPI version of 27 January 1991 was then modified to make more
   portable by Pat Terry, January - October 1992

   This is the IBM-PC MS-DOS Turbo Pascal version for generating Turbo Pascal
   based on the port first done by Volker Pohlers, October 1995

   This version outputs error messages in "standard" form for use with editors

Usage:
          COCOR [-options] GrammarName[.atg] [$options]

Input:
  attributed grammar   input grammar
  scanner.frm          frame file
  parser.frm           frame file
  compiler.frm         frame file (optional)

(Frame files must be in the sme directory as the grammar, or may be
found on a path specified by DOS environment variable CRFRAMES).

Output:
  <GrammarName>S.pas  generated scanner
  <GrammarName>P.pas  generated parser
  <GrammarName>.err   error numbers and corresponding error messages
  <GrammarName>.lst   source listing with error messages and trace output

Optionally

  <GrammarName>G.pas  generated symbolic names
  <GrammarName>.pas   generated compiler main module

Implementation restrictions
  1  too many nodes in graph (>1500)                 CRTable.NewNode
  2  too many symbols (>500)                         CRTable.NewSym, MovePragmas
  3  too many sets (>256 ANY-syms or SYNC syms)      CRTable.NewSet,
  4  too many character classes (>250)               CRTable.NewClass
  5  too many conditions in generated code (>100)    CRX.NewCondSet
  6  too many token names in "NAMES" (>100)          CRTable.NewName
  7  too many states in automata (>500)              CRA.NewState

Trace output
(To activate a trace switch, write "${letter}" in the input grammar, or
invoke Coco with a second command line parameter)

  A  Prints states of automaton

  C  Generates complete compiler module

  F  Prints start symbols and followers of nonterminals.

  G  Prints the top-down graph.

  I  Trace of start symbol set computation.

  L  Forces a listing (otherwise a listing is only printed if errors are found).
  
  N  Uses default names for symbol value constants.  This generates an
     extra module <grammar name>G, and corresponding import statements
     using constant names instead of numbers for symbols in parser and
     scanner.
     The constants are used unqualified and hence all needed constants
     have to be imported; so a complete import list for these constants
     is generated.
     There is no decision whether a constant is actually needed.

     The default conventions are (only terminals or pragmas can have names):
     single character   -->  <ASCII name (lowercase)>Sym
          eg. "+"       -->  plusSym
     character string   -->  <string>Sym
          eg. "PROGRAM" -->  PROGRAMSym
     scanner token      -->  <token name>Sym
          eg. ident     -->  identSym

  O  Trace of follow set computation (not yet implemented).

  P  Generates parser only

  Q  Generates error messages in quiet form for interfacing with editor

  S  Prints the symbol list.

  T  Suppresses generation of units (grammar tests only).

  X  Prints a cross reference list.

==========================================================================*)

PROGRAM -->Grammar;

USES -->Scanner, (* lst, src, errors, directory, Error, CharAt *)
     -->Parser, (* Parse *)
     CRC, CRTable, CRA, CRX, FileIO;

CONST
  ATGExt = '.atg';
  LSTExt = '.lst';
  Version = '1.48q (for Pascal)';
  ReleaseDate = '9 July 1999';

VAR
  Options, GrammarName, ATGFileName, lstFileName : STRING;
  ll1 : BOOLEAN; (* TRUE, if grammar is LL(1) *)
  IDE, ok : BOOLEAN;  (* TRUE, if grammar tests ok so far *)
  P : INTEGER;   (* ParamCount *)

(* ------------------- Source Listing and Error handler -------------- *)

  TYPE
    CHARSET = SET OF CHAR;
    Err = ^ErrDesc;
    ErrDesc = RECORD
      nr, line, col: INTEGER;
      next: Err
    END;

  CONST
    TAB  = #09;
    _LF  = #10;
    _CR  = #13;
    _EF  = #0;
    LineEnds : CHARSET = [_CR, _LF, _EF];

  VAR
    firstErr, lastErr: Err;
    Extra : INTEGER;

  PROCEDURE StoreError (nr, line, col: INTEGER; pos: LONGINT); FAR;
  (* Store an error message for later printing *)
    VAR
      nextErr: Err;
    BEGIN
      NEW(nextErr);
      nextErr^.nr := nr; nextErr^.line := line; nextErr^.col := col;
      nextErr^.next := NIL;
      IF firstErr = NIL
        THEN firstErr := nextErr
        ELSE lastErr^.next := nextErr;
      lastErr := nextErr;
      INC(errors)
    END;

  PROCEDURE GetLine (VAR pos  : LONGINT;
                     VAR line : STRING;
                     VAR eof  : BOOLEAN);
  (* Read a source line. Return empty line if eof *)
    VAR
      ch: CHAR;
      i:  INTEGER;
    BEGIN
      i := 1; eof := FALSE; ch := CharAt(pos); INC(pos);
      WHILE NOT (ch IN LineEnds) DO BEGIN
        line[i] := ch; INC(i); ch := CharAt(pos); INC(pos)
      END;
      line[0] := Chr(i-1);
      eof := (i = 1) AND (ch = _EF);
      IF ch = _CR THEN BEGIN (* check for MsDos *)
        ch := CharAt(pos);
        IF ch = _LF THEN BEGIN INC(pos); Extra := 0 END
      END
    END;

  PROCEDURE PrintErr (line : STRING; nr, col: INTEGER);
  (* Print an error message *)

    PROCEDURE Msg (s: STRING);
      BEGIN
        Write(lst, s)
      END;

    PROCEDURE Pointer;
      VAR
        i : INTEGER;
      BEGIN
        Write(lst, '*****  ');
        i := 0;
        WHILE i < col + Extra - 2 DO BEGIN
          IF line[i] = TAB
            THEN Write(lst, TAB)
            ELSE Write(lst, ' ');
          INC(i)
        END;
        Write(lst, '^ ')
      END;

    BEGIN
      IF NOT IDE THEN Pointer;
      CASE nr OF
       -->Errors
        102 : Msg('string literal may not extend over line end');
        103 : Msg('a literal must not have attributes');
        104 : Msg('this symbol kind not allowed in production');
        105 : Msg('attribute mismatch between declaration and use');
        106 : Msg('undefined string in production');
        107 : Msg('name declared twice');
        108 : Msg('this type not allowed on left side of production');
        109 : Msg('earlier semantic action was not terminated');
        111 : Msg('missing production for grammar name');
        112 : Msg('grammar symbol must not have attributes');
        113 : Msg('a literal must not be declared with a structure');
        114 : Msg('semantic action not allowed here');
        115 : Msg('undefined name');
        116 : Msg('attributes not allowed in token declaration');
        117 : Msg('name does not match grammar name');
        118 : Msg('unacceptable constant value');
        119 : Msg('may not ignore CHR(0)');
        120 : Msg('token may not be empty');
        121 : Msg('token must not start with an iteration');
        122 : Msg('only characters allowed in comment declaration');
        123 : Msg('only terminals may be weak');
        124 : Msg('literal tokens may not contain white space');
        125 : Msg('comment delimiter must be 1 or 2 characters long');
        126 : Msg('character set contains more than one character');
        127 : Msg('could not make deterministic automaton');
        128 : Msg('semantic action text too long - please split it');
        129 : Msg('literal tokens may not be empty');
        ELSE BEGIN Msg('Error: '); Write(lst, nr) END
      END;
      WriteLn(lst);
    END;

  PROCEDURE PrintListing;
  (* Print a source listing with error messages *)