(*ASSEMBLER AND INTERPRETER OF PASCAL CODE*) (*K. JENSEN, N. WIRTH, CH. JACOBI, ETH MAY 76*) 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 THE NUMBER OF UNITS OF STORAGE IS USED EXPLICITELY, THIS VALUE 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) *) LABEL 1; CONST CODEMAX =8650; PCMAX = 17500; 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 = 13820; OVERM = 18000; MAXSTR = 18001; LARGEINT = 26144; BEGINCODE = 3; INPUTADR = 5; OUTPUTADR = 6; PRDADR = 7; PRRADR = 8; DUMINST = 62; TYPE BIT4 = 0..15; BIT6 = 0..127; BIT20 = -26143..26143; DATATYPE = (UNDEF,INT,REEL,BOOL,SETT,ADR,MARK,CAR); ADDRESS = -1..MAXSTR; BETA = PACKED ARRAY[1..25] OF CHAR; (*ERROR MESSAGE*) 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 DATATYPE OF INT :(VI :INTEGER); REEL :(VR :REAL); BOOL :(VB :BOOLEAN); SETT :(VS :SET OF 0..58); CAR :(VC: CHAR); ADR :(VA : ADDRESS); (*ADDRESS IN STORE*) MARK :(VM :INTEGER); END; MP,SP,NP,EP : ADDRESS; (* ADDRESS REGISTERS *) (*MP POINTS TO BEGINNING OF A DATA SEGMENT SP POINTS TO TOP OF THE STACK EP POINTS TO THE STACK WENN IT IS GROWTH THE MAXIMUM 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 *) COP : ARRAY[BIT6] OF INTEGER; SPTABLE : ARRAY[0..20] OF ALFA; (*STANDARD FUNCTIONS AND PROCEDURES*) (*LOCALY USED FOR INTERPRETING ONE INSTRUCTION*) AD,AD1: ADDRESS; B: BOOLEAN; I,J,I1,I2: INTEGER; C: CHAR; (*--------------------------------------------------------------------*) PROCEDURE LOAD; CONST MAXLABEL = 1850; 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 '; INSTR[59] := 'ORD '; INSTR[60] := 'CHR '; INSTR[61] := 'UJC '; 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 '; COP[ 0] := 105; COP[ 1] := 65; COP[ 2] := 70; COP[ 3] := 75; COP[ 6] := 80; COP[ 9] := 85; COP[10] := 90; COP[26] := 95; COP[57] := 100; PC:= BEGINCODE; ICP := MAXSTK + 1; RCP := OVERI + 1; SCP := OVERR + 1; BCP := OVERS + 2; MCP := OVERB + 1; 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); HALT; 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 *) AGAIN: BOOLEAN; BEGIN AGAIN := TRUE; WHILE AGAIN 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; 'Q': BEGIN AGAIN := FALSE; READLN(PRD) END; ' ': BEGIN READ(PRD,CH); ASSEMBLE END END; END END; (*GENERATE*) PROCEDURE ASSEMBLE; (*TRANSLATE SYMBOLIC CODE INTO MACHINE CODE AND STORE*) LABEL 1; (*GOTO 1 FOR INSTRUCTIONS WITHOUT CODE GENERATION*) 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: 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*) PROCEDURE TYPESYMBOL; VAR I: INTEGER; BEGIN IF CH <> 'I' THEN BEGIN CASE CH OF 'A' : I := 0; 'R' : I := 1; 'S' : I := 2; 'B' : I := 3; 'C' : I := 4; END; OP := COP[OP]+I; END; END (*TYPESYMBOL*) ; BEGIN P := 0; Q := 0; OP := 0; GETNAME; INSTR[DUMINST] := NAME; WHILE INSTR[OP]<>NAME DO OP := OP+1; IF OP = DUMINST THEN ERRORL(' ILLEGEAL INSTRUCTION '); 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; 'C' : P := 6; 'M' :BEGIN P := 5; READ(PRD,Q) END END END; (*LOD,STR*) 0,2: BEGIN TYPESYMBOL; READ(PRD,P,Q) END; 4 (*LDA*) : 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; (*LAO,IXA,MOV*) 5,16,55: READ(PRD,Q); (*LDO,SRO,IND,INC,DEC*) 1,3,9,10,57: BEGIN TYPESYMBOL; READ(PRD,Q) END; (*ENT,UJP,FJP,XJP*) 23,24,25: LABELSEARCH; 13 (*ENT*) : BEGIN READ(PRD,P); LABELSEARCH END; 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; 'C': BEGIN P := 6; REPEAT READ(PRD,CH); UNTIL CH <> ' '; IF CH <> '''' THEN ERRORL(' ILLEGAL CHARACTER '); READ(PRD,CH); Q := ORD(CH); READ(PRD,CH); IF CH <> '''' THEN ERRORL(' ILLEGAL CHARACTER '); 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 TYPESYMBOL; READ(PRD,LB,UB); IF OP = 95 THEN Q := LB ELSE BEGIN 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 END; 56 (*LCA*): BEGIN IF MCP + 16 >= OVERM THEN ERRORL(' MULTIPLE TABLE OVERFLOW '); MCP := MCP+16; Q := MCP; FOR I := 0 TO 15 (*STRINGLGTH*) DO BEGIN READ(PRD,CH); STORE[Q+I].VC := CH END; END; 6 (*STO*) : TYPESYMBOL; 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 : ; (*ORD,CHR*) 59,60: GOTO 1; 61 (*UJC*): ; (*MUST HAVE SAME LENGTH AS UJP*) END; (*CASE*) (* 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; 1: READLN(PRD); END; (*ASSEMBLE*) BEGIN (*LOAD*) INIT; GENERATE; PC := 0; GENERATE; END; (*LOAD*) (*------------------------------------------------------------------------*) PROCEDURE PMD; VAR S :INTEGER; I: INTEGER; PROCEDURE PT; BEGIN WRITE(S:6); IF ABS(STORE[S].VI) < MAXINT THEN WRITE(STORE[S].VI) ELSE WRITE('TOO BIG '); S := S - 1; I := 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 COMPARE; (*COMPARING IS ONLY CORRECT IF RESULT BY COMPARING INTEGERS WILL BE*) BEGIN I1 := STORE[SP].VA; I2 := STORE[SP+1].VA; I := 0; B := TRUE; WHILE B AND (I<>Q) DO IF STORE[I1+I].VI = STORE[I2+I].VI THEN I := I+1 ELSE B := FALSE END; (*COMPARE*) 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[STORE[SP].VA].VC := 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[STORE[SP].VA].VC := 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].VC := C; STORE[STORE[SP].VA].VC := F^; 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-2].VI; J := STORE[SP-1].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,STORE[AD+I].VC); SP:= SP-4 END;(*WRITESTR*) PROCEDURE GETFILE(VAR F: TEXT); VAR AD: ADDRESS; BEGIN AD:=STORE[SP].VA; GET(F); STORE[AD].VC := F^; SP:=SP-1 END;(*GETFILE*) PROCEDURE PUTFILE(VAR F: TEXT); VAR AD: ADDRESS; BEGIN AD:= STORE[SP].VA; F^ := STORE[AD].VC; PUT(F); SP:= SP-1; END;(*PUTFILE*) BEGIN (*CALLSP*) CASE Q OF 0 (*GET*): CASE STORE[SP].VA OF 5: GETFILE(INPUT); 6: ERRORI(' GET ON OUTPUT FILE '); 7: GETFILE(PRD); 8: ERRORI(' GET ON PRR FILE ') END; 1 (*PUT*): CASE STORE[SP].VA OF 5: ERRORI(' PUT ON READ FILE '); 6: PUTFILE(OUTPUT); 7: ERRORI(' PUT ON PRD FILE '); 8: PUTFILE(PRR) END; 2 (*RST*): BEGIN (*FOR TESTPHASE*) NP := STORE[SP].VA; SP := SP-1 END; 3 (*RLN*) : BEGIN CASE STORE[SP].VA OF 5: BEGIN READLN(INPUT); STORE[INPUTADR].VC := INPUT^ END; 6: ERRORI(' READLN ON OUTPUT FILE '); 7: BEGIN READLN(INPUT); STORE[INPUTADR].VC := INPUT^ END; 8: 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 <= EP THEN ERRORI(' STORE OVERFLOW '); NP:= AD; AD:= STORE[SP-1].VA; STORE[AD].VA := NP; SP:=SP-2 END; 5 (*WLN*) : BEGIN CASE STORE[SP].VA OF 5: ERRORI(' WRITELN ON INPUT FILE '); 6: WRITELN(OUTPUT); 7: ERRORI(' WRITELN ON PRD FILE '); 8: WRITELN(PRR) END; SP:= SP-1 END; 6 (*WRS*): CASE STORE[SP].VA OF 5: ERRORI(' WRITE ON INPUT FILE '); 6: WRITESTR(OUTPUT); 7: ERRORI(' WRITE ON PRD FILE '); 8: WRITESTR(PRR) END; 7 (*ELN*) : BEGIN CASE STORE[SP].VA OF 5: LINE:= EOLN(INPUT); 6: ERRORI(' EOLN OUTPUT FILE '); 7: LINE:=EOLN(PRD); 8: ERRORI(' EOLN ON PRR FILE ') END; STORE[SP].VB := LINE END; 8 (*WRI*) : BEGIN CASE STORE[SP].VA OF 5: ERRORI(' WRITE ON INPUT FILE '); 6: WRITE(OUTPUT, STORE[SP-2].VI: STORE[SP-1].VI); 7: ERRORI(' WRITE ON PRD FILE '); 8: WRITE(PRR,STORE[SP-2].VI: STORE[SP-1].VI) END; SP:=SP-3 END; 9 (*WRR*) : BEGIN CASE STORE[SP].VA OF 5: ERRORI(' WRITE ON INPUT FILE '); 6: WRITE(OUTPUT, STORE[SP-2].VR: STORE[SP-1].VI); 7: ERRORI(' WRITE ON PRD FILE '); 8: WRITE(PRR,STORE[SP-2].VR: STORE[SP-1].VI) END; SP:=SP-3 END; 10 (*WRC*):BEGIN CASE STORE[SP].VA OF 5: ERRORI(' WRITE ON INPUT FILE '); 6: WRITE(OUTPUT,STORE[SP-2].VC: STORE[SP-1].VI); 7: ERRORI(' WRITE ON PRD FILE '); 8: WRITE(PRR,CHR(STORE[SP-2].VI): STORE[SP-1].VI); END; SP:=SP-3 END; 11(*RDI*) : CASE STORE[SP].VA OF 5: READI(INPUT); 6: ERRORI(' READ ON OUTPUT FILE '); 7: READI(PRD); 8: ERRORI(' READ ON PRR FILE ') END; 12(*RDR*) : CASE STORE[SP].VA OF 5: READR(INPUT); 6: ERRORI(' READ ON OUTPUT FILE '); 7: READR(PRD); 8: ERRORI(' READ ON PRR FILE ') END; 13(*RDC*): CASE STORE[SP].VA OF 5: READC(INPUT); 6: ERRORI(' READ ON OUTPUT FILE '); 7: READC(PRD); 8: 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].VA := NP; SP:= SP-1 END; END;(*CASE Q*) END;(*CALLSP*) BEGIN (* MAIN *) REWRITE(PRR); LOAD; (* ASSEMBLES AND STORES CODE *) WRITELN(OUTPUT); (* FOR TESTING *) PC := 0; SP := -1; MP := 0; NP := MAXSTK+1; EP := 5; STORE[INPUTADR].VC := INPUT^; STORE[PRDADR].VC := PRD^; 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 OF 105,106,107,108,109, 0 (*LOD*): BEGIN AD := BASE(P) + Q; SP := SP+1; STORE[SP] := STORE[AD] END; 65,66,67,68,69, 1 (*LDO*): BEGIN SP := SP+1; STORE[SP] := STORE[Q] END; 70,71,72,73,74, 2 (*STR*): BEGIN STORE[BASE(P)+Q] := STORE[SP]; SP := SP-1 END; 75,76,77,78,79, 3 (*SRO*): BEGIN STORE[Q] := STORE[SP]; SP := SP-1 END; 4 (*LDA*): BEGIN SP := SP+1; STORE[SP].VA := BASE(P) + Q END; 5 (*LAO*): BEGIN SP := SP+1; STORE[SP].VA := Q END; 80,81,82,83,84, 6 (*STO*): BEGIN STORE[STORE[SP-1].VA] := STORE[SP]; SP := SP-2; END; 7 (*LDC*): BEGIN SP := SP+1; IF P=1 THEN BEGIN STORE[SP].VI := Q; END ELSE IF P = 6 THEN STORE[SP].VC := CHR(Q) ELSE IF P = 3 THEN STORE[SP].VB := Q = 1 ELSE (* LOAD NIL *) STORE[SP].VA := MAXSTR END; 8 (*LCI*): BEGIN SP := SP+1; STORE[SP] := STORE[Q] END; 85,86,87,88,89, 9 (*IND*): BEGIN AD := STORE[SP].VA + Q; (* Q IS A NUMBER OF STORAGE UNITS *) STORE[SP] := STORE[AD] END; 90,91,92,93,94, 10 (*INC*): BEGIN STORE[SP].VI := STORE[SP].VI+Q; END; 11 (*MST*):BEGIN (*P=LEVEL OF CALLING PROCEDURE MINUS LEVEL OF CALLED PROCEDURE + 1; SET DL AND SL, INCREMENT SP*) (* THEN LENTH OF THIS ELEMENT IS MAX(INTSIZE,REALSIZE,BOOLSIZE,CHARSIZE,PTRSIZE *) STORE[SP+2].VM := BASE(P); (* THE LENGTH OF THIS ELEMENT IS PTRSIZE *) STORE[SP+3].VM := MP; (* IDEM *) STORE[SP+4].VM := EP; (* IDEM *) SP := SP+5 END; 12 (*CUP*):BEGIN (*P=NO OF LOCATIONS FOR PARAMETERS, Q=ENTRY POINT*) MP := SP-(P+4); STORE[MP+4].VM := PC; PC := Q END; 13 (*ENT*): IF P = 1 THEN BEGIN SP := MP + Q; (*Q = LENGTH OF DATASEG*) IF SP > NP THEN ERRORI(' STORE OVERFLOW '); END ELSE BEGIN EP := SP+Q; IF EP > NP THEN ERRORI(' STORE OVERFLOW '); END; (*Q = MAX SPACE REQUIRED ON STACK*) 14 (*RET*):BEGIN CASE P OF 0: SP:= MP-1; 1,2,3,4,5: SP:= MP END; PC := STORE[MP+4].VM; EP := STORE[MP+3].VM; MP:= STORE[MP+2].VM; END; 15 (*CSP*): CALLSP; 16 (*IXA*): BEGIN I := STORE[SP].VI; SP := SP-1; STORE[SP].VA := Q*I+STORE[SP].VA; END; 17 (*EQU*):BEGIN SP := SP-1; CASE P OF 1: STORE[SP].VB := STORE[SP].VI = STORE[SP+1].VI; 0: STORE[SP].VB := STORE[SP].VA = STORE[SP+1].VA; 6: STORE[SP].VB := STORE[SP].VC = STORE[SP+1].VC; 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*) END; 18 (*NEQ*):BEGIN SP := SP-1; CASE P OF 0: STORE[SP].VB := STORE[SP].VA <> STORE[SP+1].VA; 1: STORE[SP].VB := STORE[SP].VI <> STORE[SP+1].VI; 6: STORE[SP].VB := STORE[SP].VC <> STORE[SP+1].VC; 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*) END; 19 (*GEQ*):BEGIN SP := SP-1; CASE P OF 0: ERRORI(' <,<=,>,>= FOR ADDRESS '); 1: STORE[SP].VB := STORE[SP].VI >= STORE[SP+1].VI; 6: STORE[SP].VB := STORE[SP].VC >= STORE[SP+1].VC; 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 OR (STORE[I1+I].VI >= STORE[I2+I].VI) END END; (*CASE P*) END; 20 (*GRT*):BEGIN SP := SP-1; CASE P OF 0: ERRORI(' <,<=,>,>= FOR ADDRESS '); 1: STORE[SP].VB := STORE[SP].VI > STORE[SP+1].VI; 6: STORE[SP].VB := STORE[SP].VC > STORE[SP+1].VC; 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 := NOT B AND (STORE[I1+I].VI > STORE[I2+I].VI) END END; (*CASEP*) END; 21 (*LEQ*):BEGIN SP := SP-1; CASE P OF 0: ERRORI(' <,<=,>,>= FOR ADDRESS '); 1: STORE[SP].VB := STORE[SP].VI <= STORE[SP+1].VI; 6: STORE[SP].VB := STORE[SP].VC <= STORE[SP+1].VC; 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 OR (STORE[I1+I].VI <= STORE[I2+I].VI) END; END; (*CASE P*) END; 22 (*LES*):BEGIN SP := SP-1; CASE P OF 0: ERRORI(' <,<=,>,>= FOR ADDRESS '); 1: STORE[SP].VB := STORE[SP].VI < STORE[SP+1].VI; 6: STORE[SP].VB := STORE[SP].VC < STORE[SP+1].VC; 2: STORE[SP].VB := STORE[SP].VR(MAXSTR-Q)) THEN ERRORI(' BAD POINTER VALUE '); 96,97,98,99, 26 (*CHK*):IF (STORE[SP].VI < STORE[Q-1].VI) OR (STORE[SP].VI > STORE[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); 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; 32 (*SGS*): BEGIN STORE[SP].VS := [STORE[SP].VI] END; 33 (*FLT*):BEGIN STORE[SP].VR := STORE[SP].VI; END; 34 (*FLO*):BEGIN STORE[SP-1].VR := STORE[SP-1].VI; END; 35 (*TRC*):BEGIN STORE[SP].VI := TRUNC(STORE[SP].VR); 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; 48 (*INN*): BEGIN SP := SP - 1; I := STORE[SP].VI; STORE[SP].VB := I IN STORE[SP+1].VS; 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); 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; STORE[SP].VA := Q; END; 100,101,102,103,104, 57 (*DEC*): BEGIN STORE[SP].VI := STORE[SP].VI-Q; END; 58 (*STP*):INTERPRETING := FALSE; 59(*ORD*): (*ONLY USED TO CHANGE THE TAGFIELD*) BEGIN END; 60(*CHR*): BEGIN END; 61(*UJC*): ERRORI(' CASE - ERROR '); END END; (*WHILE INTERPRETING*) 1 : END.