?? 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.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -