pl0.pas

此源码是编译器原理代码

      ELSE GEN(OPR,0,3)
    END
  END (*EXPRESSION*);

 PROCEDURE CONDITION(FSYS:SYMSET);
  VAR
   RELOP:SYMBOL;
  BEGIN
    IF SYM=ODDSYM THEN BEGIN
      GETSYM; EXPRESSION(FSYS); GEN(OPR,0,6)
    END
    ELSE BEGIN
      EXPRESSION([EQL,NEQ,LSS,LEQ,GTR,GEQ]+FSYS);
      IF NOT(SYM IN [EQL,NEQ,LSS,LEQ,GTR,GEQ])
      THEN ERROR(20)
      ELSE BEGIN
        RELOP:=SYM; GETSYM; EXPRESSION(FSYS);
        CASE RELOP OF
          EQL: GEN(OPR,0,8);
          NEQ: GEN(OPR,0,9);
          LSS: GEN(OPR,0,10);
          GEQ: GEN(OPR,0,11);
          GTR: GEN(OPR,0,12);
          LEQ: GEN(OPR,0,13);
        END
      END
    END
  END (*CONDITION*);

  BEGIN (*STATEMENT*)
   CASE SYM OF
    IDENT: BEGIN
        I:=POSITION(ID);
        IF I=0 THEN ERROR(11)
        ELSE
          IF TABLE[I].KIND<>VARIABLE THEN BEGIN
            (*ASSIGNMENT TO NON-VARIABLE*)
            ERROR(12); I:=0
          END;
        GETSYM;
        IF SYM=BECOMES THEN GETSYM
        ELSE ERROR(13);
        EXPRESSION(FSYS);
        IF I<>0 THEN
          WITH TABLE[I] DO GEN(STO,LEV-LEVEL,ADR)
      END;
    READSYM: BEGIN
        GETSYM;
        IF SYM<>LPAREN THEN ERROR(34)
        ELSE
          REPEAT
            GETSYM;
            IF SYM=IDENT THEN I:=POSITION(ID)
            ELSE I:=0;
            IF I=0 THEN ERROR(35)
            ELSE
              WITH TABLE[I] DO BEGIN
                GEN(OPR,0,16);
                GEN(STO,LEV-LEVEL,ADR)
              END;
            GETSYM
          UNTIL SYM<>COMMA;
        IF SYM<>RPAREN THEN BEGIN
          ERROR(33);
          WHILE NOT (SYM IN FSYS) DO GETSYM
        END
        ELSE GETSYM
      END; { READSYM }
    WRITESYM: BEGIN
        GETSYM;
        IF SYM=LPAREN THEN BEGIN
          REPEAT
            GETSYM;
            EXPRESSION([RPAREN,COMMA]+FSYS);
            GEN(OPR,0,14)
          UNTIL SYM<>COMMA;
          IF SYM<>RPAREN THEN ERROR(33)
          ELSE GETSYM
        END;
        GEN(OPR,0,15)
      END; {WRITESYM}
    CALLSYM: BEGIN
        GETSYM;
        IF SYM<>IDENT THEN ERROR(14)
        ELSE BEGIN
          I:=POSITION(ID);
          IF I=0 THEN ERROR(11)
          ELSE
            WITH TABLE[I] DO
              IF KIND=PROCEDUR
              THEN GEN(CAL,LEV-LEVEL,ADR)
              ELSE ERROR(15);
            GETSYM
        END
      END;
    IFSYM: BEGIN
        GETSYM;
        CONDITION([THENSYM,DOSYM]+FSYS);
        IF SYM = THENSYM THEN GETSYM
        ELSE ERROR(16);
        CX1:=CX;  GEN(JPC,0,0);
        STATEMENT(FSYS);  CODE[CX1].A:=CX
      END;
    BEGINSYM: BEGIN
        GETSYM;
        STATEMENT([SEMICOLON,ENDSYM]+FSYS);
        WHILE SYM IN [SEMICOLON]+STATBEGSYS DO BEGIN
          IF SYM=SEMICOLON THEN GETSYM
          ELSE ERROR(10);
          STATEMENT([SEMICOLON,ENDSYM]+FSYS)
        END;
        IF SYM= ENDSYM THEN GETSYM
        ELSE ERROR(17)
      END;
    WHILESYM: BEGIN
        CX1:=CX; GETSYM; CONDITION([DOSYM]+FSYS);
        CX2:=CX; GEN(JPC,0,0);
        IF SYM=DOSYM THEN GETSYM
        ELSE ERROR(18);
        STATEMENT(FSYS);
        GEN(JMP,0,CX1);
        CODE[CX2].A:=CX
      END;
   END;
   TEST(FSYS,[],19)
  END (*STATEMENT*);

 BEGIN (*BLOCK*)
   DX:=3; TX0:=TX; CX0:=CX;
   TABLE[TX].ADR:=CX; GEN(JMP,0,0);
   IF LEV>LEVMAX THEN ERROR(32);
     REPEAT
       IF SYM=CONSTSYM THEN BEGIN
         GETSYM;
         REPEAT
           CONSTDECLARATION;
           WHILE SYM=COMMA DO BEGIN
             GETSYM;  CONSTDECLARATION
           END;
           IF SYM=SEMICOLON THEN GETSYM
           ELSE ERROR(5)
         UNTIL SYM<>IDENT
       END;
       IF SYM=VARSYM THEN BEGIN
         GETSYM;
         REPEAT
           VARDECLARATION;
           WHILE SYM=COMMA DO BEGIN
             GETSYM; VARDECLARATION
           END;
           IF SYM=SEMICOLON THEN GETSYM
           ELSE ERROR(5)
         UNTIL SYM<>IDENT;
       END;
       WHILE SYM=PROCSYM DO BEGIN
         GETSYM;
         IF SYM=IDENT THEN BEGIN
           ENTER(PROCEDUR); GETSYM
         END
         ELSE ERROR(4);
         IF SYM=SEMICOLON THEN GETSYM
         ELSE ERROR(5);
         BLOCK(LEV+1,TX,[SEMICOLON]+FSYS);
         IF SYM = SEMICOLON THEN BEGIN
           GETSYM;
           TEST(STATBEGSYS+[IDENT,PROCSYM],FSYS,6)
         END
         ELSE ERROR(5)
       END;
       TEST(STATBEGSYS+[IDENT], DECLBEGSYS,7)
     UNTIL NOT(SYM IN DECLBEGSYS);
   CODE[TABLE[TX0].ADR].A:=CX;
   WITH TABLE[TX0] DO BEGIN
     ADR:=CX;   (*START ADDR OF CODE*)
     SIZE:=DX;  (*SIZE OF DATA SEGMENT*)
     (*"SIZE" WAS NOT DECLARED IN THE ORIGINAL. THIS
     IS ITS ONLY APPEARANCE.  WHAT DOES IT DO?*)
   END;
   GEN(INT,0,DX);
   STATEMENT([SEMICOLON,ENDSYM]+FSYS);
   GEN(OPR,0,0);  (*RETURN*)
   TEST(FSYS,[],8);
   LISTCODE
 END  (*BLOCK*);

PROCEDURE INTERPRET;
 CONST
  STACKSIZE = 500;
 VAR
  P,B,T:INTEGER; (*PROGRAM BASE TOPSTACK REGISTERS*)
  I:INSTRUCTION;
  S:ARRAY[1..STACKSIZE] OF INTEGER;  (*DATASTORE*)

 FUNCTION BASE(L:INTEGER):INTEGER;
  VAR
    B1:INTEGER;
  BEGIN
    B1:=B; (*FIND BASE L LEVELS DOWN*)
    WHILE L>0 DO BEGIN
      B1:=S[B1]; L:=L-1
    END;
    BASE:=B1
  END (*BASE*);

 BEGIN
  WRITELN('*** START PL0 ***');
  WRITELN(OUTPUT1,'*** START PL0 ***');

  T:=0; B:=1; P:=0;
  S[1]:=0; S[2]:=0; S[3]:=0;
  REPEAT
   I:=CODE[P]; P:=P+1;
   WITH I DO
    CASE F OF
     LIT: BEGIN T:=T+1; S[T]:=A END;
     OPR: CASE A OF  (*OPERATOR*)
           0: BEGIN (*RETURN*)
               T:=B-1; P:=S[T+3]; B:=S[T+2]
              END;
           1: S[T]:=-S[T];
           2: BEGIN T:=T-1; S[T]:=S[T]+S[T+1] END;
           3: BEGIN T:=T-1; S[T]:=S[T]-S[T+1] END;
           4: BEGIN T:=T-1; S[T]:=S[T]*S[T+1] END;
           5: BEGIN T:=T-1; S[T]:=S[T] DIV S[T+1] END;
           6: S[T]:=ORD(ODD(S[T]));

           8: BEGIN T:=T-1; S[T]:=ORD(S[T]=S[T+1])  END;
           9: BEGIN T:=T-1; S[T]:=ORD(S[T]<>S[T+1]) END;
          10: BEGIN T:=T-1; S[T]:=ORD(S[T]<S[T+1])  END;
          11: BEGIN T:=T-1; S[T]:=ORD(S[T]>=S[T+1]) END;
          12: BEGIN T:=T-1; S[T]:=ORD(S[T]>S[T+1])  END;
          13: BEGIN T:=T-1; S[T]:=ORD(S[T]<=S[T+1]) END;
          14: BEGIN
                WRITE(S[T]); WRITE(OUTPUT1,S[T]); T:=T-1
              END;
          15: BEGIN WRITELN; WRITELN(OUTPUT1) END;
          16: BEGIN
                T:=T+1; WRITE('? '); WRITE(OUTPUT1,'? ');
                READLN(S[T]); WRITELN(OUTPUT1,S[T])
              END;
          END;
     LOD: BEGIN T:=T+1; S[T]:=S[BASE(L)+A] END;
     STO: BEGIN
            S[BASE(L)+A]:=S[T] (*WRITELN(S[T])*); T:=T-1
          END;
     CAL: BEGIN (*GENERAT NEW BLOCK MARK*)
            S[T+1]:=BASE(L); S[T+2]:=B; S[T+3]:=P;
            B:=T+1; P:=A
          END;
     INT: T:=T+A;
     JMP: P:=A;
     JPC: BEGIN IF S[T]=0 THEN P:=A;  T:=T-1  END;
    END (*WITH,CASE*)
  UNTIL P=0;
  WRITE('*** END PL0 ***');
  WRITE(OUTPUT1,'*** END PL0 ***')
 END (*INTERPRET*);

BEGIN (*MAIN*)
 FOR CH:=' ' TO '^' DO SSYM[CH]:=NUL;
  (*CHANGED BECAUSE OF DIFFERENT CHARACTER SET*)
  (*NOTE THE TYPOS BELOW IN THE ORIGINAL WHERE THE
    ALFAS WERE NOT GIVEN THE CORRECT SPACE*)
 WORD[ 1]:='BEGIN     ';  WORD[ 2]:='CALL      ';
 WORD[ 3]:='CONST     ';  WORD[ 4]:='DO        ';
 WORD[ 5]:='END       ';  WORD[ 6]:='IF        ';
 WORD[ 7]:='ODD       ';  WORD[ 8]:='PROCEDURE ';
 WORD[ 9]:='PROGRAM   ';  WORD[10]:='READ      ';
 WORD[11]:='THEN      ';  WORD[12]:='VAR       ';
 WORD[13]:='WHILE     ';  WORD[14]:='WRITE     ';
 WSYM[ 1]:=BEGINSYM;      WSYM[ 2]:=CALLSYM;
 WSYM[ 3]:=CONSTSYM;      WSYM[ 4]:=DOSYM;
 WSYM[ 5]:=ENDSYM;        WSYM[ 6]:=IFSYM;
 WSYM[ 7]:=ODDSYM;        WSYM[ 8]:=PROCSYM;
 WSYM[ 9]:=PROGSYM;       WSYM[10]:=READSYM;
 WSYM[11]:=THENSYM;       WSYM[12]:=VARSYM;
 WSYM[13]:=WHILESYM;      WSYM[14]:=WRITESYM;
 SSYM['+']:=PLUS;      SSYM['-']:=MINUS;
 SSYM['*']:=TIMES;     SSYM['/']:=SLASH;
 SSYM['(']:=LPAREN;    SSYM[')']:=RPAREN;
 SSYM['=']:=EQL;       SSYM[',']:=COMMA;
 SSYM['.']:=PERIOD;    SSYM['#']:=NEQ;
 SSYM[';']:=SEMICOLON;
 MNEMONIC[LIT]:='LIT  ';   MNEMONIC[OPR]:='OPR  ';
 MNEMONIC[LOD]:='LOD  ';   MNEMONIC[STO]:='STO  ';
 MNEMONIC[CAL]:='CAL  ';   MNEMONIC[INT]:='INT  ';
 MNEMONIC[JMP]:='JMP  ';   MNEMONIC[JPC]:='JPC  ';
 DECLBEGSYS:=[CONSTSYM,VARSYM,PROCSYM];
 STATBEGSYS:=[BEGINSYM,CALLSYM,IFSYM,WHILESYM];
 FACBEGSYS:=[IDENT,NUMBER,LPAREN];

 WRITE('INPUT FILES PL/0 SOURCE PROGRAM NAME?');
 READLN(SourceF);
 ASSIGN(INPUT1,  SourceF+'.PL0');   RESET(INPUT1);
 ASSIGN(OUTPUT1, SourceF+'.COD');  REWRITE(OUTPUT1);
 WRITE('LIST OBJECT CODE?  '); READLN(YN);
 LISTSWITCH:=(YN='Y')or(YN='y');
 ERR:=0;
 CC:=0; CX:=0; LL:=0; CH:=' '; KK:=AL; GETSYM;
 IF SYM<>PROGSYM THEN ERROR(0)
 ELSE BEGIN
   GETSYM;
   IF SYM<>IDENT THEN ERROR(0)
   ELSE BEGIN
     GETSYM;
     IF SYM<>SEMICOLON THEN ERROR(5)
     ELSE GETSYM
   END
 END;
 BLOCK(0,0,[PERIOD]+DECLBEGSYS+STATBEGSYS);
 IF SYM<>PERIOD THEN ERROR(9);
 IF ERR=0 THEN INTERPRET
 ELSE BEGIN
   WRITE('ERROR IN PL/0 PROGRAM');
   WRITE(OUTPUT1,'ERROR IN PL/0 PROGRAM')
 END;
99:
  WRITELN; WRITELN(OUTPUT1); CLOSE(OUTPUT1)

END.