(* ASSEMBLER AND INTERPRETER OF PASCAL CODE. K.JENSEN, N.WIRTH, E.T.H. 15.3.73 *) PROGRAM PCODE(INPUT,OUTPUT,PRD,PRR); (* NOTE FOR THE IMPLEMENTATION. =========================== THIS INTERPRETER IS WRITTEN FOR THE CASE WHERE ALL THE FUNDAMENTAL TYPES TAKE ONE STORAGE UNIT. IN AN IMPLEMENTATION ALL THE HANDLING OF THE SP POINTER HAS TO TAKE INTO ACCOUNT THE FACT TAHT THE TYPES MAY HAVE A LENGTH DIFFERENT FROM ONE. SO IN PUSH AND POP OPERATIONS THE IMPLEMENTOR HAS TO INCREASE AND DECREASE THE SP NOT BY 1 BUT BY A NUMBER DEPENDING ON THE TYPE CONCERNED. WHERE A COMMENT SAYS THAT SOME VARIABLE IS EXPRESSED 'IN UNITS OF STORAGE' THE VALUE OF THIS VARIABLE MUST NOT BE CORRECTED, BECAUSE THE COMPILER HAS COMPUTED IT TAKING INTO ACCOUNT THE LENGTHS OF THE TYPES INVOLVED. THE SAME HOLDS FOR THE HANDLING OF THE NP POINTER (WHICH MUST NOT BE CORRECTED) *) (***************************************************** * * * CONVERTED TO ISO 7185 PASCAL BY SCOTT A. MOORE * * [SAM] ON JAN 22, 2011. * * * * VARIOUS CHANGES WERE MADE, ALL MARKED WITH MY * * INITIALS THUS [SAM]. THERE ARE COMMENTS FOR ALL * * CHANGES MADE. THE ONLY OTHERS WERE MINOR FORMAT * * GLITCHES, APPARENTLY DUE TO SEVERAL EOLS * * INSERTED AT VARIOUS PLACES INTO THE CODE. * * * *****************************************************) LABEL 1; CONST CODEMAX = 6735; (* SIZE OF PROGRAM AREA *) PCMAX = 13470; (* 2 * CODEMAX *) MAXSTK = 13650; (* SIZE OF VARIABLE STORE *) OVERI = 13655; (* SIZE OF INTEGER CONSTANT TABLE = 5 *) OVERR = 13660; (* SIZE OF REAL CONSTANT TABLE = 5 *) OVERS = 13730; (* SIZE OF SET CONSTANT TABLE = 70 *) OVERB = 13734; (* SIZE OF BOUNDARY CONSTANT TABLE = 4 *) OVERM = 15034; (* SIZE OF MULTIPLE CONSTANT TABLE = 1300 *) MAXSTR = 15035; LARGEINT = 524288; (* = 2**19 *) BEGINCODE = 3; INPUTADR = 4; (* ABSOLUTE ADDRESS *) OUTPUTADR = 5; PRDADR = 6; PRRADR = 7; TYPE BIT4 = 0..15; BIT6 = 0..63; BIT20 = -524287..524287; DATATYPE = (UNDEF,INT,REEL,BOOL,SETT,ADR,MARK); ADDRESS = -1..MAXSTR; BETA = PACKED ARRAY[1..25] OF CHAR; (*ERROR MESSAGE*) { ALFA WAS APPARENTLY A COMPILER DEFINED TYPE. [SAM] } ALFA = PACKED ARRAY [1..10] OF CHAR; VAR CODE : ARRAY[0..CODEMAX] OF (* THE PROGRAM *) PACKED RECORD OP1 :BIT6; P1 :BIT4; Q1 :BIT20; OP2 :BIT6; P2 :BIT4; Q2 :BIT20 END; PC : 0..PCMAX; (*PROGRAM ADDRESS REGISTER*) OP : BIT6; P : BIT4; Q : BIT20; (*INSTRUCTION REGISTER*) STORE : ARRAY [0..OVERM] OF RECORD CASE STYPE :DATATYPE OF UNDEF :(); { ISO 7185 requires all cases present. [sam] } INT :(VI :INTEGER); REEL :(VR :REAL); BOOL :(VB :BOOLEAN); SETT :(VS :SET OF 0..58); ADR :(VA :ADDRESS); (*ADDRESS IN STORE*) MARK :(VM :INTEGER); END; MP,SP,NP : ADDRESS; (* ADDRESS REGISTERS *) (*MP POINTS TO BEGINNING OF A DATA SEGMENT SP POINTS TO TOP OF THE STACK NP POINTS TO TOP OF DYNAMICLY ALLOCATED AREA*) INTERPRETING : BOOLEAN; PRD,PRR: TEXT;(*PRD FOR READ ONLY, PRR FOR WRITE ONLY *) INSTR : ARRAY[BIT6] OF ALFA; (* MNEMONIC INSTRUCTION CODES *) SPTABLE : ARRAY[0..20] OF ALFA; (* STANDARD FUNCTIONS AND PROCEDURES *) (*-----------------------------------------------------------------------------*) PROCEDURE LOAD; CONST MAXLABEL = 1550; (* COMPLETE COMPILER PROCESSING *) TYPE LABELST = (ENTERED,DEFINED); (*LABEL SITUATION*) LABELRG = 0..MAXLABEL; (*LABEL RANGE*) LABELREC = RECORD VAL: ADDRESS; ST: LABELST END; VAR ICP,RCP,SCP,BCP,MCP : ADDRESS; (*POINTERS TO NEXT FREE POSITION*) WORD : ARRAY[1..10] OF CHAR; I : INTEGER; CH : CHAR; LABELTAB: ARRAY[LABELRG] OF LABELREC; LABELVALUE: ADDRESS; PROCEDURE INIT; VAR I: INTEGER; BEGIN INSTR[ 0]:='LOD '; INSTR[ 1]:='LDO '; INSTR[ 2]:='STR '; INSTR[ 3]:='SRO '; INSTR[ 4]:='LDA '; INSTR[ 5]:='LAO '; INSTR[ 6]:='STO '; INSTR[ 7]:='LDC '; INSTR[ 8]:='... '; INSTR[ 9]:='IND '; INSTR[10]:='INC '; INSTR[11]:='MST '; INSTR[12]:='CUP '; INSTR[13]:='ENT '; INSTR[14]:='RET '; INSTR[15]:='CSP '; INSTR[16]:='IXA '; INSTR[17]:='EQU '; INSTR[18]:='NEQ '; INSTR[19]:='GEQ '; INSTR[20]:='GRT '; INSTR[21]:='LEQ '; INSTR[22]:='LES '; INSTR[23]:='UJP '; INSTR[24]:='FJP '; INSTR[25]:='XJP '; INSTR[26]:='CHK '; INSTR[27]:='EOF '; INSTR[28]:='ADI '; INSTR[29]:='ADR '; INSTR[30]:='SBI '; INSTR[31]:='SBR '; INSTR[32]:='SGS '; INSTR[33]:='FLT '; INSTR[34]:='FLO '; INSTR[35]:='TRC '; INSTR[36]:='NGI '; INSTR[37]:='NGR '; INSTR[38]:='SQI '; INSTR[39]:='SQR '; INSTR[40]:='ABI '; INSTR[41]:='ABR '; INSTR[42]:='NOT '; INSTR[43]:='AND '; INSTR[44]:='IOR '; INSTR[45]:='DIF '; INSTR[46]:='INT '; INSTR[47]:='UNI '; INSTR[48]:='INN '; INSTR[49]:='MOD '; INSTR[50]:='ODD '; INSTR[51]:='MPI '; INSTR[52]:='MPR '; INSTR[53]:='DVI '; INSTR[54]:='DVR '; INSTR[55]:='MOV '; INSTR[56]:='LCA '; INSTR[57]:='DEC '; INSTR[58]:='STP '; SPTABLE[ 0]:='GET '; SPTABLE[ 1]:='PUT '; SPTABLE[ 2]:='RST '; SPTABLE[ 3]:='RLN '; SPTABLE[ 4]:='NEW '; SPTABLE[ 5]:='WLN '; SPTABLE[ 6]:='WRS '; SPTABLE[ 7]:='ELN '; SPTABLE[ 8]:='WRI '; SPTABLE[ 9]:='WRR '; SPTABLE[10]:='WRC '; SPTABLE[11]:='RDI '; SPTABLE[12]:='RDR '; SPTABLE[13]:='RDC '; SPTABLE[14]:='SIN '; SPTABLE[15]:='COS '; SPTABLE[16]:='EXP '; SPTABLE[17]:='LOG '; SPTABLE[18]:='SQT '; SPTABLE[19]:='ATN '; SPTABLE[20]:='SAV '; PC:= BEGINCODE; ICP:= MAXSTK+1; FOR I:= ICP TO OVERI DO STORE[I].STYPE:= INT; RCP:= OVERI+1; FOR I:= RCP TO OVERR DO STORE[I].STYPE:= REEL; SCP:= OVERR+1; FOR I:= SCP TO OVERS DO STORE[I].STYPE:= SETT; BCP:= OVERS+2; FOR I:= OVERS+1 TO OVERB DO STORE[I].STYPE:= INT; MCP:= OVERB+1; FOR I:= MCP TO OVERM DO STORE[I].STYPE:= INT; FOR I:= 1 TO 10 DO WORD[I]:= ' '; FOR I:= 0 TO MAXLABEL DO WITH LABELTAB[I] DO BEGIN VAL:=-1; ST:= ENTERED END; RESET(PRD); END;(*INIT*) PROCEDURE ERRORL(STRING: BETA); (*ERROR IN LOADING*) BEGIN WRITELN; WRITE(STRING); GOTO 1 (* TO END PROGRAM PCODE*) END; (*ERRORL*) PROCEDURE UPDATE(X: LABELRG); (*WHEN A LABEL DEFINITION LX IS FOUND*) VAR CURR,SUCC: -1..PCMAX; (*RESP. CURRENT ELEMENT AND SUCCESSOR ELEMENT OF A LIST OF FUTURE REFERENCE*) ENDLIST: BOOLEAN; BEGIN IF LABELTAB[X].ST=DEFINED THEN ERRORL(' DUPLICATED LABEL ') ELSE BEGIN IF LABELTAB[X].VAL<>-1 THEN (*FORWARD REFERENCE(S)*) BEGIN CURR:= LABELTAB[X].VAL; ENDLIST:= FALSE; WHILE NOT ENDLIST DO WITH CODE[CURR DIV 2] DO BEGIN IF ODD(CURR) THEN BEGIN SUCC:= Q2; Q2:= LABELVALUE END ELSE BEGIN SUCC:= Q1; Q1:= LABELVALUE END; IF SUCC=-1 THEN ENDLIST:= TRUE ELSE CURR:= SUCC END; END; LABELTAB[X].ST:= DEFINED; LABELTAB[X].VAL:= LABELVALUE; END END;(*UPDATE*) PROCEDURE ASSEMBLE; FORWARD; PROCEDURE GENERATE;(*GENERATE SEGMENT OF CODE*) VAR X: INTEGER; (* LABEL NUMMER *) BEGIN WHILE NOT EOLN(PRD) DO BEGIN READ(PRD,CH);(* FIRST LINE OF CHARACTER*) CASE CH OF 'I': READLN(PRD); 'L': BEGIN READ(PRD,X); IF NOT EOLN(PRD) THEN READ(PRD,CH); IF CH='=' THEN READ(PRD,LABELVALUE) ELSE LABELVALUE:= PC; UPDATE(X); READLN(PRD); END; ' ': BEGIN READ(PRD,CH); ASSEMBLE END END; END END; (*GENERATE*) PROCEDURE ASSEMBLE; (*TRANSLATE SYMBOLIC CODE INTO MACHINE CODE AND STORE*) VAR NAME :ALFA; B :BOOLEAN; R :REAL; S :SET OF 0..58; C1 :CHAR; I,S1,LB,UB :INTEGER; PROCEDURE LOOKUP(X: LABELRG); (* SEARCH IN LABEL TABLE*) BEGIN CASE LABELTAB[X].ST OF ENTERED:IF LABELTAB[X].VAL=-1 THEN BEGIN LABELTAB[X].VAL:=PC; Q:=-1(*NIL=-1*) END ELSE BEGIN Q:=LABELTAB[X].VAL; LABELTAB[X].VAL:=PC END; DEFINED: Q:= LABELTAB[X].VAL END(*CASE LABEL..*) END;(*LOOKUP*) PROCEDURE LABELSEARCH; VAR X: LABELRG; BEGIN WHILE (CH<>'L') AND NOT EOLN(PRD) DO READ(PRD,CH); READ(PRD,X); LOOKUP(X) END;(*LABELSEARCH*) PROCEDURE GETNAME; BEGIN WORD[1] := CH; READ(PRD,WORD[2],WORD[3]); IF NOT EOLN(PRD) THEN READ(PRD,CH) (*NEXT CHARACTER*); PACK(WORD,1,NAME) END; (*GETNAME*) BEGIN P := 0; Q := 0; OP := 0; GETNAME; WHILE INSTR[OP]<>NAME DO OP := OP+1; CASE OP OF (* GET PARAMETERS P,Q *) (*EQU,NEQ,GEQ,GRT,LEQ,LES*) 17,18,19, 20,21,22 : BEGIN CASE CH OF 'A': ; (*P = 0*) 'I': P := 1; 'R': P := 2; 'B': P := 3; 'S': P := 4; 'M' :BEGIN P := 5; READ(PRD,Q) END END END; (*LOD,STR,LDA*) 0,2,4 : READ(PRD,P,Q); 12 (*CUP*): BEGIN READ(PRD,P); LABELSEARCH END; 11 (*MST*) : READ(PRD,P); 14 (*RET*) : CASE CH OF 'P': P:=0; 'I': P:=1; 'R': P:=2; 'C': P:=3; 'B': P:=4; 'A': P:= 5 END; (*LDO,SRO,LAO,IND,INC,IXA,MOV,DEC*) 1,3,5,9,10, 16,55,57: READ(PRD,Q); (*ENT,UJP,FJP,XJP*) 13,23,24,25: LABELSEARCH; 15 (*CSP*) : BEGIN FOR I:=1 TO 9 DO READ(PRD,CH); GETNAME; WHILE NAME<>SPTABLE[Q] DO Q := Q+1 END; 7 (*LDC*) : BEGIN CASE CH OF (*GET Q*) 'I' :BEGIN P := 1; READ(PRD,I); IF ABS(I)>=LARGEINT THEN BEGIN OP := 8; STORE[ICP].VI := I; Q := MAXSTK; REPEAT Q := Q+1 UNTIL STORE[Q].VI=I; IF Q=ICP THEN BEGIN ICP := ICP+1; IF ICP=OVERI THEN ERRORL(' INTEGER TABLE OVERFLOW ') END END ELSE Q := I END; 'R' :BEGIN OP := 8; P := 2; READ(PRD,R); STORE[RCP].VR := R; Q := OVERI; REPEAT Q := Q+1 UNTIL STORE[Q].VR=R; IF Q=RCP THEN BEGIN RCP := RCP+1; IF RCP=OVERR THEN ERRORL(' REAL TABLE OVERFLOW ') END END; 'N' :; (*P,Q = 0*) 'B' :BEGIN P := 3; READ(PRD,Q) END; '(' :BEGIN OP := 8; P := 4; S := [ ]; READ(PRD,CH); WHILE CH<>')' DO BEGIN READ(PRD,S1,CH); S := S + [S1] END; STORE[SCP].VS := S; Q := OVERR; REPEAT Q := Q+1 UNTIL STORE[Q].VS=S; IF Q=SCP THEN BEGIN SCP := SCP+1; IF SCP=OVERS THEN ERRORL(' SET TABLE OVERFLOW ') END END END (*CASE*) END; 26 (*CHK*) : BEGIN READ(PRD,LB,UB); STORE[BCP-1].VI := LB; STORE[BCP].VI := UB; Q := OVERS; REPEAT Q := Q+2 UNTIL (STORE[Q-1].VI=LB)AND (STORE[Q].VI=UB); IF Q=BCP THEN BEGIN BCP := BCP+2; IF BCP=OVERB THEN ERRORL(' BOUNDARY TABLE OVERFLOW ') END END; 56 (*LCA*) : BEGIN READ(PRD,CH); (*CH = FIRST CHAR IN STRING*) Q := MCP; WHILE CH<>'''' DO BEGIN STORE[MCP].VI := ORD(CH); MCP := MCP+1; READ(PRD,CH) END END; 6,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47, 48,49,50,51,52,53,54,58 : ; END; (*CASE*) READLN(PRD); (* STORE INSTRUCTION *) WITH CODE[PC DIV 2] DO IF ODD(PC) THEN BEGIN OP2 := OP; P2 := P; Q2 := Q END ELSE BEGIN OP1 := OP; P1 := P; Q1 := Q END; PC := PC+1; END; (*ASSEMBLE*) BEGIN (*LOAD*) INIT; GENERATE; PC:=0; READ(PRD,CH); GENERATE; END; (*LOAD*) (*------------------------------------------------------------------------*) PROCEDURE PMD; VAR S :INTEGER; I: INTEGER; PROCEDURE PT; { ADDED INDEX VARIABLE J. [SAM] } VAR J: INTEGER; BEGIN WRITE(S:6); CASE STORE[S].STYPE OF UNDEF: BEGIN WHILE (S>=1)AND (STORE[S].STYPE=UNDEF) DO S := S-1; IF S>=1 THEN S := S+1; WRITE(' --',S:5,' UNDEF') END; INT : WRITE(STORE[S].VI); REEL : WRITE(STORE[S].VR); BOOL : WRITE(STORE[S].VB); { CHANGED SET WRITE TO BITS. THE OLD FORMULATION WAS COMPILER DEPENDENT. [SAM] } SETT : {WRITE(STORE[S].VS:21 OCT);} BEGIN WRITE('['); FOR J := 1 TO 58 DO IF J IN STORE[S].VS THEN WRITE('1') ELSE WRITE('0'); WRITE(']') END; ADR : WRITE(' ^ ',STORE[S].VA:6); MARK : WRITE(' ***',STORE[S].VM:6) END; (*CASE*) S := S - 1; I := I + 1; write('>', i:1, '<'); IF I = 4 THEN BEGIN WRITELN(OUTPUT); I := 0 END; END; (*PT*) BEGIN WRITE(' PC =',PC-1:5,' OP =',OP:3,' SP =',SP:5,' MP =',MP:5,' NP =',NP:5); WRITELN; WRITELN('--------------------------------------'); S := SP; I := 0; WHILE S>=0 DO PT; S := MAXSTK; WHILE S>=NP DO PT; END; (*PMD*) PROCEDURE ERRORI(STRING: BETA); BEGIN WRITELN; WRITELN(STRING); PMD; GOTO 1 END;(*ERRORI*) FUNCTION BASE(LD :INTEGER):ADDRESS; VAR AD :ADDRESS; BEGIN AD := MP; WHILE LD>0 DO BEGIN AD := STORE[AD+1].VM; LD := LD-1 END; BASE := AD END; (*BASE*) PROCEDURE EX0; VAR AD,AD1 :ADDRESS; I,J: INTEGER; PROCEDURE PUSH; BEGIN SP := SP+1; IF SP>=NP THEN ERRORI(' STORE OVERFLOW ') END; PROCEDURE CALLSP; VAR LINE: BOOLEAN; ADPTR,ADELNT: ADDRESS; I: INTEGER; PROCEDURE READI(VAR F:TEXT); VAR AD: ADDRESS; BEGIN AD:= STORE[SP-1].VA; READ(F,STORE[AD].VI); STORE[AD].STYPE:= INT; STORE[STORE[SP].VA].VI:= ORD(F^); SP:= SP-2 END;(*READI*) PROCEDURE READR(VAR F: TEXT); VAR AD: ADDRESS; BEGIN AD:= STORE[SP-1].VA; READ(F,STORE[AD].VR); STORE[AD].STYPE:= REEL; STORE[STORE[SP].VA].VI:= ORD(F^); SP:= SP-2 END;(*READR*) PROCEDURE READC(VAR F: TEXT); VAR C: CHAR; AD: ADDRESS; BEGIN READ(F,C); AD:= STORE[SP-1].VA; STORE[AD].VI:= ORD(C); STORE[AD].STYPE:= INT; STORE[STORE[SP].VA].VI:= ORD(F^); SP:= SP-2 END;(*READC*) PROCEDURE WRITESTR(VAR F: TEXT); VAR I,J,K: INTEGER; AD: ADDRESS; BEGIN AD:= STORE[SP-3].VA; K:= STORE[SP-1].VI; J:= STORE[SP-2].VI; (* J AND K ARE NUMBERS OF CHARACTERS *) IF K>J THEN FOR I:=1 TO K-J DO WRITE(F,' ') ELSE J:= K; FOR I:=0 TO J-1 DO WRITE(F,CHR(STORE[AD+I].VI)); (* IN THE INDEX OF STORE I HAS TO BE MULTIPLIED BY CHARSIZE *) SP:= SP-4 END;(*WRITESTR*) PROCEDURE GETFILE(VAR F: TEXT); VAR AD: ADDRESS; BEGIN AD:=STORE[SP].VA; GET(F); STORE[AD].VI:= ORD(F^); SP:=SP-1 END;(*GETFILE*) PROCEDURE PUTFILE(VAR F: TEXT); VAR AD: ADDRESS; BEGIN AD:= STORE[SP].VA; F^:= CHR(STORE[AD].VI); PUT(F); STORE[AD].STYPE:= UNDEF; SP:= SP-1; END;(*PUTFILE*) BEGIN (*CALLSP*) CASE Q OF 0 (*GET*): CASE STORE[SP].VA OF 4: GETFILE(INPUT); 5: ERRORI(' GET ON OUTPUT FILE '); 6: GETFILE(PRD); 7: ERRORI(' GET ON PRR FILE ') END; 1 (*PUT*): CASE STORE[SP].VA OF 4: ERRORI(' PUT ON READ FILE '); 5: PUTFILE(OUTPUT); 6: ERRORI(' PUT ON PRD FILE '); 7: PUTFILE(PRR) END; 2 (*RST*): BEGIN NP:= STORE[SP].VI; SP:=SP-1 END; 3 (*RLN*) : BEGIN CASE STORE[SP].VA OF 4: BEGIN READLN(INPUT);STORE[INPUTADR].VI:=ORD(INPUT^) END; 5: ERRORI(' READLN ON OUTPUT FILE '); 6: BEGIN READLN(PRD); STORE[PRDADR].VI:= ORD(PRD^) END; 7: ERRORI(' READLN ON PRR FILE ') END; SP:= SP-1 END; 4 (*NEW*): BEGIN AD:= NP-STORE[SP].VA; (*TOP OF STACK GIVES THE LENGTH IN UNITS OF STORAGE *) IF AD<= SP THEN ERRORI(' STORE OVERFLOW '); FOR I:=NP-1 DOWNTO AD DO STORE[I].STYPE:= UNDEF; NP:= AD; AD:= STORE[SP-1].VA; STORE[AD].VA:= NP; STORE[AD].STYPE:=ADR; SP:=SP-2 END; 5 (*WLN*) : BEGIN CASE STORE[SP].VA OF 4: ERRORI(' WRITELN ON INPUT FILE '); 5: WRITELN(OUTPUT); 6: ERRORI(' WRITELN ON PRD FILE '); 7: WRITELN(PRR) END; SP:= SP-1 END; 6 (*WRS*): CASE STORE[SP].VA OF 4: ERRORI(' WRITE ON INPUT FILE '); 5: WRITESTR(OUTPUT); 6: ERRORI(' WRITE ON PRD FILE '); 7: WRITESTR(PRR) END; 7 (*ELN*) : BEGIN CASE STORE[SP].VA OF 4: LINE:= EOLN(INPUT); 5: ERRORI(' EOLN OUTPUT FILE '); 6: LINE:=EOLN(PRD); 7: ERRORI(' EOLN ON PRR FILE ') END; STORE[SP].VB:= LINE; STORE[SP].STYPE:= BOOL END; 8 (*WRI*) : BEGIN CASE STORE[SP].VA OF 4: ERRORI(' WRITE ON INPUT FILE '); 5: WRITE(OUTPUT,STORE[SP-2].VI:STORE[SP-1].VI); 6: ERRORI(' WRITE ON PRD FILE '); 7: WRITE(PRR,STORE[SP-2].VI:STORE[SP-1].VI) END; SP:=SP-3 END; 9 (*WRR*) : BEGIN CASE STORE[SP].VA OF 4: ERRORI(' WRITE ON INPUT FILE '); 5: WRITE(OUTPUT,STORE[SP-2].VR:STORE[SP-1].VI); 6: ERRORI(' WRITE ON PRD FILE '); 7: WRITE(PRR,STORE[SP-2].VR:STORE[SP-1].VI) END; SP:=SP-3 END; 10 (*WRC*):BEGIN CASE STORE[SP].VA OF 4: ERRORI(' WRITE ON INPUT FILE '); 5: WRITE(OUTPUT,CHR(STORE[SP-2].VI):STORE[SP-1].VI); 6: ERRORI(' WRITE ON PRD FILE '); 7: WRITE(PRR,CHR(STORE[SP-2].VI):STORE[SP-1].VI) END; SP:=SP-3 END; 11(*RDI*) : CASE STORE[SP].VA OF 4: READI(INPUT); 5: ERRORI(' READ ON OUTPUT FILE '); 6: READI(PRD); 7: ERRORI(' READ ON PRR FILE ') END; 12(*RDR*) : CASE STORE[SP].VA OF 4: READR(INPUT); 5: ERRORI(' READ ON OUTPUT FILE '); 6: READR(PRD); 7: ERRORI(' READ ON PRR FILE ') END; 13(*RDC*): CASE STORE[SP].VA OF 4: READC(INPUT); 5: ERRORI(' READ ON OUTPUT FILE '); 6: READC(PRD); 7: ERRORI(' READ ON PRR FILE ') END; 14(*SIN*): STORE[SP].VR:= SIN(STORE[SP].VR); 15(*COS*): STORE[SP].VR:= COS(STORE[SP].VR); 16(*EXP*): STORE[SP].VR:= EXP(STORE[SP].VR); 17(*LOG*): STORE[SP].VR:= LN(STORE[SP].VR); 18(*SQT*): STORE[SP].VR:= SQRT(STORE[SP].VR); 19(*ATN*): STORE[SP].VR:= ARCTAN(STORE[SP].VR); 20(*SAV*): BEGIN AD:=STORE[SP].VA; STORE[AD].STYPE:=ADR; STORE[AD].VI:= NP; SP:= SP-1 END; END;(*CASE Q*) END;(*CALLSP*) BEGIN CASE OP OF (* IN THIS PROCEDURE Q MUST NOT BE CORRECTED *) 0 (*LOD*): BEGIN AD := BASE(P) + Q; IF STORE[AD].STYPE=UNDEF THEN ERRORI(' VALUE UNDEFINED '); PUSH; STORE[SP] := STORE[AD] END; 1 (*LDO*): BEGIN IF STORE[Q].STYPE=UNDEF THEN ERRORI(' VALUE UNDEFINED '); PUSH; STORE[SP] := STORE[Q] END; 2 (*STR*): BEGIN STORE[BASE(P)+Q] := STORE[SP]; SP := SP-1 END; 3 (*SRO*): BEGIN STORE[Q] := STORE[SP]; SP := SP-1 END; 4 (*LDA*): BEGIN PUSH; STORE[SP].VA := BASE(P) + Q; STORE[SP].STYPE := ADR END; 5 (*LAO*): BEGIN PUSH; STORE[SP].VA := Q; STORE[SP].STYPE := ADR END; 6 (*STO*): BEGIN STORE[STORE[SP-1].VA] := STORE[SP]; SP := SP-2 END; 7 (*LDC*): BEGIN PUSH; IF P=1 THEN BEGIN STORE[SP].VI := Q; STORE[SP].STYPE := INT END ELSE IF P=3 THEN BEGIN STORE[SP].VB := Q=1; STORE[SP].STYPE := BOOL END ELSE (*LOAD NIL*) BEGIN STORE[SP].VA := MAXSTR; STORE[SP].STYPE := ADR END END; 8 (*LCI*): BEGIN PUSH; STORE[SP] := STORE[Q] END; 9 (*IND*): BEGIN AD := STORE[SP].VI + Q; (* Q IS A NUMBER OF STORAGE UNITS *) IF STORE[AD].STYPE=UNDEF THEN ERRORI(' VALUE UNDEFINED '); STORE[SP] := STORE[AD] END; 10 (*INC*):STORE[SP].VI := STORE[SP].VI + Q; 11 (*MST*):BEGIN (*P=LEVEL OF CALLING PROCEDURE MINUS LEVEL OF CALLED PROCEDURE + 1; SET DL AND SL, INCREMENT SP*) STORE[SP+1].STYPE := UNDEF; (* THEN LENTH OF THIS ELEMENT IS MAX(INTSIZE,REALSIZE,BOOLSIZE,CHARSIZE,PTRSIZE *) STORE[SP+2].STYPE := MARK; STORE[SP+2].VM := BASE(P); (* THE LENGTH OF THIS ELEMENT IS PTRSIZE *) STORE[SP+3].STYPE := MARK; STORE[SP+3].VM := MP; (* IDEM *) STORE[SP+4].STYPE := UNDEF; (* IDEM *) SP := SP+4 END; 12 (*CUP*):BEGIN (*P=NO OF LOCATIONS FOR PARAMETERS, Q=ENTRY POINT*) MP := SP-(P+3); STORE[MP+3].STYPE := MARK; STORE[MP+3].VM := PC; PC := Q END; 13 (*ENT*):BEGIN J := MP+Q; (*Q=LENGTH OF DATA SEG*) IF J>NP THEN ERRORI(' STORE OVERFLOW '); (*RESET TO UNDEFINED--MAY DECIDE TO REMOVE THIS TEST*) IF SPQ) DO IF STORE[I1+I].VI=STORE[I2+I].VI THEN I := I+1 ELSE B := FALSE END; (*COMPARE*) BEGIN CASE OP OF (* IN THIS PROCEDURE Q MUST NOT BE CORRECTED *) 16 (*IXA*):BEGIN SP := SP-1; (* Q IS A NUMBER OF STORAGE UNITS *) STORE[SP].VA := Q*STORE[SP+1].VA + STORE[SP].VA END; 17 (*EQU*):BEGIN SP := SP-1; CASE P OF 0,1: STORE[SP].VB := STORE[SP].VI=STORE[SP+1].VI; 2: STORE[SP].VB := STORE[SP].VR=STORE[SP+1].VR; 3: STORE[SP].VB := STORE[SP].VB=STORE[SP+1].VB; 4: STORE[SP].VB := STORE[SP].VS=STORE[SP+1].VS; 5: BEGIN COMPARE; STORE[SP].VB := B; END; END; (*CASE P*) STORE[SP].STYPE := BOOL END; 18 (*NEQ*):BEGIN SP := SP-1; CASE P OF 0,1: STORE[SP].VB := STORE[SP].VI<>STORE[SP+1].VI; 2: STORE[SP].VB := STORE[SP].VR<>STORE[SP+1].VR; 3: STORE[SP].VB := STORE[SP].VB<>STORE[SP+1].VB; 4: STORE[SP].VB := STORE[SP].VS<>STORE[SP+1].VS; 5: BEGIN COMPARE; STORE[SP].VB := NOT B; END END; (*CASE P*) STORE[SP].STYPE := BOOL END; 19 (*GEQ*):BEGIN SP := SP-1; CASE P OF 0,1: STORE[SP].VB := STORE[SP].VI>=STORE[SP+1].VI; 2: STORE[SP].VB := STORE[SP].VR>=STORE[SP+1].VR; 3: STORE[SP].VB := STORE[SP].VB>=STORE[SP+1].VB; 4: STORE[SP].VB := STORE[SP].VS>=STORE[SP+1].VS; 5: BEGIN COMPARE; STORE[SP].VB := (STORE[I1+I].VI>=STORE[I2+I].VI)OR B END END; (*CASE P*) STORE[SP].STYPE := BOOL END; 20 (*GRT*):BEGIN SP := SP-1; CASE P OF 0,1: STORE[SP].VB := STORE[SP].VI>STORE[SP+1].VI; 2: STORE[SP].VB := STORE[SP].VR>STORE[SP+1].VR; 3: STORE[SP].VB := STORE[SP].VB>STORE[SP+1].VB; 4: ERRORI(' SET INCLUSION '); 5: BEGIN COMPARE; STORE[SP].VB := (STORE[I1+I].VI>STORE[I2+I].VI)AND NOT B END END; (*CASEP*) STORE[SP].STYPE := BOOL END; 21 (*LEQ*):BEGIN SP := SP-1; CASE P OF 0,1: STORE[SP].VB := STORE[SP].VI<=STORE[SP+1].VI; 2: STORE[SP].VB := STORE[SP].VR<=STORE[SP+1].VR; 3: STORE[SP].VB := STORE[SP].VB<=STORE[SP+1].VB; 4: STORE[SP].VB := STORE[SP].VS<=STORE[SP+1].VS; 5: BEGIN COMPARE; STORE[SP].VB := (STORE[I1+I].VI<=STORE[I2+I].VI)OR B END; END; (*CASE P*) STORE[SP].STYPE := BOOL END; 22 (*LES*):BEGIN SP := SP-1; CASE P OF 0,1: STORE[SP].VB := STORE[SP].VISTORE[Q].VI)THEN ERRORI(' VALUE OUT OF RANGE '); 27 (*EOF*):BEGIN I := STORE[SP].VI; IF I=INPUTADR THEN BEGIN STORE[SP].VB := EOF(INPUT); STORE[SP].STYPE := BOOL END ELSE ERRORI(' CODE IN ERROR ') END; 28 (*ADI*):BEGIN SP := SP-1; STORE[SP].VI := STORE[SP].VI + STORE[SP+1].VI END; 29 (*ADR*):BEGIN SP := SP-1; STORE[SP].VR := STORE[SP].VR + STORE[SP+1].VR END; 30 (*SBI*):BEGIN SP := SP-1; STORE[SP].VI := STORE[SP].VI - STORE[SP+1].VI END; 31 (*SBR*):BEGIN SP := SP-1; STORE[SP].VR := STORE[SP].VR - STORE[SP+1].VR END; END (*CASE OP*) END; (*EX1*) PROCEDURE EX2; BEGIN CASE OP OF 32 (*SGS*):BEGIN STORE[SP].VS := [STORE[SP].VI]; STORE[SP].STYPE := SETT END; 33 (*FLT*):BEGIN STORE[SP].VR := STORE[SP].VI; STORE[SP].STYPE := REEL END; 34 (*FLO*):BEGIN STORE[SP-1].VR := STORE[SP-1].VI; STORE[SP-1].STYPE := REEL END; 35 (*TRC*):BEGIN STORE[SP].VI := TRUNC(STORE[SP].VR); STORE[SP].STYPE := INT END; 36 (*NGI*):STORE[SP].VI := -STORE[SP].VI; 37 (*NGR*):STORE[SP].VR := -STORE[SP].VR; 38 (*SQI*):STORE[SP].VI := SQR(STORE[SP].VI); 39 (*SQR*):STORE[SP].VR := SQR(STORE[SP].VR); 40 (*ABI*):STORE[SP].VI := ABS(STORE[SP].VI); 41 (*ABR*):STORE[SP].VR := ABS(STORE[SP].VR); 42 (*NOT*):STORE[SP].VB := NOT STORE[SP].VB; 43 (*AND*):BEGIN SP := SP-1; STORE[SP].VB := STORE[SP].VB AND STORE[SP+1].VB END; 44 (*IOR*):BEGIN SP := SP-1; STORE[SP].VB := STORE[SP].VB OR STORE[SP+1].VB END; 45 (*DIF*):BEGIN SP := SP-1; STORE[SP].VS := STORE[SP].VS - STORE[SP+1].VS END; 46 (*INT*):BEGIN SP := SP-1; STORE[SP].VS := STORE[SP].VS * STORE[SP+1].VS END; 47 (*UNI*):BEGIN SP := SP-1; STORE[SP].VS := STORE[SP].VS + STORE[SP+1].VS END; END (*CASE OP*) END; (*EX2*) PROCEDURE EX3; VAR I,I1,I2 :ADDRESS; BEGIN CASE OP OF 48 (*INN*):BEGIN SP := SP-1; STORE[SP].VB := STORE[SP].VI IN STORE[SP+1].VS; STORE[SP].STYPE := BOOL END; 49 (*MOD*):BEGIN SP := SP-1; STORE[SP].VI := STORE[SP].VI MOD STORE[SP+1].VI END; 50 (*ODD*):BEGIN STORE[SP].VB := ODD(STORE[SP].VI); STORE[SP].STYPE := BOOL END; 51 (*MPI*):BEGIN SP := SP-1; STORE[SP].VI := STORE[SP].VI * STORE[SP+1].VI END; 52 (*MPR*):BEGIN SP := SP-1; STORE[SP].VR := STORE[SP].VR * STORE[SP+1].VR END; 53 (*DVI*):BEGIN SP := SP-1; STORE[SP].VI := STORE[SP].VI DIV STORE[SP+1].VI END; 54 (*DVR*):BEGIN SP := SP-1; STORE[SP].VR := STORE[SP].VR/STORE[SP+1].VR END; 55 (*MOV*): BEGIN I1 := STORE[SP-1].VA; I2 := STORE[SP].VA; SP := SP-2; FOR I := 0 TO Q-1 DO STORE[I1+I] := STORE[I2+I] (* Q IS A NUMBER OF STORAGE UNITS *) END; 56 (*LCA*):BEGIN SP := SP + 1; IF SP >= NP THEN ERRORI(' STORE OVERFLOW '); STORE[SP].VA := Q; STORE[SP].STYPE := ADR END; 57 (*DEC*):STORE[SP].VI := STORE[SP].VI - Q; 58 (*STP*):INTERPRETING := FALSE; END (*CASE OP*) END; (*EX3*) (*------------------------------------------------------------------------*) BEGIN (* M A I N *) REWRITE(PRR); LOAD; (* ASSEMBLES AND STORES CODE *) WRITELN(OUTPUT); (*FOR TESTING*) PC := 0; SP := -1; MP := 0; NP := MAXSTK+1; STORE[INPUTADR].STYPE := INT; STORE[INPUTADR].VI := ORD(INPUT^); STORE[PRDADR].STYPE:= INT; STORE[PRDADR].VI:= ORD(PRD^); STORE[OUTPUTADR].STYPE:= UNDEF; INTERPRETING := TRUE; WHILE INTERPRETING DO BEGIN (*FETCH*) WITH CODE[PC DIV 2] DO IF ODD(PC) THEN BEGIN OP := OP2; P := P2; Q := Q2 END ELSE BEGIN OP := OP1; P := P1; Q := Q1 END; PC := PC+1; (*EXECUTE*) CASE OP DIV 16 OF 0: EX0; 1: EX1; 2: EX2; 3: EX3 END END; (*WHILE INTERPRETING*) 1 : END.