home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / copascal.arc / INTERPT.MOD < prev   
Encoding:
Text File  |  1986-01-22  |  15.4 KB  |  520 lines
  1. (*
  2.     Interpret the code in P-CODE, also uses the tables TAB & BTAB
  3.     and the variable S to simulate the run time stack.
  4. *)
  5.  
  6. { procedure INTERPRET;  (* global code, tab, btab *) }
  7.  
  8. label 97,98;        (* trap label *)
  9. const STEPMAX = 8;
  10.       TRU   =  1;
  11.       FALS  =  0;
  12.       CHARL =  0;
  13.       CHARH = 63;
  14.  
  15. type PTYPE = 0..PMAX;
  16.  
  17. var  IR: ORDER;      (* instruction buffer *)
  18.      PS: (RUN,FIN,CASCHK,DIVCHK,INXCHK,STKCHK,LINCHK,LNGCHK,REDCHK,DEADLOCK);
  19.      LNCNT, OCNT, BLKCNT, CHRCNT: integer;     (*COUNTERS*)
  20.      H1,H2,H3,H4: integer;
  21.      FLD: array [1..4] of integer;     (* default field widths *)
  22.  
  23.      S: array [ 1..STMAX ] of record
  24.           case DUM : TYPES of        (*   S[B+0] = FCT RESULT  *)
  25.             INTS  : ( I : integer);  (*   S[B+1] = RETURN ADR  *)
  26.             REALS : ( R :    REAL);  (*   S[B+2] = STATIC LINK *)
  27.             BOOLS : ( B : boolean);  (*   S[B+3] = DYNAMIC LINK*)
  28.             CHARS : ( C :    CHAR);  (*   S[B+4] = TABLE INDEX *)
  29.           end;
  30.  
  31.      PTAB: array[PTYPE] of RECORD
  32.              PC : integer;    (*PROGRAM COUNTER*)
  33.              T  : integer;    (*TOP STACK INDEX*)
  34.              B  : integer;    (*BASE INDEX*)
  35.              DISPLAY   : array [1..LMAX] of integer;
  36.              STACKSIZE : integer;
  37.              SUSPEND   : integer;
  38.              ACTIVE    : boolean
  39.            end;
  40.      NPR,
  41.      CURPR:PTYPE;
  42.      STEPCOUNT:integer;
  43.      PFLAG:boolean;
  44.  
  45. procedure CHOOSEPROC;
  46. var D:integer;
  47. begin
  48.   D := PMAX + 1;
  49.   CURPR := (CURPR+TRUNC( RANDOM * PMAX )) MOD ( PMAX+1 );
  50.   while ((NOT PTAB[CURPR].ACTIVE) OR (PTAB[CURPR].SUSPEND<>0)) AND (D >= 0)
  51.    do begin
  52.      D:= D-1;
  53.      CURPR:= (CURPR+1) MOD (PMAX+1)
  54.    end;
  55.   if ( D < 0 ) then PS := DEADLOCK
  56.     else STEPCOUNT := TRUNC( RANDOM * STEPMAX );
  57. end;
  58.  
  59. function ITOB( I : integer ) : boolean;
  60. begin
  61.   if I=TRU then ITOB := TRUE else ITOB := FALSE;
  62. end;
  63.  
  64. function BTOI( B : boolean ) : integer;
  65. begin
  66.   if B then BTOI := TRU else BTOI := FALS;
  67. end;
  68.  
  69. begin { INTERPRET }
  70.   if DFLAG then begin
  71.     writeln(' DFILE : ',DFILE, length(DFILE):10, DFILE[8]:3 );
  72.     assign( DATA, DFILE + '.DAT' );
  73.     reset( DATA );
  74.   end;
  75.   S[1].I :=  0;
  76.   S[2].I :=  0;
  77.   S[3].I := -1;
  78.   S[4].I := BTAB[1].LAST;
  79.   with PTAB[0] do begin
  80.     B := 0;
  81.     SUSPEND:=0;
  82.     DISPLAY[1] := 0;
  83.     T := BTAB[2].VSIZE - 1;
  84.     PC := TAB[S[4].I].ADR;
  85.     ACTIVE := TRUE;
  86.     STACKSIZE := STMAX - PMAX*STKINCR;
  87.   end;
  88.   for CURPR:=1 to PMAX do with PTAB[CURPR] do begin
  89.     ACTIVE := FALSE;
  90.     DISPLAY[1] := 0;
  91.     PC := 0;
  92.     SUSPEND := 0;
  93.     B := PTAB[CURPR-1].STACKSIZE + 1;
  94.     STACKSIZE := B + STKINCR - 1;
  95.     T := B-1;
  96.   end;
  97.   NPR:=0;
  98.   CURPR:=0;
  99.   PFLAG:=FALSE;
  100.   STEPCOUNT:=0;
  101.   RANDOMIZE;  (* initialize TURBO random number generator *)
  102.   PS := RUN;
  103.   LNCNT  :=  0;
  104.   OCNT   :=  0;
  105.   CHRCNT :=  0;
  106.   FLD[1] := 10;
  107.   FLD[2] := 22;
  108.   FLD[3] := 10;
  109.   FLD[4] :=  1;
  110.  
  111.   repeat
  112.     if PTAB[0].ACTIVE then CURPR:=0
  113.       else if STEPCOUNT = 0 then begin
  114.         CHOOSEPROC;
  115.         if PS=DEADLOCK then GOTO 98
  116.       end else STEPCOUNT:=STEPCOUNT - 1;
  117.     with PTAB[CURPR] do begin
  118.       IR := CODE[PC];
  119.       PC := PC+1;
  120.       OCNT := OCNT + 1;
  121.     end;
  122.     if PFLAG then begin
  123.       if IR.F = 18 then NPR:=NPR+1;
  124.       CURPR := NPR;
  125.     end;
  126.     with PTAB[CURPR] do
  127.  
  128.     case IR.F of
  129.  
  130.     0: begin { load address }
  131.          T := T+1;
  132.          if T > STACKSIZE then PS := STKCHK
  133.            else S[T].I := DISPLAY[IR.X] + IR.Y;
  134.        end;
  135.     1: begin { load value   }
  136.        T := T+1;
  137.        if T > STACKSIZE then PS := STKCHK
  138.          else S[T] := S[DISPLAY[IR.X] + IR.Y];
  139.        end;
  140.     2: begin { load indirect }
  141.          T := T+1;
  142.          if T > STACKSIZE then PS := STKCHK
  143.            else S[T] := S[S[DISPLAY[IR.X] + IR.Y].I]
  144.        end;
  145.     3: begin { update display }
  146.          H1 := IR.Y;
  147.          H2 := IR.X;
  148.          H3 := B;
  149.          repeat
  150.            DISPLAY[H1] := H3;
  151.            H1 := H1-1;
  152.            H3 := S[H3+2].I;
  153.          until ( H1 = H2 );
  154.        end;
  155.     4: PFLAG := TRUE;  (* CObegin *)
  156.     5: begin           (* COend   *)
  157.          PFLAG:= FALSE;
  158.          PTAB[0].ACTIVE:=FALSE
  159.        end;
  160.     6: begin     { wait }
  161.          H1 := S[T].I;
  162.          T  := T-1;
  163.          if S[H1].I > 0 then S[H1].I:=S[H1].I - 1
  164.            else begin
  165.              SUSPEND   := H1;
  166.              STEPCOUNT := 0;
  167.            end;
  168.        end;
  169.     7: begin     { signal }
  170.          H1:=S[T].I;
  171.          T:=T-1;
  172.          H2:= PMAX+1;
  173.          H3:= TRUNC( RANDOM*H2 );
  174.          while ( H2 >= 0 ) AND ( PTAB[H3].SUSPEND <> H1 ) do begin
  175.            H3 := (H3+1) MOD (PMAX+1);
  176.            H2 := H2-1;
  177.          end;
  178.          if ( H2 < 0 ) OR ( S[H1].I < 0 )
  179.            then S[H1].I := S[H1].I+1
  180.            else PTAB[H3].SUSPEND := 0;
  181.        end;
  182.     8: case IR.Y OF      { standard procedures }
  183.          0: S[T].I := ABS(S[T].I);
  184.          1: S[T].R := ABS(S[T].R);
  185.          2: S[T].I := SQR(S[T].I);
  186.          3: S[T].R := SQR(S[T].R);
  187.          4: S[T].B := ODD(S[T].I);
  188.          5: begin { S[T].C := CHR(S[T].I); }
  189.               if (S[T].I < 0) OR (S[T].I > 63) then PS := INXCHK
  190.             end;
  191.          6: { S[T].I := ORD(S[T].C) };
  192.          7: S[T].C := SUCC(S[T].C);
  193.          8: S[T].C := PRED(S[T].C);
  194.          9: S[T].I := ROUND(S[T].R);
  195.         10: S[T].I := TRUNC(S[T].R);
  196.         11: S[T].R := SIN(S[T].R);
  197.         12: S[T].R := COS(S[T].R);
  198.         13: S[T].R := EXP(S[T].R);
  199.         14: S[T].R := LN(S[T].R);
  200.         15: S[T].R := SQRT(S[T].R);
  201.         16: S[T].R := ARCTAN(S[T].R);
  202.         17: begin
  203.               T := T+1;
  204.               if T > STACKSIZE then PS := STKCHK else S[T].B := EOF( DATA );
  205.             end;
  206.         18: begin
  207.               T := T+1;
  208.               if T > STACKSIZE then PS := STKCHK else S[T].B := EOLN( DATA );
  209.             end;
  210.         19: S[T].I := RANDOM( S[T].I + 1 );
  211.        end;
  212.     9: S[T].I := S[T].I + IR.Y;   (* offset *)
  213.    10: PC := IR.Y;                (* jump   *)
  214.    11: begin                      (* conditional junp *)
  215.          if NOT S[T].B then PC := IR.Y;
  216.          T := T-1
  217.        end;
  218.    12: begin (* switch *)
  219.          H1 := S[T].I;
  220.          T  := T-1;
  221.          H2 := IR.Y;
  222.          H3 := 0;
  223.          repeat
  224.            if CODE[H2].F <> 13 then begin
  225.              H3 := 1;
  226.              PS := CASCHK;
  227.            end else
  228.            if CODE[H2].Y = H1 then begin
  229.              H3 := 1;
  230.              PC := CODE[H2+1].Y
  231.            end else H2 := H2 + 2;
  232.          until ( H3 <> 0 );
  233.        end;
  234.    14: begin (* for1UP *)
  235.          H1 := S[T-1].I;
  236.          if H1 <= S[T].I then S[S[T-2].I].I := H1
  237.            else begin
  238.              T  := T-3;
  239.              PC := IR.Y;
  240.           end;
  241.         end;
  242.    15: begin (* for2up *)
  243.          H2 := S[T-2].I;
  244.          H1 := S[H2].I + 1;
  245.          if H1 <= S[T].I then begin
  246.            S[H2].I := H1;
  247.            PC := IR.Y
  248.          end else T := T-3;
  249.        end;
  250.    16: begin (* for1down *)
  251.          H1 := S[T-1].I;
  252.          if H1 >= S[T].I then S[S[T-2].I].I := H1
  253.            else begin
  254.              PC := IR.Y;
  255.              T := T-3;
  256.            end;
  257.        end;
  258.    17: begin (* for2down *)
  259.          H2 := S[T-2].I;
  260.          H1 := S[H2].I - 1;
  261.          if H1 >= S[T].I then begin
  262.            S[H2].I := H1;
  263.            PC := IR.Y;
  264.          end else T := T-3;
  265.        end;
  266.    18: begin (* mark stack *)
  267.          H1 := BTAB[TAB[IR.Y].REF].VSIZE;
  268.          if T+H1 > STACKSIZE then PS := STKCHK
  269.            else begin
  270.              T := T+5;
  271.              S[T-1].I := H1-1;
  272.              S[T].I := IR.Y;
  273.            end;
  274.        end;
  275.    19: begin (* call *)
  276.          ACTIVE := TRUE;
  277.          H1 := T - IR.Y;
  278.          H2 := S[H1+4].I;    (* H2 points to TAB *)
  279.          H3 := TAB[H2].LEV;
  280.          DISPLAY[H3+1] := H1;
  281.          H4 := S[H1+3].I + H1;
  282.          S[H1+1].I := PC;
  283.          S[H1+2].I := DISPLAY[H3];
  284.          S[H1+3].I := B;
  285.          if PFLAG then S[H1+3].I:=PTAB[0].B
  286.            else S[H1+3].I:=B;
  287.          for H3 := T+1 to H4 do S[H3].I := 0;
  288.          B := H1;
  289.          T := H4;
  290.          PC := TAB[H2].ADR;
  291.        end;
  292.    20: begin { INDEX1 }
  293.          H1 := IR.Y;     (* H1 points to ATAB *)
  294.          H2 := ATAB[H1].LOW;
  295.          H3 := S[T].I;
  296.          if H3 < H2 then PS := INXCHK
  297.           else if H3 > ATAB[H1].HIGH then PS := INXCHK
  298.             else begin
  299.               T := T-1;
  300.               S[T].I := S[T].I + (H3-H2);
  301.             end;
  302.        end;
  303.    21: begin { INDEX }
  304.          H1 := IR.Y;      (* H1 POINTS TO ATAB *)
  305.          H2 := ATAB[H1].LOW; H3 := S[T].I;
  306.          if H3 < H2 then PS := INXCHK else
  307.          if H3 > ATAB[H1].HIGH then PS := INXCHK
  308.            else begin
  309.              T := T-1;
  310.              S[T].I := S[T].I + (H3-H2)*ATAB[H1].ELSIZE;
  311.            end;
  312.        end;
  313.    22: begin { load block }
  314.          H1 := S[T].I; T := T-1;
  315.          H2 := IR.Y + T; if H2 > STACKSIZE then PS := STKCHK else
  316.          while T < H2 do begin
  317.            T := T+1;
  318.            S[T] := S[H1];
  319.            H1 := H1+1;
  320.          end
  321.        end;
  322.    23: begin { copy block }
  323.          H1 := S[T-1].I;
  324.          H2 := S[T].I; H3 := H1 + IR.Y;
  325.          while H1 < H3 do begin
  326.            S[H1] := S[H2];
  327.            H1 := H1+1;
  328.            H2 := H2+1;
  329.          end;
  330.          T := T-2;
  331.        end;
  332.    24: begin { literal }
  333.          T := T+1;
  334.          if T > STACKSIZE then PS := STKCHK else S[T].I := IR.Y;
  335.        end;
  336.    25: begin { load real }
  337.          T := T+1;
  338.          if T > STACKSIZE then PS := STKCHK else S[T].R := RCONST[IR.Y];
  339.        end;
  340.  26: begin (* FLOAT *)
  341.        H1 := T - IR.Y;
  342.        S[H1].R := S[H1].I;
  343.      end;
  344.  27: begin (* READ *)
  345.        if EOF( DATA ) then PS := REDCHK else
  346.          case IR.Y OF
  347.            1 : READ( S[S[T].I].I );
  348.            2 : READ( S[S[T].I].R );
  349.            3 : begin
  350.                  READ( CH );
  351.                  S[S[T].I].I := ORD( CH );
  352.                end;
  353.            4 : READ(S[S[T].I].C);
  354.          end;
  355.        T := T-1;
  356.      end;
  357.  28: begin (* write STRING *)
  358.        H1 := S[T].I; H2 := IR.Y; T := T-1;
  359.        CHRCNT := CHRCNT+H1; if CHRCNT > LINELENG then PS := LNGCHK;
  360.        repeat
  361.          write(STAB[H2]);
  362.          H1 := H1-1;
  363.          H2 := H2+1
  364.        until H1 = 0;
  365.      end;
  366.  29: begin (* write1 *)
  367.        CHRCNT := CHRCNT + FLD[IR.Y];
  368.        if CHRCNT > LINELENG then PS := LNGCHK else
  369.        case IR.Y OF
  370.         1: write(S[T].I: FLD[1]);
  371.         2: write(S[T].R: FLD[2]);
  372.         3: write(S[T].B: FLD[3]);
  373.         4: write(S[T].C);            (*BURD*)
  374.        end;
  375.        T := T-1
  376.      end;
  377.  30: begin (* write2 *)
  378.        CHRCNT := CHRCNT + S[T].I;
  379.        if CHRCNT > LINELENG then PS := LNGCHK else
  380.        case IR.Y OF
  381.         1: write(S[T-1].I: S[T].I);
  382.         2: write(S[T-1].R: S[T].I);
  383.         3: write(S[T-1].B: S[T].I);
  384.         4: write(S[T].C);            (*BURD*)
  385.        end;
  386.        T := T-2
  387.      end;
  388.  31: PS := FIN;
  389.  32: begin (* EXIT procedure *)      (*BURD*)
  390.        T := B-1;
  391.        PC := S[B+1].I;
  392.        if PC<>0 then B:= S[B+3].I
  393.          else begin
  394.            NPR := NPR-1;
  395.            ACTIVE := FALSE;
  396.            STEPCOUNT:=0;
  397.            PTAB[0].ACTIVE:=(NPR=0)
  398.          end;
  399.      end;
  400.  33: begin (* EXIT function *)
  401.        T := B;
  402.        PC := S[B+1].I;
  403.        B := S[B+3].I;
  404.      end;
  405.  34: S[T] := S[S[T].I];
  406.  35: S[T].B := NOT S[T].B;
  407.  36: S[T].I := - S[T].I;
  408.  37: begin
  409.        CHRCNT := CHRCNT + S[T-1].I;
  410.        if CHRCNT > LINELENG then PS := LNGCHK
  411.          else write(S[T-2].R: S[T-1].I: S[T].I);
  412.        T := T-3;
  413.      end;
  414.  38: begin (*STORE*)
  415.        S[S[T-1].I] := S[T];
  416.        T := T-2;
  417.      end;
  418.  39..61 : begin
  419.             T := T-1;
  420.             case IR.F of
  421.  
  422.              39 : S[T].B := ( S[T].R =  S[T+1].R );
  423.              40 : S[T].B := ( S[T].R <> S[T+1].R );
  424.              41 : S[T].B := ( S[T].R <  S[T+1].R );
  425.              42 : S[T].B := ( S[T].R <= S[T+1].R );
  426.              43 : S[T].B := ( S[T].R >  S[T+1].R );
  427.              44 : S[T].B := ( S[T].R >= S[T+1].R );
  428.              45 : S[T].B := ( S[T].I =  S[T+1].I );
  429.              46 : S[T].B := ( S[T].I <> S[T+1].I );
  430.              47 : S[T].B := ( S[T].I <  S[T+1].I );
  431.              48 : S[T].B := ( S[T].I <= S[T+1].I );
  432.              49 : S[T].B := ( S[T].I >  S[T+1].I );
  433.              50 : S[T].B := ( S[T].I >= S[T+1].I );
  434.              51 : S[T].B := ( S[T].B OR S[T+1].B );
  435.              52 : S[T].I := S[T].I + S[T+1].I;
  436.              53 : S[T].I := S[T].I - S[T+1].I;
  437.              54 : S[T].R := S[T].R + S[T+1].R;
  438.              55 : S[T].R := S[T].R - S[T+1].R;
  439.              56 : S[T].B := ( S[T].B AND S[T+1].B );
  440.              57 : S[T].I := S[T].I * S[T+1].I;
  441.              58 : if S[T+1].I = 0 then PS := DIVCHK
  442.                     else S[T].I := S[T].I DIV S[T+1].I;
  443.              59 : if S[T+1].I = 0 then PS := DIVCHK
  444.                     else S[T].I := S[T].I MOD S[T+1].I;
  445.              60 : S[T].R := S[T].R * S[T+1].R;
  446.              61 : S[T].R := S[T].R / S[T+1].R;
  447.           end;  { case }
  448.         end;  { begin }
  449.  
  450. 62: if EOF( DATA ) then PS := REDCHK else READLN;
  451.  63: begin
  452.        writeln;
  453.        LNCNT := LNCNT + 1;
  454.        CHRCNT := 0;
  455.        if LNCNT > LINELIMIT then PS := LINCHK;
  456.      end
  457.    end (*case*) ;
  458.  until PS <> RUN;
  459.  
  460. 98: if PS <> FIN then begin (* fatal error in user's program *)
  461.       writeln;
  462.       with PTAB[CURPR]
  463.         do write(' HALT at',PC:5,'in process',CURPR:4,' because of ');
  464.       case PS OF
  465.         DEADLOCK: writeln( 'DEADLOCK'             );
  466.         RUN     : writeln( 'ERROR (SEE DAYFILE)'  );
  467.         CASCHK  : writeln( 'UNDEFINED CASE'       );
  468.         DIVCHK  : writeln( 'DIVIDE BY 0'          );
  469.         INXCHK  : writeln( 'INVALID INDEX'        );
  470.         STKCHK  : writeln( 'STORAGE OVERFLOW'     );
  471.         LINCHK  : writeln( 'TOO MUCH OUTPUT'      );
  472.         LNGCHK  : writeln( 'LINE TOO LONG'        );
  473.         REDCHK  : writeln( 'READ PAST END OF FILE');
  474.       end;
  475.       writeln('0PROCESS  ACTIVE  SUSPEND PC');
  476.       for H1:=0 to PMAX do with PTAB[H1] do
  477.         writeln('0',H1:4,'      ',ACTIVE,SUSPend:5,PC:8);
  478.       writeln('0GLOBAL VARIABLES');
  479.       for H1:= BTAB[1].LAST+1 to TMAX do
  480.         with TAB[H1] do if LEV<>1 then GOTO 97
  481.           else if OBJ=VARIABLE then if TYP IN STANTYPS then
  482.         case TYP OF
  483.           INTS  : writeln( NAME, ' = ', S[ADR].I );
  484.           BOOLS : writeln( NAME, ' = ', S[ADR].B );
  485.           CHARS : writeln( NAME, ' = ', CHR( S[ADR].I MOD 64 ));
  486.           REALS : writeln( NAME, ' = ', S[ADR].R );
  487.         end;
  488.   97: writeln;
  489. H1 := B;        (* post mortem dump *)
  490. BLKCNT := 10;
  491.     repeat
  492.       writeln;
  493.       BLKCNT := BLKCNT - 1;
  494.       if BLKCNT = 0 then H1 := 0; H2 := S[H1+4].I;
  495.       if H1<>0 then
  496.         writeln(' ', TAB[H2].NAME, ' CALLED AT', S[H1+1].I: 5);
  497.       H2 := BTAB[ TAB[H2].REF ].LAST;
  498.       while H2 <> 0 do
  499.       with TAB[H2] do begin
  500.         if OBJ = VARIABLE then
  501.           if TYP IN STANTYPS then begin
  502.             write('    ', NAME, ' = ');
  503.             if NORMAL then H3 := H1+ADR else H3 := S[H1+ADR].I;
  504.             case TYP OF
  505.               INTS:  writeln(S[H3].I);
  506.               REALS: writeln(S[H3].R);
  507.               BOOLS: writeln(S[H3].B);
  508.               CHARS: writeln(CHR(S[H3].I MOD 64));
  509.             end;
  510.           end;
  511.           H2 := LINK;
  512.       end;
  513.       H1 := S[H1+3].I;
  514.     until ( H1 < 0 );
  515.   end;
  516.   if DEBUG then begin
  517.     writeln;
  518.     writeln( OCNT, ' STEPS' );
  519.   end;
  520.