crt.mod

来自「一个Modula-2语言分析器」· MOD 代码 · 共 1,434 行 · 第 1/4 页

    (* search lines where symbol has been defined and insert in order *)
    i := 1;
    WHILE i <= lastNt DO (*for all symbols*)
      GetSym(i, sn); p := xList[i].lptr; q := NIL;
      WHILE (p # NIL) & (p^.line > sn.line) DO q := p; p := p^.next END;
      Storage.ALLOCATE(l, SYSTEM.TSIZE(ListNode)); l^.next := p;
      l^.line := -sn.line;
      IF q # NIL THEN q^.next := l ELSE xList[i].lptr := l END;
      IF i = maxP THEN i := firstNt ELSE INC(i) END
    END;

    (* print cross reference listing *)
    FileIO.WriteString(CRS.lst, "Cross reference list:");
    FileIO.WriteLn(CRS.lst); FileIO.WriteLn(CRS.lst);
    FileIO.WriteString(CRS.lst, "Terminals:"); FileIO.WriteLn(CRS.lst);
    FileIO.WriteString(CRS.lst, "  0  EOF"); FileIO.WriteLn(CRS.lst);
    i := 1;
    WHILE i <= lastNt DO (* for all symbols *)
      IF i = maxT THEN
        FileIO.WriteLn(CRS.lst);
        FileIO.WriteString(CRS.lst, "Pragmas:"); FileIO.WriteLn(CRS.lst);
      ELSE
        FileIO.WriteInt(CRS.lst, i, 3); FileIO.WriteString(CRS.lst, "  ");
        FileIO.WriteText(CRS.lst, xList[i].name, 25);
        l := xList[i].lptr; col := 35;
        WHILE l # NIL DO
          IF col + 5 > maxLineLen THEN
            FileIO.WriteLn(CRS.lst); FileIO.WriteText(CRS.lst, "", 30);
            col := 35
          END;
          IF l^.line = 0 THEN FileIO.WriteString(CRS.lst, "undef")
          ELSE FileIO.WriteInt(CRS.lst, l^.line, 5)
          END;
          INC(col, 5);
          l := l^.next
        END;
        FileIO.WriteLn(CRS.lst);
      END;
      IF i = maxP THEN
        FileIO.WriteLn(CRS.lst);
        FileIO.WriteString(CRS.lst, "Nonterminals:");
        FileIO.WriteLn(CRS.lst);
        i := firstNt
      ELSE INC(i)
      END
    END;
    FileIO.WriteLn(CRS.lst); FileIO.WriteLn(CRS.lst);
  END XRef;

(* NewNode              Generate a new graph node and return its index gp
----------------------------------------------------------------------*)
PROCEDURE NewNode (typ, p1, line: INTEGER): INTEGER;
  BEGIN
    INC(nNodes); IF nNodes > maxNodes THEN Restriction(1, maxNodes) END;
    gn^[nNodes].typ     := typ;    gn^[nNodes].next     := 0;
    gn^[nNodes].p1      := p1;     gn^[nNodes].p2       := 0;
    gn^[nNodes].pos.beg := - FileIO.Long1; (* Bugfix - PDT *)
    gn^[nNodes].pos.len := 0;      gn^[nNodes].pos.col := 0;
    gn^[nNodes].line    := line;
    RETURN nNodes;
  END NewNode;

(* CompleteGraph        Set right ends of graph gp to 0
----------------------------------------------------------------------*)
PROCEDURE CompleteGraph (gp: INTEGER);
  VAR
    p: INTEGER;
  BEGIN
    WHILE gp # 0 DO
      p := gn^[gp].next; gn^[gp].next := 0; gp := p
    END
  END CompleteGraph;

(* ConcatAlt            Make (gL2, gR2) an alternative of (gL1, gR1)
----------------------------------------------------------------------*)
PROCEDURE ConcatAlt (VAR gL1, gR1: INTEGER; gL2, gR2: INTEGER);
  VAR
    p: INTEGER;
  BEGIN
    gL2 := NewNode(alt, gL2, 0); p := gL1;
    WHILE gn^[p].p2 # 0 DO p := gn^[p].p2 END;
    gn^[p].p2 := gL2; p := gR1;
    WHILE gn^[p].next # 0 DO p := gn^[p].next END;
    gn^[p].next := gR2
  END ConcatAlt;

(* ConcatSeq            Make (gL2, gR2) a successor of (gL1, gR1)
----------------------------------------------------------------------*)
PROCEDURE ConcatSeq (VAR gL1, gR1: INTEGER; gL2, gR2: INTEGER);
  VAR
    p, q: INTEGER;
  BEGIN
    p := gn^[gR1].next; gn^[gR1].next := gL2; (*head node*)
    WHILE p # 0 DO (*substructure*)
      q := gn^[p].next; gn^[p].next := -gL2; p := q
    END;
    gR1 := gR2
  END ConcatSeq;

(* MakeFirstAlt         Generate alt-node with (gL,gR) as only alternative
----------------------------------------------------------------------*)
PROCEDURE MakeFirstAlt (VAR gL, gR: INTEGER);
  BEGIN
    gL := NewNode(alt, gL, 0); gn^[gL].next := gR; gR := gL
  END MakeFirstAlt;

(* MakeIteration        Enclose (gL, gR) into iteration node
----------------------------------------------------------------------*)
PROCEDURE MakeIteration (VAR gL, gR: INTEGER);
  VAR
    p, q: INTEGER;
  BEGIN
    gL := NewNode(iter, gL, 0); p := gR; gR := gL;
    WHILE p # 0 DO
      q := gn^[p].next; gn^[p].next := - gL; p := q
    END
  END MakeIteration;

(* MakeOption           Enclose (gL, gR) into option node
----------------------------------------------------------------------*)
PROCEDURE MakeOption (VAR gL, gR: INTEGER);
  BEGIN
    gL := NewNode(opt, gL, 0); gn^[gL].next := gR; gR := gL
  END MakeOption;

(* StrToGraph           Generate node chain from characters in s
----------------------------------------------------------------------*)
PROCEDURE StrToGraph (s: ARRAY OF CHAR; VAR gL, gR: INTEGER);
  VAR
    i, len: CARDINAL;
  BEGIN
    gR := 0; i := 1; len := FileIO.SLENGTH(s) - 1; (*strip quotes*)
    WHILE i < len DO
      gn^[gR].next := NewNode(char, ORD(s[i]), 0); gR := gn^[gR].next;
      INC(i)
    END;
    gL := gn^[0].next; gn^[0].next := 0
  END StrToGraph;

(* DelGraph             Check if graph starting with index gp is deletable
----------------------------------------------------------------------*)
PROCEDURE DelGraph (gp: INTEGER): BOOLEAN;
  VAR
    gn: GraphNode;
  BEGIN
    IF gp = 0 THEN RETURN TRUE END; (*end of graph found*)
    GetNode(gp, gn);
    RETURN DelNode(gn) & DelGraph(ABS(gn.next));
  END DelGraph;

(* DelNode              Check if graph node gn is deletable
----------------------------------------------------------------------*)
PROCEDURE DelNode (gn: GraphNode): BOOLEAN;
  VAR
    sn: SymbolNode;

  PROCEDURE DelAlt (gp: INTEGER): BOOLEAN;
    VAR
      gn: GraphNode;
    BEGIN
      IF gp <= 0 THEN RETURN TRUE END; (*end of graph found*)
      GetNode(gp, gn);
      RETURN DelNode(gn) & DelAlt(gn.next);
    END DelAlt;

  BEGIN
    IF gn.typ = nt THEN GetSym(gn.p1, sn); RETURN sn.deletable
    ELSIF gn.typ = alt THEN
      RETURN DelAlt(gn.p1) OR (gn.p2 # 0) & DelAlt(gn.p2)
    ELSE RETURN (gn.typ = eps) OR (gn.typ = iter)
                OR (gn.typ = opt) OR (gn.typ = sem) OR (gn.typ = sync)
    END
  END DelNode;

(* PrintGraph           Print the graph
----------------------------------------------------------------------*)
PROCEDURE PrintGraph;
  VAR
    i: INTEGER;

  PROCEDURE WriteTyp2 (typ: INTEGER);
    BEGIN
      CASE typ OF
        nt  : FileIO.WriteString(CRS.lst, "nt  ")
      | t   : FileIO.WriteString(CRS.lst, "t   ")
      | wt  : FileIO.WriteString(CRS.lst, "wt  ")
      | any : FileIO.WriteString(CRS.lst, "any ")
      | eps : FileIO.WriteString(CRS.lst, "eps ")
      | sem : FileIO.WriteString(CRS.lst, "sem ")
      | sync: FileIO.WriteString(CRS.lst, "sync")
      | alt : FileIO.WriteString(CRS.lst, "alt ")
      | iter: FileIO.WriteString(CRS.lst, "iter")
      | opt : FileIO.WriteString(CRS.lst, "opt ")
      ELSE    FileIO.WriteString(CRS.lst, "--- ")
      END;
    END WriteTyp2;

  BEGIN (* PrintGraph *)
    FileIO.WriteString(CRS.lst, "GraphList:");
    FileIO.WriteLn(CRS.lst); FileIO.WriteLn(CRS.lst);
    FileIO.WriteString(CRS.lst, " nr   typ    next     p1     p2   line");
(* useful for debugging - PDT *)
    FileIO.WriteString(CRS.lst, " posbeg poslen poscol");
(* *)
    FileIO.WriteLn(CRS.lst); FileIO.WriteLn(CRS.lst);
    i := 0;
    WHILE i <= nNodes DO
      FileIO.WriteInt(CRS.lst, i, 3); FileIO.WriteString(CRS.lst, "   ");
      WriteTyp2(gn^[i].typ); FileIO.WriteInt(CRS.lst, gn^[i].next, 7);
      FileIO.WriteInt(CRS.lst, gn^[i].p1, 7);
      FileIO.WriteInt(CRS.lst, gn^[i].p2, 7);
      FileIO.WriteInt(CRS.lst, gn^[i].line, 7);
(* useful for debugging - PDT *)
      FileIO.WriteInt(CRS.lst, FileIO.INTL(gn^[i].pos.beg), 7);
      FileIO.WriteCard(CRS.lst, gn^[i].pos.len, 7);
      FileIO.WriteInt(CRS.lst, gn^[i].pos.col, 7);
(*  *)
      FileIO.WriteLn(CRS.lst);
      INC(i);
    END;
    FileIO.WriteLn(CRS.lst); FileIO.WriteLn(CRS.lst);
  END PrintGraph;

(* FindCircularProductions      Test grammar for circular derivations
----------------------------------------------------------------------*)
PROCEDURE FindCircularProductions (VAR ok: BOOLEAN);
  TYPE
    ListEntry = RECORD
      left: INTEGER;
      right: INTEGER;
      deleted: BOOLEAN;
    END;
  VAR
    changed, onLeftSide,
    onRightSide: BOOLEAN;
    i, j, listLength: INTEGER;
    list: ARRAY [0 .. maxList] OF ListEntry;
    singles: MarkList;
    sn: SymbolNode;

  PROCEDURE GetSingles (gp: INTEGER; VAR singles: MarkList);
    VAR
      gn: GraphNode;
    BEGIN
      IF gp <= 0 THEN RETURN END; (* end of graph found *)
      GetNode (gp, gn);
      IF gn.typ = nt THEN
        IF DelGraph(ABS(gn.next)) THEN Sets.Incl(singles, gn.p1) END
      ELSIF (gn.typ = alt) OR (gn.typ = iter) OR (gn.typ = opt) THEN
        IF DelGraph(ABS(gn.next)) THEN
          GetSingles(gn.p1, singles);
          IF gn.typ = alt THEN GetSingles(gn.p2, singles) END
        END
      END;
      IF DelNode(gn) THEN GetSingles(gn.next, singles) END
    END GetSingles;

  BEGIN (* FindCircularProductions *)
    i := firstNt; listLength := 0;
    WHILE i <= lastNt DO (* for all nonterminals i *)
      ClearMarkList(singles); GetSym(i, sn);
      GetSingles(sn.struct, singles); (* get nt's j such that i-->j *)
      j := firstNt;
      WHILE j <= lastNt DO (* for all nonterminals j *)
        IF Sets.In(singles, j) THEN
          list[listLength].left := i; list[listLength].right := j;
          list[listLength].deleted := FALSE;
          INC(listLength);
          IF listLength > maxList THEN Restriction(9, maxList) END
        END;
        INC(j)
      END;
      INC(i)
    END;

    REPEAT
      i := 0; changed := FALSE;
      WHILE i < listLength DO
        IF ~ list[i].deleted THEN
          j := 0; onLeftSide := FALSE; onRightSide := FALSE;
          WHILE j < listLength DO
            IF ~ list[j].deleted THEN
              IF list[i].left = list[j].right THEN onRightSide := TRUE END;
              IF list[j].left = list[i].right THEN onLeftSide := TRUE END
            END;
            INC(j)
          END;
          IF ~ onRightSide OR ~ onLeftSide THEN
            list[i].deleted := TRUE; changed := TRUE
          END
        END;
        INC(i)
      END
    UNTIL ~ changed;

    FileIO.WriteString(CRS.lst, "Circular derivations:    ");
    i := 0; ok := TRUE;
    WHILE i < listLength DO
      IF ~ list[i].deleted THEN
        ok := FALSE;
        FileIO.WriteLn(CRS.lst); FileIO.WriteString(CRS.lst, "     ");
        GetSym(list[i].left, sn); FileIO.WriteText(CRS.lst, sn.name, 20);
        FileIO.WriteString(CRS.lst, " --> ");
        GetSym(list[i].right, sn); FileIO.WriteText(CRS.lst, sn.name, 20);
      END;
      INC(i)
    END;
    IF ok THEN FileIO.WriteString(CRS.lst, " -- none --") END;
    FileIO.WriteLn(CRS.lst);
  END FindCircularProductions;

(* LL1Test              Collect terminal sets and checks LL(1) conditions
----------------------------------------------------------------------*)
PROCEDURE LL1Test (VAR ll1: BOOLEAN);
  VAR
    sn: SymbolNode;
    curSy: INTEGER;

  PROCEDURE LL1Error (cond, ts: INTEGER);
    VAR
      sn: SymbolNode;
    BEGIN
      ll1 := FALSE;
      FileIO.WriteLn(CRS.lst);
      FileIO.WriteString(CRS.lst, " LL(1) error in ");
      GetSym(curSy, sn); FileIO.WriteString(CRS.lst, sn.name);
      FileIO.WriteString(CRS.lst, ": ");
      IF ts > 0 THEN
        GetSym(ts, sn); FileIO.WriteString(CRS.lst, sn.name);
        FileIO.WriteString(CRS.lst, " is ");
      END;
      CASE cond OF
        1: FileIO.WriteString(CRS.lst,
                  "the start of several alternatives.")
      | 2: FileIO.WriteString(CRS.lst,
                  "the start & successor of a deletable structure")
      | 3: FileIO.WriteString(CRS.lst,
                  "an ANY node that matches no symbol")
      END;
    END LL1Error;

  PROCEDURE Check (cond: INTEGER; VAR s1, s2: Set);
    VAR
      i: INTEGER;
    BEGIN
      i := 0;
      WHILE i <= maxT DO
        IF Sets.In(s1, i) & Sets.In(s2, i) THEN LL1Error(cond, i) END;
        INC(i)
      END
    END Check;

  PROCEDURE CheckAlternatives (gp: INTEGER);
    VAR
      gn, gn1: GraphNode;
      s1, s2: Set;
      p: INTEGER;
    BEGIN
      WHILE gp > 0 DO