Power-Programmierung/CD1.mdf/pascal/interpre/pl/simulato.pas

Pascal/Delphi Source File | 1980-01-01 | 9.7 KB | 503 lines

PROGRAM SIMULATOR;
{$C-,K-,V-,D-}
CONST
     MIN = 1;
     MAX = 5000;
TYPE
    WORKSTRING = STRING[80];
    OPERATION_PART =
             (ADD5,AND5,ARROW5,ASSIGN5,BAR5,CALL5,CONSTANT5,DIVIDE5,END_PROC5,
              END_PROG5,EQUAL5,FI5,GREATER5,INDEX5,LESS5,MINUS5,MODULO5,
              MULTIPLY5,NOT5,OR5,PROC5,PROG5,READ5,SUBTRACT5,VALUE5,VARIABLE5,
              WRITE5);
    STORE = ARRAY[MIN..MAX] OF INTEGER;
    ERRORS = (DIVISION_BY_ZERO6,IF_STATEMENT_FAILS6,RANGE_ERROR6,
              STACK_OVERFLOW6);
VAR
    ST: STORE;
    P,B,S: INTEGER;
    STACK_BOTTOM: INTEGER;
    RUNNING: BOOLEAN;
    TEMP2: TEXT[$2000];
    OK: BOOLEAN;


FUNCTION EXIST(FILENAME: WORKSTRING): BOOLEAN;
VAR
   FIL: FILE;
   RESULT: INTEGER;
BEGIN
     ASSIGN(FIL,FILENAME);
     {$I-}
     RESET(FIL);
     {$I+}
     RESULT:= IORESULT;
     IF RESULT = 0
        THEN
          BEGIN
            CLOSE(FIL);
            EXIST:= TRUE
          END
        ELSE EXIST:= FALSE
END;

PROCEDURE ERROR(ERR_TYPE: ERRORS; NUM: INTEGER);
BEGIN
     WRITELN;
     IF ERR_TYPE <> STACK_OVERFLOW6
        THEN WRITE('LINE ',NUM:5,' - INTERPRETER ERROR ')
        ELSE WRITE('PC = ',NUM:5,' - INTERPRETER ERROR ');
     CASE ERR_TYPE OF
          DIVISION_BY_ZERO6: WRITELN(' -- DIVISION BY ZERO');
          IF_STATEMENT_FAILS6: WRITELN(' -- IF STATEMENT FAILS');
          RANGE_ERROR6: WRITELN(' -- RANGE ERROR');
          STACK_OVERFLOW6: WRITELN(' -- STACK OVERFLOW')
     END;
     RUNNING:= FALSE
END;

PROCEDURE ALLOCATE(WORDS: INTEGER);
BEGIN
     S:= S + WORDS;
     IF S > MAX
        THEN ERROR(STACK_OVERFLOW6,P)
END;

PROCEDURE VARIABLE(LEVEL,DISPLACEMENT: INTEGER);
VAR
   X: INTEGER;
BEGIN
     ALLOCATE(1);
     X:= B;
     WHILE LEVEL > 0 DO
       BEGIN
            X:= ST[X];
            LEVEL:= LEVEL - 1
       END;
     ST[S]:= X + DISPLACEMENT;
     P:= P + 3
END;

PROCEDURE INDEX(BOUND,LINENUM: INTEGER);
VAR
   I: INTEGER;
BEGIN
     I:= ST[S];
     S:= S - 1;
     IF (I < 1) OR (I > BOUND)
        THEN ERROR(RANGE_ERROR6,LINENUM)
        ELSE ST[S]:= ST[S] + I - 1;
     P:= P + 3
END;



PROCEDURE CONSTANT(VALUE: INTEGER);
BEGIN
     ALLOCATE(1);
     ST[S]:= VALUE;
     P:= P + 2
END;

PROCEDURE VALUE;
BEGIN
     ST[S]:= ST[ST[S]];
     P:= P + 1
END;

PROCEDURE NOTX;
BEGIN
     ST[S]:= 1 - ST[S];
     P:= P + 1
END;

PROCEDURE MULTIPLY;
BEGIN
     P:= P + 1;
     S:= S - 1;
     ST[S]:= ST[S] * ST[S+1]
END;

PROCEDURE DIVIDE(LINENUM: INTEGER);
BEGIN
     IF ST[S+1] = 0
        THEN ERROR(DIVISION_BY_ZERO6,LINENUM)
        ELSE
          BEGIN
            P:= P + 2;
            S:= S - 1;
            ST[S]:= ST[S] DIV ST[S+1]
          END
END;

PROCEDURE MODULO(LINENUM: INTEGER);
BEGIN
     IF ST[S+1] = 0
        THEN ERROR(DIVISION_BY_ZERO6,LINENUM)
        ELSE
            BEGIN
              P:= P + 2;
              S:= S - 1;
              ST[S]:= ST[S] MOD ST[S+1]
            END
END;

PROCEDURE MINUS;
BEGIN
     ST[S]:= -ST[S];
     P:= P + 1
END;

PROCEDURE ADD;
BEGIN
     P:= P + 1;
     S:= S - 1;
     ST[S]:= ST[S] + ST[S+1]
END;

PROCEDURE SUBTRACT;
BEGIN
     P:= P + 1;
     S:= S - 1;
     ST[S]:= ST[S] - ST[S+1]
END;

PROCEDURE LESS;
BEGIN
     P:= P + 1;
     S:= S - 1;
     ST[S]:= ORD(ST[S] < ST[S+1])
END;

PROCEDURE EQUAL;
BEGIN
     P:= P + 1;
     S:= S - 1;
     ST[S]:= ORD(ST[S] = ST[S+1])
END;

PROCEDURE GREATER;
BEGIN
     P:= P + 1;
     S:= S - 1;
     ST[S]:= ORD(ST[S] > ST[S+1])
END;

PROCEDURE ANDX;
BEGIN
     P:= P + 1;
     S:= S - 1;
     IF ST[S] = ORD(TRUE)
        THEN ST[S]:= ST[S+1]
END;

PROCEDURE ORX;
BEGIN
     P:= P + 1;
     S:= S - 1;
     IF ST[S] = ORD(FALSE)
        THEN ST[S]:= ST[S+1]
END;


PROCEDURE READINT(VAR VALUE: INTEGER);
VAR
   X,Y: INTEGER;
   RESULT: INTEGER;
BEGIN
     X:= WHEREX;
     Y:= WHEREY;
     REPEAT
           {$I-}
           READ(VALUE);
           {$I+}
           RESULT:= IORESULT;
           IF RESULT <> 0
              THEN
                BEGIN
                  GOTOXY(X,Y);
                  CLREOL;
                  WRITE(^G)
                END
     UNTIL RESULT = 0;
     WRITELN
END;


PROCEDURE READX(NUMBER: INTEGER);
VAR
   X: INTEGER;
BEGIN
     P:= P + 2;
     S:= S - NUMBER;
     X:= S;
     WHILE X < S + NUMBER DO
       BEGIN
         X:= X + 1;
         LOWVIDEO;
         WRITE('? ');
         NORMVIDEO;
         READINT(ST[ST[X]])
       END
END;

PROCEDURE WRITEX(NUMBER: INTEGER);
VAR
   X: INTEGER;
BEGIN
     P:= P + 2;
     S:= S - NUMBER;
     X:= S;
     WHILE X < S + NUMBER DO
       BEGIN
         X:= X + 1;
         WRITE(ST[X]:6)
       END;
     WRITELN;
END;

PROCEDURE ASSIGNX(NUMBER: INTEGER);
VAR
   X: INTEGER;
BEGIN
     P:= P + 2;
     S:= S - 2*NUMBER;
     X:= S;
     WHILE X < S + NUMBER DO
       BEGIN
         X:= X + 1;
         ST[ST[X]]:= ST[X + NUMBER]
       END
END;

PROCEDURE CALLX(LEVEL,ADDR: INTEGER);
VAR
   X: INTEGER;
BEGIN
     ALLOCATE(3);
     X:= B;
     WHILE LEVEL > 0 DO
       BEGIN
         X:= ST[X];
         LEVEL:= LEVEL - 1
       END;
     ST[S-2]:= X;
     ST[S-1]:= B;
     ST[S]:= P + 3;
     B:= S - 2;
     P:= ADDR
END;

PROCEDURE ARROW(ADDR: INTEGER);
BEGIN
     IF ST[S] = ORD(TRUE)
        THEN P:= P + 2
        ELSE P:= ADDR;
     S:= S - 1
END;

PROCEDURE BAR(ADDR: INTEGER);
BEGIN
     P:= ADDR
END;

PROCEDURE FI(LINENUM: INTEGER);
BEGIN
     ERROR(IF_STATEMENT_FAILS6,LINENUM)
END;

PROCEDURE PROC(VAR_LENGTH, ADDR: INTEGER);
BEGIN
     ALLOCATE(VAR_LENGTH);
     P:= ADDR
END;

PROCEDURE END_PROC;
BEGIN
     S:= B - 1;
     P:= ST[B + 2];
     B:= ST[B + 1]
END;

PROCEDURE PROG(VAR_LENGTH, ADDR: INTEGER);
BEGIN
     B:= STACK_BOTTOM;
     S:= B;
     ALLOCATE(VAR_LENGTH + 2);
     P:= ADDR
END;

PROCEDURE END_PROG;
BEGIN
     RUNNING:= FALSE
END;




PROCEDURE LOAD_PROGRAM;
VAR
   N: INTEGER;
BEGIN
     N:= MIN;
     {$I-}
     REPEAT
           READ(TEMP2,ST[N]);
           N:= N + 1
     UNTIL EOF(TEMP2);
     {$I+}
     STACK_BOTTOM:= N
END;

PROCEDURE RUN_PROGRAM;
VAR
   OPERATION: OPERATION_PART;
BEGIN
     RUNNING:= TRUE;
     P:= MIN;
     WHILE RUNNING DO
       BEGIN
         OPERATION:= OPERATION_PART(ST[P]);
         CASE OPERATION OF
              ADD5: ADD;
              AND5: ANDX;
              ARROW5: ARROW(ST[P+1]);
              ASSIGN5: ASSIGNX(ST[P+1]);
              BAR5: BAR(ST[P+1]);
              CALL5: CALLX(ST[P+1],ST[P+2]);
              CONSTANT5: CONSTANT(ST[P+1]);
              DIVIDE5: DIVIDE(ST[P+1]);
              END_PROC5: END_PROC;
              END_PROG5: END_PROG;
              EQUAL5: EQUAL;
              FI5: FI(ST[P+1]);
              GREATER5: GREATER;
              INDEX5: INDEX(ST[P+1],ST[P+2]);
              LESS5: LESS;
              MINUS5: MINUS;
              MODULO5: MODULO(ST[P+1]);
              MULTIPLY5: MULTIPLY;
              NOT5: NOTX;
              OR5: ORX;
              PROC5: PROC(ST[P+1],ST[P+2]);
              PROG5: PROG(ST[P+1],ST[P+2]);
              READ5: READX(ST[P+1]);
              SUBTRACT5: SUBTRACT;
              VALUE5: VALUE;
              VARIABLE5: VARIABLE(ST[P+1],ST[P+2]);
              WRITE5: WRITEX(ST[P+1])
         END { CASE }
       END { WHILE }
END;

PROCEDURE SCROLLDOWN(LINES: INTEGER);
TYPE
    REGISTERS = RECORD CASE INTEGER OF
                  1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS: INTEGER);
                  2: (AL,AH,BL,BH,CL,CH,DL,DH: BYTE);
                END;
VAR
   REGS: REGISTERS;
BEGIN
     REGS.AH:= 7;
     REGS.AL:= LINES;
     REGS.BH:= 7;
     REGS.CH:= 0;
     REGS.CL:= 0;
     REGS.DH:= 24;
     REGS.DL:= 79;
     INTR($10,REGS)
END;

PROCEDURE INITIALIZE;
VAR
   I: INTEGER;
   FIL: FILE;
BEGIN
     CLRSCR;
     LOWVIDEO;
     GOTOXY(1,1);
     WRITE(#186' PROGRAM: ');
     NORMVIDEO;
     WRITE('PL SIMULATOR - RUNS PL CODE FROM THE PARSER ');
     LOWVIDEO;
     GOTOXY(80,1);
     WRITE(#186);
     GOTOXY(1,2);
     WRITE(#186' AUTHOR: ');
     NORMVIDEO;
     WRITE('JAY MONFORT                        ');
     LOWVIDEO;
     WRITE('FOR: ');
     NORMVIDEO;
     WRITE('MATH 434 - COMPILER DESIGN');
     LOWVIDEO;
     GOTOXY(80,2);
     WRITE(#186);
     GOTOXY(1,3);
     WRITE(#186' DATE: ');
     NORMVIDEO;
     WRITE('NOVEMBER 27, 1986');
     LOWVIDEO;
     GOTOXY(80,3);
     WRITE(#186);
     GOTOXY(1,4);
     WRITE(#204);
     FOR I:= 2 TO 79 DO WRITE(#205);
     WRITELN(#185);
     FOR I:= 5 TO 23 DO
       BEGIN
            GOTOXY(1,I);
            WRITE(#186);
            GOTOXY(80,I);
            WRITE(#186)
       END;
     GOTOXY(1,24);
     WRITE(#200);
     FOR I:= 2 TO 79 DO WRITE(#205);
     WRITE(#188);
     SCROLLDOWN(1);
     GOTOXY(1,1);
     WRITE(#201);
     FOR I:= 2 TO 79 DO WRITE(#205);
     WRITE(#187);
     WINDOW(2,6,79,24);
     GOTOXY(1,1);
     IF NOT EXIST('TEMP2')
        THEN OK:= FALSE
        ELSE
          BEGIN
            OK:= TRUE;
            ASSIGN(TEMP2,'TEMP2.');
            RESET(TEMP2)
          END
END;

PROCEDURE FINALIZE;
BEGIN
     WRITELN; WRITELN;
     IF OK
        THEN CLOSE(TEMP2);
     WINDOW(1,1,80,25);
     GOTOXY(1,25);
     CLREOL;
     GOTOXY(1,24);
     NORMVIDEO
END;

BEGIN
     INITIALIZE;
     IF OK
       THEN
         BEGIN
           LOAD_PROGRAM;
           RUN_PROGRAM
         END
       ELSE
           BEGIN
                GOTOXY(20,6);
                WRITE('TEMP2 NOT FOUND'^G^G)
           END;
     FINALIZE
END.