PROGRAM PL0(INPUT,OUTPUT,INPUT1,OUTPUT1);
  (*PL0 COMPILER WITH CODE GENERATION*)
LABEL
  99;
CONST
  AL=10;     (*LENGTH OF IDENTIFIERS*)
  NORW=14;   (*# OF RESERVED WORDS*)
  TXMAX=100; (*LENGTH OF IDENTIFIER TABLE*)
  NMAX=14;   (*MAX NUMBER OF DEGITS IN NUMBERS*)
  AMAX=2047; (*MAXIMUM ADDRESS*)
  LEVMAX=3;  (*MAX DEPTH OF BLOCK NESTING*)
  CXMAX=200; (*SIZE OF CODE ARRAY*)
TYPE
  SYMBOL=(NUL, IDENT, NUMBER, PLUS, MINUS, TIMES,
          SLASH, ODDSYM, EQL, NEQ, LSS, LEQ, GTR, GEQ,
          LPAREN, RPAREN, COMMA, SEMICOLON, PERIOD,
          BECOMES, BEGINSYM, ENDSYM, IFSYM, THENSYM,
          WHILESYM, WRITESYM, READSYM, DOSYM, CALLSYM,
          CONSTSYM, VARSYM, PROCSYM, PROGSYM);
  ALFA = PACKED ARRAY[1..AL] OF CHAR;
  OBJECTS = (CONSTANT, VARIABLE, PROCEDUR);
    (*WIRTH USED THE WORD "PROCEDURE" THERE,
       WHICH WON'T WORK!*)
  SYMSET = SET OF SYMBOL;
  FCT = ( LIT, OPR, LOD, STO, CAL, INT, JMP, JPC);
  INSTRUCTION = PACKED RECORD
                  F:FCT;       (*FUNCTION CODE*)
                  L:0..LEVMAX; (*LEVEL*)
                  A:0..AMAX;   (*DISPLACEMENT ADDR*)
                END;
        (* LIT O A -- LOAD CONSTANT A
           OPR 0 A -- EXECUTE OPR A
           LOD L A -- LOAD VARIABLE L,A
           STO L A -- STORE VARIABLE L,A
           CAL L A -- CALL PROCEDURE A AT LEVEL L
           INT 0 A -- INCREMET T-REGISTER BY A
           JMP 0 A -- JUMP TO A
           JPC 0 A -- JUMP CONDITIONAL TO A *)
VAR
  LISTSWITCH:BOOLEAN; (*TRUE SET LIST OBJECT CODE*)
  CH:CHAR;    (*LAST CHAR READ*)
  SYM:SYMBOL; (*LAST SYMBOL READ*)
  ID:ALFA;    (*LAST IDENTIFIER READ*)
  NUM:INTEGER;(*LAST NUMBER READ*)
  CC:INTEGER; (*CHARACTER COUNT*)
  LL:INTEGER; (*LINE LENGTH*)
  KK:INTEGER;
  CX:INTEGER; (*CODE ALLOCATION INDEX*)
  LINE:ARRAY[1..81] OF CHAR;
  A:ALFA;
  CODE:ARRAY[0..CXMAX] OF INSTRUCTION;
  WORD:ARRAY[1..NORW] OF ALFA;
  WSYM:ARRAY[1..NORW] OF SYMBOL;
  SSYM:ARRAY[' '..'^'] OF SYMBOL;
    (* WIRTH USES "ARRAY[CHAR]" HERE*)
  MNEMONIC:ARRAY[FCT] OF PACKED ARRAY[1..5] OF CHAR;
  DECLBEGSYS, STATBEGSYS, FACBEGSYS:SYMSET;
  TABLE: ARRAY[0..TXMAX] OF
           RECORD
             NAME:ALFA;
             CASE KIND:OBJECTS OF
               CONSTANT:(VAL:INTEGER);
               VARIABLE,
               PROCEDUR:(LEVEL,ADR,SIZE:INTEGER)
                  (* "SIZE" LACKING IN ORIGINAL.
                     I THINK IT BELONGS HERE *)
             END;
  INPUT1,OUTPUT1:TEXT;
   (*FOR Turbo Pascal NEED FILE VARIABLES*)
  SourceF:STRING[10];
  YN:CHAR{ALFA};  (* 'LIST OBJECT CODE? '*)
  ERR:INTEGER;    (*NOT DECLARED IN ORIGINAL*)

PROCEDURE ERROR(N:INTEGER);
  BEGIN
    WRITELN('****',' ':CC-1,'^',N:2);
    WRITELN(OUTPUT1,'****',' ':CC-1,'^',N:2);
    ERR:=ERR+1
     (*I THINK THIS IS THE WAY IT IS USED*)
  END (*ERROR*);

PROCEDURE GETSYM;
 VAR
   I,J,K:INTEGER;

 PROCEDURE GETCH;
  BEGIN
   IF CC=LL THEN BEGIN
     IF EOF(INPUT1) THEN BEGIN
       WRITE('PROGRAM INCOMPLETE');
       WRITE(OUTPUT1,'PROGRAM INCOMPLETE'); {GOTO 99}
     END;
     LL:=0; CC:=0; WRITE(CX:4,' ');
     WRITE(OUTPUT1,CX:4,' ');
     WHILE NOT EOLN(INPUT1) DO BEGIN
       LL:=LL+1; READ(INPUT1,CH); WRITE(CH);
       WRITE(OUTPUT1,CH); LINE[LL]:=CH
     END;
     WRITELN; WRITELN(OUTPUT1);
     LL:=LL+1; READLN(INPUT1); LINE[LL]:=#13;
   END;
   CC:=CC+1; CH:=LINE[CC]
  END (*GETCH*);

 BEGIN (*GETSYM*)
   WHILE CH<=' ' DO GETCH;
   IF CH IN ['A'..'Z'] THEN BEGIN (*ID OR RESERVED WORD*)
     K:=0;
     REPEAT
       IF K<AL THEN BEGIN
         K:=K+1; A[K]:=CH
       END;
       GETCH
     UNTIL NOT(CH IN ['A'..'Z','0'..'9']);
     IF K>=KK THEN KK:=K
     ELSE REPEAT
            A[KK]:=' '; KK:=KK-1
          UNTIL KK=K;
     ID:=A; I:=1; J:=NORW;
     REPEAT
       K:=(I+J) DIV 2;
       IF ID<=WORD[K] THEN J:=K-1;
       IF ID>=WORD[K] THEN I:=K+1
     UNTIL I>J;
     IF I-1 > J THEN SYM:=WSYM[K]
     ELSE SYM:=IDENT
   END
   ELSE
     IF CH IN ['0'..'9'] THEN BEGIN (*NUMBER*)
       K:=0; NUM:=0; SYM:=NUMBER;
       REPEAT
         NUM:=10*NUM+(ORD(CH)-ORD('0'));
         K:=K+1; GETCH
       UNTIL NOT(CH IN ['0'..'9']);
       IF K>NMAX THEN ERROR(30)
     END
     ELSE
       IF CH=':' THEN BEGIN
         GETCH;
         IF CH='=' THEN BEGIN
           SYM:=BECOMES; GETCH
         END
         ELSE SYM:=NUL;
       END
       ELSE (*THE FOLLOWING TWO CHECK WERE ADDED
              BECAUSE ASCII DOES NOT HAVE A
              SINGLE CHARACTER FOR <= OR >=*)
         IF CH='<' THEN BEGIN
           GETCH;
           IF CH='=' THEN BEGIN
             SYM:=LEQ; GETCH
           END
           ELSE SYM:=LSS
         END
         ELSE
           IF CH='>' THEN BEGIN
             GETCH;
             IF CH='=' THEN BEGIN
               SYM:=GEQ; GETCH
             END
             ELSE SYM:=GTR
           END
           ELSE BEGIN
             SYM:=SSYM[CH]; GETCH
           END
 END (*GETSYM*);

PROCEDURE GEN(X:FCT; Y,Z:INTEGER);
 BEGIN
   IF CX>CXMAX THEN BEGIN
     WRITE('PROGRAM TOO LONG');
     WRITE(OUTPUT1,'PROGRAM TOO LONG'); {GOTO 99}
   END;
   WITH CODE[CX] DO BEGIN
     F:=X; L:=Y; A:=Z
   END;
   CX:=CX+1
 END (*GEN*);

PROCEDURE TEST(S1,S2:SYMSET; N:INTEGER);
 BEGIN
   IF NOT(SYM IN S1) THEN BEGIN
     ERROR(N); S1:=S1+S2;
     WHILE NOT(SYM IN S1) DO GETSYM
   END
 END  (*TEST*) ;

PROCEDURE BLOCK(LEV,TX:INTEGER; FSYS:SYMSET);
 VAR
   DX :INTEGER;  (*DATA ALLOCATION INDEX*)
   TX0:INTEGER;  (*INITIAL TABLE INDEX*)
   CX0:INTEGER;  (*INITIAL CODE INDEX*)

 PROCEDURE ENTER(K:OBJECTS);
   BEGIN (*ENTER OBJECT INTO TABLE*)
     TX:=TX+1;
     WITH TABLE[TX] DO BEGIN
       NAME:=ID;KIND:=K;
       CASE K OF
         CONSTANT: BEGIN
             IF NUM>AMAX THEN BEGIN
               ERROR(31); NUM:=0
             END;
             VAL:=NUM
           END;
         VARIABLE: BEGIN
             LEVEL:=LEV; ADR:=DX; DX:=DX+1
           END;
         PROCEDUR:  LEVEL:=LEV
       END
     END
   END(*ENTER*);

 FUNCTION POSITION(ID:ALFA):INTEGER;
  VAR
    I:INTEGER;
  BEGIN (*FIND IDENTIFIER IN TABLE*)
    TABLE[0].NAME:=ID; I:=TX;
    WHILE TABLE[I].NAME<>ID DO I:=I-1;
    POSITION:=I
  END (*POSITION*);

 PROCEDURE CONSTDECLARATION;
   BEGIN
    IF SYM=IDENT THEN BEGIN
      GETSYM;
      IF SYM IN [EQL,BECOMES] THEN BEGIN
        IF SYM = BECOMES THEN ERROR(1);
        GETSYM;
        IF SYM=NUMBER THEN BEGIN
          ENTER(CONSTANT); GETSYM
        END
        ELSE ERROR(2)
      END
      ELSE ERROR(3)
    END
    ELSE ERROR(4)
   END (*CONSTDECLARATION*);

 PROCEDURE VARDECLARATION;
   BEGIN
     IF SYM=IDENT THEN BEGIN
       ENTER(VARIABLE); GETSYM
     END
     ELSE ERROR(4)
   END (*VARDECLARATION*);

 PROCEDURE LISTCODE;
   VAR
     I:INTEGER;
   BEGIN (*LIST CODE GENERATED FOR THIS BLOCK*)
     IF LISTSWITCH THEN
       FOR I:= CX0 TO CX-1 DO
         WITH CODE[I] DO BEGIN
           WRITELN(I:4,MNEMONIC[F]:7,L:2,A:4);
           WRITELN(OUTPUT1,I:4,MNEMONIC[F]:7,L:2,A:4)
         END
   END (*LISTCODE*);

 PROCEDURE STATEMENT(FSYS:SYMSET);
  VAR
   I,CX1,CX2:INTEGER;
  PROCEDURE EXPRESSION(FSYS:SYMSET);
   VAR
    ADDOP:SYMBOL;

   PROCEDURE TERM(FSYS:SYMSET);
    VAR
     MULOP:SYMBOL;
    PROCEDURE FACTOR(FSYS:SYMSET);
     VAR
      I:INTEGER;
     BEGIN
       TEST(FACBEGSYS,FSYS,24);
       WHILE SYM IN FACBEGSYS DO BEGIN
         IF SYM=IDENT THEN BEGIN
           I:=POSITION(ID);
           IF I=0 THEN ERROR(11)
           ELSE
             WITH TABLE[I] DO
               CASE KIND OF
                 CONSTANT:GEN(LIT,0,VAL);
                 VARIABLE:GEN(LOD,LEV-LEVEL,ADR);
                 PROCEDUR:ERROR(21)
               END;
           GETSYM
         END
         ELSE
           IF SYM=NUMBER THEN BEGIN
             IF NUM>AMAX THEN BEGIN
               ERROR(31); NUM:=0
             END;
             GEN(LIT,0,NUM); GETSYM
           END
           ELSE
             IF SYM=LPAREN THEN BEGIN
               GETSYM; EXPRESSION([RPAREN]+FSYS);
               IF SYM=RPAREN THEN GETSYM
               ELSE ERROR(22)
             END;
         TEST(FSYS,FACBEGSYS,23)
       END
     END(*FACTOR*);

   BEGIN (*TERM*)
     FACTOR(FSYS+[TIMES,SLASH]);
     WHILE SYM IN [TIMES,SLASH] DO BEGIN
       MULOP:=SYM;GETSYM;FACTOR(FSYS+[TIMES,SLASH]);
       IF MULOP= TIMES THEN GEN(OPR,0,4)
       ELSE GEN(OPR,0,5)
     END
   END (*TERM*);

  BEGIN (*EXPRESSION*)
    IF SYM IN [PLUS,MINUS] THEN BEGIN
      ADDOP:=SYM; GETSYM; TERM(FSYS+[PLUS,MINUS]);
      IF ADDOP=MINUS THEN GEN(OPR,0,1)
    END
    ELSE TERM(FSYS+[PLUS,MINUS]);
    WHILE SYM IN [PLUS,MINUS] DO BEGIN
      ADDOP:=SYM; GETSYM; TERM(FSYS+[PLUS,MINUS]);
      IF ADDOP = PLUS THEN GEN(OPR,0,2)