home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / PASCAL / COPASC.ZIP / INTERPT.MOD < prev   
Encoding:
Text File  |  1987-09-07  |  13.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.