crx.pas

一个Pascal语言分析器

            PutS(';$')
          END;
        CRTable.t :
          BEGIN
            CRTable.GetSym(gn.p1, sn);
            IndentProc(indent);
            IF Sets.IsIn(checked, gn.p1)
              THEN PutS('Get;$')
              ELSE BEGIN PutS('Expect('); PutSI(gn.p1); PutS(');$') END
          END;
        CRTable.wt :
          BEGIN
            CRTable.CompExpected(ABS(gn.next), curSy, s1);
            CRTable.GetSet(0, s2); Sets.Unite(s1, s2);
            CRTable.GetSym(gn.p1, sn);
            IndentProc(indent);
            PutS('ExpectWeak('); PutSI(gn.p1); PutS(', ');
            PutI(NewCondSet(s1)); PutS(');$')
          END;
        CRTable.any :
          BEGIN IndentProc(indent); PutS('Get;$') END;
        CRTable.eps :
        (* nothing *) 
          BEGIN END;
        CRTable.sem :
          BEGIN CopySourcePart(gn.pos, indent, IndentProc); PutS(';$') END;
        CRTable.sync :
          BEGIN
            CRTable.GetSet(gn.p1, s1);
            GenErrorMsg(syncErr, curSy, errNr);
            IndentProc(indent); PutS('WHILE NOT (');
            GenCond(s1, indent + 9);
            PutS(') DO BEGIN SynError('); PutI(errNr); PutS('); Get END;$') END;
        CRTable.alt :
          BEGIN
            CRTable.CompFirstSet(gp, s1);
            equal := Sets.Equal(s1, checked);
            alts := Alternatives(gp);
            OldNewLine := NewLine;
            IF alts > maxAlter THEN
              BEGIN IndentProc(indent); PutS('CASE sym OF$') END;
            gp2 := gp;
            IF alts > maxAlter
              THEN addInd := 4
              ELSE addInd := 2;
            errSemNod :=  - 1;
            FirstCase := TRUE;
            WHILE gp2 <> 0 DO BEGIN
              CRTable.GetNode(gp2, gn2);
              CRTable.CompExpected(gn2.p1, curSy, s1);
              IndentProc(indent);
              IF alts > maxAlter
                THEN
                  BEGIN PutS('  '); PutSet1(s1); PutS(' : BEGIN$') END
                ELSE IF gp2 = gp THEN
                  BEGIN PutS('IF'); GenCond(s1, indent + 2); PutS(' THEN BEGIN$') END
                ELSE IF (gn2.p2 = 0) AND equal THEN
                  BEGIN PutS('END ELSE BEGIN$') END
                ELSE
                  BEGIN PutS('END ELSE IF'); GenCond(s1, indent + 5); PutS(' THEN BEGIN$') END;
              Sets.Unite(s1, checked);
              GenCode(gn2.p1, indent + addInd, s1);
              NewLine := TRUE;
              IF alts > maxAlter THEN
                BEGIN IndentProc(indent); PutS('    END;$'); END;
              gp2 := gn2.p2;
            END;
            IF NOT equal THEN
              BEGIN
                GenErrorMsg(altErr, curSy, errNr);
                IndentProc(indent);
                IF NOT (alts > maxAlter) THEN
                  BEGIN PutS('END '); END;
                PutS('ELSE BEGIN SynError(');
                PutI(errNr);
                PutS(');$');
                IF alts > maxAlter THEN
                  BEGIN IndentProc(indent); PutS('    END;$'); END;
              END;
            IndentProc(indent);
            PutS('END;$');
          END;
        CRTable.iter :
          BEGIN
            CRTable.GetNode(gn.p1, gn2);
            IndentProc(indent);
            PutS('WHILE');
            IF gn2.typ = CRTable.wt
              THEN
                BEGIN
                  CRTable.CompExpected(ABS(gn2.next), curSy, s1);
                  CRTable.CompExpected(ABS(gn.next), curSy, s2);
                  CRTable.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
                BEGIN
                  gp2 := gn.p1; CRTable.CompFirstSet(gp2, s1); GenCond(s1, indent + 5)
                END;
            PutS(' DO BEGIN$');
            GenCode(gp2, indent + 2, s1);
            IndentProc(indent);
            PutS('END;$');
          END;
        CRTable.opt :
          BEGIN
            CRTable.CompFirstSet(gn.p1, s1);
            IF Sets.Equal(checked, s1)
              THEN GenCode(gn.p1, indent, checked)
              ELSE
                BEGIN
                  IndentProc(indent); PutS('IF');
                  GenCond(s1, indent + 2);
                  PutS(' THEN BEGIN$');
                  GenCode(gn.p1, indent + 2, s1);
                  IndentProc(indent); PutS('END;$');
                END
          END;
      END;
      IF (gn.typ <> CRTable.eps) AND (gn.typ <> CRTable.sem) AND (gn.typ <> CRTable.sync)
        THEN Sets.Clear(checked);
      gp := gn.next;
    END; (* WHILE gp > 0 *)
  END;

(* GenPragmaCode        Generate code for pragmas
----------------------------------------------------------------------*) 

PROCEDURE GenPragmaCode (leftMarg : INTEGER; gramName : STRING);
  LABEL
    999;
  VAR
    i : INTEGER;
    sn : CRTable.SymbolNode;
    FirstCase : BOOLEAN;

  BEGIN
    i := CRTable.maxT + 1;
    IF i > CRTable.maxP THEN EXIT;
    FirstCase := TRUE;
    PutS('CASE sym OF$'); PutB(leftMarg);
    WHILE TRUE DO BEGIN
      CRTable.GetSym(i, sn);
      IF FirstCase
        THEN BEGIN FirstCase := FALSE; PutS('  ') END
        ELSE BEGIN PutS('  ') END;
      PutSI(i); PutS(': BEGIN '); NewLine := FALSE;
      CopySourcePart(sn.semPos, leftMarg + 6, Indent);
      PutS(' END;');
      IF i = CRTable.maxP THEN GOTO 999;
      INC(i); PutLn; PutB(leftMarg);
    END;
    999:
    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;

(* GenProcedureHeading  Generate procedure heading
----------------------------------------------------------------------*) 

PROCEDURE GenProcedureHeading (sn : CRTable.SymbolNode);
  BEGIN
    PutS('PROCEDURE '); PutS('_'); PutS(sn.name);
    IF sn.attrPos.beg >= 0 THEN
      BEGIN
        PutS(' ('); NewLine := FALSE;
        CopySourcePart(sn.attrPos, 13 + Length(sn.name), Indent);
        Put(')')
      END;
    Put(';')
  END;

(* GenForwardRefs       Generate forward references for one-pass compilers
----------------------------------------------------------------------*) 

PROCEDURE GenForwardRefs;
  VAR
    sp : INTEGER;
    sn : CRTable.SymbolNode;

  BEGIN
    sp := CRTable.firstNt;
    WHILE sp <= CRTable.lastNt DO BEGIN (* for all nonterminals *)
      CRTable.GetSym(sp, sn);
      GenProcedureHeading(sn); PutS(' FORWARD;$'); INC(sp)
    END;
    WriteLn(syn);
  END;

(* GenProductions       Generate code for all productions
----------------------------------------------------------------------*) 

PROCEDURE GenProductions;
  VAR
    sn : CRTable.SymbolNode;
    checked : CRTable.CRTSet;

  BEGIN
    curSy := CRTable.firstNt;
    NewLine := TRUE; (* Bug fix PDT*)
    WHILE curSy <= CRTable.lastNt DO BEGIN (* for all nonterminals *)
      CRTable.GetSym(curSy, sn); GenProcedureHeading(sn); WriteLn(syn);
      IF sn.semPos.beg >= 0 THEN
        BEGIN CopySourcePart(sn.semPos, 2, IndentProc); PutLn END;
      PutB(2);
      PutS('BEGIN$');
      {may like to add PutS(" (* "); PutS("_"); PutS(sn.name); PutS(" *)$");}
      Sets.Clear(checked);
      GenCode(sn.struct, 4, checked); PutB(2); PutS('END;$$');
      INC(curSy);
    END;
  END;

(* GenSetInits          Initialise all sets
----------------------------------------------------------------------*) 

PROCEDURE InitSets;
  VAR
    i, j : INTEGER;

  BEGIN
    CRTable.GetSet(0, symSet[0]);
    NewLine := FALSE;
    i := 0;
    WHILE i <= maxSS DO BEGIN
      IF i <> 0 THEN PutLn;
      j := 0;
      WHILE j <= CRTable.maxT DIV Sets.size DO BEGIN
        IF j <> 0 THEN PutLn;
        Indent(2); PutS('symSet['); PutI2(i); PutS(', '); PutI(j);
        PutS('] := ['); PutSet(symSet[i, j], j * Sets.size); PutS('];');
        INC(j);
      END;
      INC(i)
    END
  END;

(* GenCompiler          Generate the target compiler
----------------------------------------------------------------------*) 

PROCEDURE GenCompiler;
  VAR
    Digits, len, pos, LeftMargin : INTEGER;
    errNr, i : INTEGER;
    checked : CRTable.CRTSet;
    gn : CRTable.GraphNode;
    sn : CRTable.SymbolNode;
    gramName, fGramName, fn, ParserFrame : STRING;
    temp : TEXT;
    ch : CHAR;
  BEGIN
    ParserFrame := Concat(CRS.directory, 'parser.frm');
    FileIO.Open(fram, ParserFrame, FALSE);
    IF NOT FileIO.Okay THEN
      BEGIN
        FileIO.SearchFile(fram, 'CRFRAMES', 'parser.frm', FALSE);
        IF NOT FileIO.Okay THEN
          BEGIN WriteLn('"parser.frm" not found - Aborted.'); HALT END
      END;
    LeftMargin := 0;
    CRTable.GetNode(CRTable.root, gn);
    CRTable.GetSym(gn.p1, sn);
    gramName := Copy(sn.name, 1, 7);
    fGramName := Concat(CRS.directory, gramName);
    (*----- write *.err -----*)
    fn := Concat(fGramName, '.err');
    FileIO.Open(err, fn, TRUE);
    i := 0;
    WHILE i <= CRTable.maxT DO BEGIN GenErrorMsg(tErr, i, errNr); INC(i) END;
    IF (CRTable.ddt['N'] OR CRTable.symNames) AND NOT CRTable.ddt['D'] THEN
    (*----- write *G.PAS -----*)
      BEGIN
        fn := Concat(fGramName, 'G.PAS');
        FileIO.Open(syn, fn, TRUE);
        PutS('UNIT '); PutS(gramName); PutS('G;$$');
        PutS('INTERFACE$$');
        PutS('CONST');
        i := 0;
        pos := CRA.MaxSourceLineLength + 1;
        REPEAT
          CRTable.GetSym(i, sn);
          len := Length(sn.constant);
          IF len > 0 THEN
            BEGIN
              errNr := i; Digits := 1;
              WHILE errNr >= 10 DO
                BEGIN INC(Digits); errNr := errNr DIV 10 END;
              INC(len, 3 + Digits + 1);
              IF pos + len > CRA.MaxSourceLineLength THEN
                BEGIN PutLn; pos := 0 END;
              PutS('  '); PutS(sn.constant); PutS(' = '); PutI(i); Put(';');
              INC(pos, len + 2);
            END;
        INC(i);
        UNTIL i > CRTable.maxP;
        PutS('$$IMPLEMENTATION$');
        PutS('END.$');
        Close(syn);
      END;
    (* IF CRTable.ddt["N"] OR CRTable.symNames *)
    (*----- write *P.PAS -----*)
    fn := Concat(fGramName, 'P.$$$');
    FileIO.Open(syn, fn, TRUE);
    CopyFramePart('-->modulename', LeftMargin);
    PutS(gramName); Put('P');
    CopyFramePart('-->scanner', LeftMargin);
    IF CRTable.hasUses THEN
      BEGIN CopySourcePart(CRTable.useDeclPos, 0, PutB); PutS(', ') END;
    PutS(gramName);
    Put('S');
    IF CRTable.ddt['N'] OR CRTable.symNames
      THEN CRA.ImportSymConsts(', ', PutS)
      ELSE PutS(';$');
    CopyFramePart('-->declarations', LeftMargin);
    CopySourcePart(CRTable.semDeclPos, 0, PutB);
    CopyFramePart('-->constants', LeftMargin);
    PutS('maxT = '); PutI(CRTable.maxT); Put(';');
    IF CRTable.maxP > CRTable.maxT THEN
      BEGIN PutLn; PutB(LeftMargin); PutS('maxP = '); PutI(CRTable.maxP); Put(';') END;
    CopyFramePart('-->symSetSize', LeftMargin);
    Write(syn, chr(255)); (* marker *)
    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
      BEGIN
        CopyFramePart('-->scanner', LeftMargin);
        PutS(gramName); Put('S');
      END;
    CopyFramePart('-->productions', LeftMargin);
    GenForwardRefs;
    GenProductions;
    CopyFramePart('-->parseRoot', LeftMargin);
    PutS('_Reset; Get;$');
    Sets.Clear(checked);
    GenCode(CRTable.root, LeftMargin, checked);
    CopyFramePart('-->initialization', LeftMargin);
    InitSets;
    CopyFramePart('-->modulename', LeftMargin);
    PutS(gramName + 'P *)');
    Close(syn); Close(fram); Close(err);
    IF maxSS < 0 THEN maxSS := 0;
    Assign(temp, fn); Reset(temp);
    fn := Concat(fGramName, 'P.PAS');
    FileIO.Open(syn, fn, TRUE);
    WHILE NOT eof(temp) DO BEGIN
      Read(temp, ch);
      IF ch = CHR(255) THEN Write(syn, maxSS:3) ELSE Write(syn, ch)
    END;
    Close(syn); Close(temp); Erase(temp)
  END;

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

PROCEDURE WriteStatistics;

  PROCEDURE WriteNumbers (used, available : INTEGER);
    BEGIN
      WriteLn(CRS.lst, used + 1:6, ' (limit ', available:5, ')');
    END;

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

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