www.pudn.com > 453.rar > PL0.PAS
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=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)
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;
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.