crx.mod

一个Modula-2语言分析器

          IndentProc(indent);
          PutS("WHILE ~ ("); GenCond(s1, indent + 9); PutS(") DO SynError(");
          PutI(errNr); PutS("); Get END;$")

      | CRT.alt:
          CRT.CompFirstSet(gp, s1); equal := Sets.Equal(s1, checked);
          alts := Alternatives(gp);
          OldNewLine := NewLine; altStart := FileIO.GetPos(syn);
          IF alts > maxAlter THEN
            IndentProc(indent); PutS("CASE sym OF$")
          END;
          gp2 := gp;
          IF alts > maxAlter THEN addInd := 4 ELSE addInd := 2 END;
          errSemNod := -1; FirstCase := TRUE;
          WHILE gp2 # 0 DO
            CRT.GetNode(gp2, gn2);
            CRT.CompExpected(gn2.p1, curSy, s1);
            IndentProc(indent);
            IF alts > maxAlter THEN
              IF FirstCase
                THEN FirstCase := FALSE; PutS("  ")
                ELSE PutS("| ") END;
              PutSet1(s1); PutS(" :$");
            ELSIF gp2 = gp
              THEN PutS("IF"); GenCond(s1, indent + 2); PutS(" THEN$")
            ELSIF (gn2.p2 = 0) & equal THEN PutS("ELSE$")
            ELSE PutS("ELSIF"); GenCond(s1, indent + 5); PutS(" THEN$")
            END;
            Sets.Unite(s1, checked);
            GenCode(gn2.p1, indent + addInd, s1); NewLine := TRUE;
            gp2 := gn2.p2;
          END;
          IF ~ equal THEN
            GenErrorMsg(altErr, curSy, errNr);
            IndentProc(indent);
            PutS("ELSE SynError("); PutI(errNr); PutS(");$");
          END;
          IndentProc(indent); PutS("END;$");

      | CRT.iter:
          CRT.GetNode(gn.p1, gn2);
          IndentProc(indent); PutS("WHILE");
          IF gn2.typ = CRT.wt THEN
            CRT.CompExpected(ABS(gn2.next), curSy, s1);
            CRT.CompExpected(ABS(gn.next), curSy, s2);
            CRT.GetSym(gn2.p1, sn);
            PutS(" WeakSeparator("); PutSI(gn2.p1); PutS(", ");
            PutI(NewCondSet(s1));
            PutS(", "); PutI(NewCondSet(s2)); Put(")");
            Sets.Clear(s1); (*for inner structure*)
            IF gn2.next > 0 THEN gp2 := gn2.next ELSE gp2 := 0 END
          ELSE
            gp2 := gn.p1;
            CRT.CompFirstSet(gp2, s1); GenCond(s1, indent + 5)
          END;
          PutS(" DO$");
          GenCode(gp2, indent + 2, s1);
          IndentProc(indent); PutS("END;$");

      | CRT.opt:
          CRT.CompFirstSet(gn.p1, s1);
          IF Sets.Equal(checked, s1) THEN
            GenCode(gn.p1, indent, checked);
          ELSE
            IndentProc(indent); PutS("IF");
            GenCond(s1, indent + 2); PutS(" THEN$");
            GenCode(gn.p1, indent + 2, s1);
            IndentProc(indent); PutS("END;$");
          END

      END; (*CASE*)
      IF (gn.typ # CRT.eps) & (gn.typ # CRT.sem) & (gn.typ # CRT.sync) THEN
        Sets.Clear(checked)
      END;
      gp := gn.next;
    END; (* WHILE gp > 0 *)
  END GenCode;

(* GenPragmaCode        Generate code for pragmas
----------------------------------------------------------------------*)
PROCEDURE GenPragmaCode (leftMarg: CARDINAL; gramName : ARRAY OF CHAR);
  VAR
    i: INTEGER;
    sn: CRT.SymbolNode;
    FirstCase: BOOLEAN;
  BEGIN
    i := CRT.maxT + 1; 
    IF i > CRT.maxP THEN RETURN END;
    FirstCase := TRUE;
    PutS("CASE sym OF$"); PutB(leftMarg);
    LOOP
      CRT.GetSym(i, sn);
      IF FirstCase THEN FirstCase := FALSE; PutS("  ") ELSE PutS("| ") END;
      PutSI(i); PutS(": "); NewLine := FALSE;
      CopySourcePart(sn.semPos, leftMarg + 6, Indent);
      IF i = CRT.maxP THEN EXIT END;
      INC(i); PutLn; PutB(leftMarg);
    END; (* LOOP *)
    PutLn; PutB(leftMarg); PutS("END;$");
    PutB(leftMarg); PutS(gramName); PutS("S.nextPos := ");
    PutS(gramName); PutS("S.pos;$");
    PutB(leftMarg); PutS(gramName); PutS("S.nextCol := ");
    PutS(gramName); PutS("S.col;$");
    PutB(leftMarg); PutS(gramName); PutS("S.nextLine := ");
    PutS(gramName); PutS("S.line;$");
    PutB(leftMarg); PutS(gramName); PutS("S.nextLen := ");
    PutS(gramName); PutS("S.len;");
  END GenPragmaCode;

(* GenProcedureHeading  Generate procedure heading
----------------------------------------------------------------------*)
PROCEDURE GenProcedureHeading (sn: CRT.SymbolNode);
  BEGIN
    PutS("PROCEDURE "); PutS(sn.name);
    IF sn.attrPos.beg >= FileIO.Long0 THEN
(* was  PutS(" ("); CopySourcePart(sn.attrPos, 0, PutB); Put(")") ++ *)
      PutS(" ("); NewLine := FALSE;
      CopySourcePart(sn.attrPos, 13 + FileIO.SLENGTH(sn.name), Indent);
      Put(")")
    END;
    Put(";")
  END GenProcedureHeading;

(* GenForwardRefs       Generate forward references for one-pass compilers
----------------------------------------------------------------------*)
PROCEDURE GenForwardRefs;
  VAR
    sp: INTEGER;
    sn: CRT.SymbolNode;
  BEGIN
    IF CRT.ddt["M"] THEN
      PutS("(* ----- FORWARD not needed in multipass compilers$$")
    END;
    sp := CRT.firstNt;
    WHILE sp <= CRT.lastNt DO (* for all nonterminals *)
      CRT.GetSym(sp, sn); GenProcedureHeading(sn); PutS(" FORWARD;$");
      INC(sp)
    END;
    FileIO.WriteLn(syn);
    IF CRT.ddt["M"] THEN
      PutS("----- *)$$")
    END;
  END GenForwardRefs;

(* GenProductions       Generate code for all productions
----------------------------------------------------------------------*)
PROCEDURE GenProductions;
  VAR
    sn: CRT.SymbolNode;
    checked: CRT.Set;
  BEGIN
    curSy := CRT.firstNt; NewLine := TRUE; (* Bug fix PDT*)
    WHILE curSy <= CRT.lastNt DO (* for all nonterminals *)
      CRT.GetSym(curSy, sn); GenProcedureHeading(sn); FileIO.WriteLn(syn);
      IF sn.semPos.beg >= FileIO.Long0 THEN
        CopySourcePart(sn.semPos, 2, IndentProc); PutLn
      END;
      PutB(2); PutS("BEGIN$");
      (* may like to add PutS(" (* "); PutS(sn.name); PutS(" *)$"); *)
      Sets.Clear(checked);
      GenCode(sn.struct, 4, checked);
      PutB(2); PutS("END "); PutS(sn.name); PutS(";$$");
      INC(curSy);
  END;
END GenProductions;

(* GenSetInits          Initialise all sets
----------------------------------------------------------------------*)
PROCEDURE InitSets;
  VAR
    i, j: INTEGER;
  BEGIN
    CRT.GetSet(0, symSet[0]);
    NewLine := FALSE; i := 0;
    WHILE i <= maxSS DO
      IF i # 0 THEN PutLn END;
      j := 0;
      WHILE j <= CRT.maxT DIV Sets.size DO
        IF j # 0 THEN PutLn END;
        Indent(2); PutS("symSet["); PutI2(i); PutS(", ");PutI(j);
        PutS("] := BITSET{");
        PutSet(symSet[i, j], j * Sets.size); PutS("};");
        INC(j);
      END;
      INC(i)
    END
  END InitSets;

(* GenCompiler          Generate the target compiler
----------------------------------------------------------------------*)
PROCEDURE GenCompiler;
  VAR
    Digits, len, pos, LeftMargin: CARDINAL;
    errNr, i: INTEGER;
    checked: CRT.Set;
    gn: CRT.GraphNode;
    sn: CRT.SymbolNode;
    gramName: ARRAY [0 .. 31] OF CHAR;
    fGramName, fn, ParserFrame: ARRAY [0 .. 63] OF CHAR;
    endPos, SS: INT32;
  BEGIN
    FileIO.Concat(CRS.directory, "parser.frm", ParserFrame);
    FileIO.Open(fram, ParserFrame, FALSE);
    IF ~ FileIO.Okay THEN
      FileIO.SearchFile(fram, "CRFRAMES", "parser.frm", FALSE);
      IF ~ FileIO.Okay THEN
        FileIO.WriteLn(FileIO.StdOut);
        FileIO.WriteString(FileIO.StdOut, "'parser.frm' not found.");
        FileIO.WriteString(FileIO.StdOut, "- Aborted.");
        FileIO.QuitExecution
      END
    END;
    LeftMargin := 0;

    CRT.GetNode(CRT.root, gn); CRT.GetSym(gn.p1, sn);
    FileIO.Extract(sn.name, 0, 7, gramName);
    FileIO.Concat(CRS.directory, gramName, fGramName);

    (*----- write *.ERR -----*)
    FileIO.Concat(fGramName, FileIO.ErrExt, fn);
    FileIO.Open(err, fn, TRUE);
(* ++
    FileIO.WriteLn(FileIO.StdOut);
    FileIO.WriteString(FileIO.StdOut, "  ");
    FileIO.WriteString(FileIO.StdOut, fn);
 ++ *)
    i := 0;
    WHILE i <= CRT.maxT DO GenErrorMsg(tErr, i, errNr); INC(i) END;

    IF (CRT.ddt["N"] OR CRT.symNames) AND ~ CRT.ddt["D"] THEN
      (*----- write *G.DEF -----*)
      FileIO.Concat(fGramName, "G", fn);
      FileIO.Concat(fn, FileIO.DefExt, fn);
      FileIO.Open(syn, fn, TRUE);
(* ++
      FileIO.WriteLn(FileIO.StdOut);
      FileIO.WriteString(FileIO.StdOut, "  ");
      FileIO.WriteString(FileIO.StdOut, fn);
 ++ *)
      PutS("DEFINITION MODULE "); PutS(gramName); PutS("G;$$");
      PutS("CONST");
      i := 0; pos := CRA.MaxSourceLineLength + 1;
      REPEAT
        CRT.GetSym(i, sn); len := FileIO.SLENGTH(sn.constant);
        IF len > 0 THEN
          errNr := i; Digits := 1;
          WHILE errNr >= 10 DO INC(Digits); errNr := errNr DIV 10 END;
          INC(len, 3 + Digits + 1);
          IF pos + len > CRA.MaxSourceLineLength THEN
            PutLn; pos := 0
          END;
          PutS("  ");
          PutS(sn.constant); PutS(" = "); PutI(i); Put(";");
          INC(pos, len + 2);
        END;
        INC(i);
      UNTIL i > CRT.maxP;
      PutS("$$END "); PutS(gramName); PutS("G.$");
      FileIO.Close(syn);

      (*----- write *G.MOD -----*)
      FileIO.Concat(fGramName, "G", fn);
      FileIO.Concat(fn, FileIO.ModExt, fn);
      FileIO.Open(syn, fn, TRUE);
(* ++
      FileIO.WriteLn(FileIO.StdOut);
      FileIO.WriteString(FileIO.StdOut, "  ");
      FileIO.WriteString(FileIO.StdOut, fn);
 ++ *)
      PutS("IMPLEMENTATION MODULE "); PutS(gramName); PutS("G;$");
      PutS("END "); PutS(gramName); PutS("G.$");
      FileIO.Close(syn);
    END; (* IF CRT.ddt["N"] OR CRT.symNames *)

    (*----- write *P.MOD -----*)
    FileIO.Concat(fGramName, "P", fn);
    FileIO.Concat(fn, FileIO.ModExt, fn);
    FileIO.Open(syn, fn, TRUE);
(* ++
    FileIO.WriteLn(FileIO.StdOut);
    FileIO.WriteString(FileIO.StdOut, "  ");
    FileIO.WriteString(FileIO.StdOut, fn);
 ++ *)
    CopyFramePart("-->modulename", LeftMargin); PutS(gramName); Put("P");
    IF CRT.ddt["N"] OR CRT.symNames THEN CRA.ImportSymConsts(PutS) END;

    CopyFramePart("-->scanner", LeftMargin);
    PutS(gramName); Put("S");

    CopyFramePart("-->declarations", LeftMargin);
    CopySourcePart(CRT.semDeclPos, 0, PutB);

    CopyFramePart("-->constants", LeftMargin);
    PutS("maxT = "); PutI(CRT.maxT); Put(";");
    IF CRT.maxP > CRT.maxT THEN
      PutLn; PutB(LeftMargin); PutS("maxP = ");
      PutI(CRT.maxP); Put(";");
    END;

    CopyFramePart("-->symSetSize", LeftMargin);
    SS := FileIO.GetPos(syn);
    FileIO.WriteInt(syn, 999, 3);

    CopyFramePart("-->error", LeftMargin);
    PutS(gramName); PutS("S.Error(errNo, ");
    PutS(gramName); PutS("S.line, ");
    PutS(gramName); PutS("S.col, ");
    PutS(gramName); PutS("S.pos);");

    CopyFramePart("-->error", LeftMargin);
    PutS(gramName); PutS("S.Error(errNo, ");
    PutS(gramName); PutS("S.nextLine, ");
    PutS(gramName); PutS("S.nextCol, ");
    PutS(gramName); PutS("S.nextPos);");

    CopyFramePart("-->scanner", LeftMargin);
    PutS(gramName); Put("S");

    CopyFramePart("-->pragmas", LeftMargin);
    GenPragmaCode(LeftMargin, gramName);

    FOR i := 1 TO 13 DO
      CopyFramePart("-->scanner", LeftMargin);
      PutS(gramName); Put("S");
    END;

    CopyFramePart("-->productions", LeftMargin);
    GenForwardRefs; GenProductions;

    CopyFramePart("-->parseRoot", LeftMargin);
    PutS(gramName); PutS("S.Reset; Get;$");
    Sets.Clear(checked); GenCode(CRT.root, LeftMargin, checked);

    CopyFramePart("-->initialization", LeftMargin);
    InitSets;

    CopyFramePart("-->modulename", LeftMargin);
    PutS(gramName); Put("P");

    CopyFramePart("-->definition", LeftMargin);

    endPos := FileIO.GetPos(syn); (* end position of the file *)
    FileIO.SetPos(syn, SS);       (* fix up array declaration *)
    IF maxSS < 0 THEN maxSS := 0 END;
    FileIO.WriteInt(syn, maxSS, 3);
    FileIO.SetPos(syn, endPos);   (* set file pointer to end of file *)
    FileIO.Close(syn);

    IF ~ CRT.ddt["D"] THEN
      (*----- write *P.DEF -----*)
      FileIO.Concat(fGramName, "P", fn);
      FileIO.Concat(fn, FileIO.DefExt, fn);
      FileIO.Open(syn, fn, TRUE);
(* ++
      FileIO.WriteLn(FileIO.StdOut);
      FileIO.WriteString(FileIO.StdOut, "  ");
      FileIO.WriteString(FileIO.StdOut, fn);
 ++ *)
      CopyFramePart("-->modulename", LeftMargin);
      PutS(gramName); Put("P");

      CopyFramePart("-->modulename", LeftMargin);
      PutS(gramName); PutS("P.$");

      FileIO.Close(syn);
    END;
    FileIO.Close(fram); FileIO.Close(err);
  END GenCompiler;

(* WriteStatistics      Write statistics about compilation to list file
----------------------------------------------------------------------*)
PROCEDURE WriteStatistics;

  PROCEDURE WriteNumbers (used, available: INTEGER);
    BEGIN
      FileIO.WriteInt(CRS.lst, used + 1, 6);
      FileIO.WriteString(CRS.lst, " (limit ");
      FileIO.WriteInt(CRS.lst, available, 5);
      FileIO.Write(CRS.lst, ")"); FileIO.WriteLn(CRS.lst);
    END WriteNumbers;

  BEGIN
    FileIO.WriteString(CRS.lst, "Statistics:"); FileIO.WriteLn(CRS.lst);
    FileIO.WriteLn(CRS.lst);
    FileIO.WriteString(CRS.lst, "  nr of terminals:    ");
    WriteNumbers(CRT.maxT, CRT.maxTerminals);
    FileIO.WriteString(CRS.lst, "  nr of non-terminals:");
    WriteNumbers(CRT.lastNt-CRT.firstNt, CRT.maxSymbols-CRT.maxT-1);
    FileIO.WriteString(CRS.lst, "  nr of pragmas:      ");
    WriteNumbers(CRT.maxSymbols-CRT.lastNt-2, CRT.maxSymbols-CRT.maxT-1);
    FileIO.WriteString(CRS.lst, "  nr of symbolnodes:  ");
    WriteNumbers(CRT.maxSymbols-CRT.firstNt+CRT.maxT, CRT.maxSymbols);
    FileIO.WriteString(CRS.lst, "  nr of graphnodes:   ");
    WriteNumbers(CRT.nNodes, CRT.maxNodes);
    FileIO.WriteString(CRS.lst, "  nr of conditionsets:");
    WriteNumbers(maxSS, symSetSize);
    FileIO.WriteString(CRS.lst, "  nr of charactersets:");
    WriteNumbers(CRT.maxC, CRT.maxClasses);
    FileIO.WriteLn(CRS.lst); FileIO.WriteLn(CRS.lst);
  END WriteStatistics;


BEGIN (* CRX *)
  errorNr := -1; maxSS := 0; (*symSet[0] reserved for allSyncSyms*)
  NewLine := TRUE; IndDisp := 0;
END CRX.