home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Distributions / ucb / spencer_2bsd.tar.gz / 2bsd.tar / src / pi1 / stat.c < prev    next >
C/C++ Source or Header  |  1980-02-17  |  10KB  |  577 lines
  1. /* Copyright (c) 1979 Regents of the University of California */
  2. #
  3. /*
  4.  * pi - Pascal interpreter code translator
  5.  *
  6.  * Charles Haley, Bill Joy UCB
  7.  * Version 1.2 January 1979
  8.  */
  9.  
  10. #include "0.h"
  11. #include "tree.h"
  12.  
  13. int cntstat;
  14. int cnts 2;
  15. #include "opcode.h"
  16.  
  17. /*
  18.  * Statement list
  19.  */
  20. statlist(r)
  21.     int *r;
  22. {
  23.     register *sl;
  24.  
  25.     for (sl=r; sl != NIL; sl=sl[2])
  26.         statement(sl[1]);
  27. }
  28.  
  29. /*
  30.  * Statement
  31.  */
  32. statement(r)
  33.     int *r;
  34. {
  35.     register *s;
  36.     register struct nl *snlp;
  37.  
  38.     s = r;
  39.     snlp = nlp;
  40. top:
  41.     if (cntstat) {
  42.         cntstat = 0;
  43.         putcnt();
  44.     }
  45.     if (s == NIL)
  46.         return;
  47.     line = s[1];
  48.     if (s[0] == T_LABEL) {
  49.         labeled(s[2]);
  50.         s = s[3];
  51.         noreach = 0;
  52.         cntstat = 1;
  53.         goto top;
  54.     }
  55.     if (noreach) {
  56.         noreach = 0;
  57.         warning();
  58.         error("Unreachable statement");
  59.     }
  60.     switch (s[0]) {
  61.         case T_PCALL:
  62.             putline();
  63.             proc(s);
  64.             break;
  65.         case T_ASGN:
  66.             putline();
  67.             asgnop(s);
  68.             break;
  69.         case T_GOTO:
  70.             putline();
  71.             gotoop(s[2]);
  72.             noreach = 1;
  73.             cntstat = 1;
  74.             break;
  75.         default:
  76.             level++;
  77.             switch (s[0]) {
  78.                 default:
  79.                     panic("stat");
  80.                 case T_IF:
  81.                 case T_IFEL:
  82.                     ifop(s);
  83.                     break;
  84.                 case T_WHILE:
  85.                     whilop(s);
  86.                     noreach = 0;
  87.                     break;
  88.                 case T_REPEAT:
  89.                     repop(s);
  90.                     break;
  91.                 case T_FORU:
  92.                 case T_FORD:
  93.                     forop(s);
  94.                     noreach = 0;
  95.                     break;
  96.                 case T_BLOCK:
  97.                     statlist(s[2]);
  98.                     break;
  99.                 case T_CASE:
  100.                     putline();
  101.                     caseop(s);
  102.                     break;
  103.                 case T_WITH:
  104.                     withop(s);
  105.                     break;
  106.                 case T_ASRT:
  107.                     putline();
  108.                     asrtop(s);
  109.                     break;
  110.             }
  111.             --level;
  112.             if (gotos[cbn])
  113.                 ungoto();
  114.             break;
  115.     }
  116.     /*
  117.      * Free the temporary name list entries defined in
  118.      * expressions, e.g. STRs, and WITHPTRs from withs.
  119.      */
  120.     nlfree(snlp);
  121. }
  122.  
  123. ungoto()
  124. {
  125.     register struct nl *p;
  126.  
  127.     for (p = gotos[cbn]; p != NIL; p = p->chain)
  128.         if ((p->nl_flags & NFORWD) != 0) {
  129.             if (p->value[NL_GOLEV] != NOTYET)
  130.                 if (p->value[NL_GOLEV] > level)
  131.                     p->value[NL_GOLEV] = level;
  132.         } else
  133.             if (p->value[NL_GOLEV] != DEAD)
  134.                 if (p->value[NL_GOLEV] > level)
  135.                     p->value[NL_GOLEV] = DEAD;
  136. }
  137.  
  138. putcnt()
  139. {
  140.  
  141.     if (monflg == 0)
  142.         return;
  143.     cnts++;
  144.     put2(O_COUNT, cnts);
  145. }
  146.  
  147. putline()
  148. {
  149.  
  150.     if (opt('p') != 0)
  151.         put2(O_LINO, line);
  152. }
  153.  
  154. /*
  155.  * With varlist do stat
  156.  *
  157.  * With statement requires an extra word
  158.  * in automatic storage for each level of withing.
  159.  * These indirect pointers are initialized here, and
  160.  * the scoping effect of the with statement occurs
  161.  * because lookup examines the field names of the records
  162.  * associated with the WITHPTRs on the withlist.
  163.  */
  164. withop(s)
  165.     int *s;
  166. {
  167.     register *p;
  168.     register struct nl *r;
  169.     int i;
  170.     int *swl;
  171.     long soffset;
  172.  
  173.     putline();
  174.     swl = withlist;
  175.     soffset = sizes[cbn].om_off;
  176.     for (p = s[2]; p != NIL; p = p[2]) {
  177.         sizes[cbn].om_off =- 2;
  178.         put2(O_LV | cbn <<9, i = sizes[cbn].om_off);
  179.         r = lvalue(p[1], MOD);
  180.         if (r == NIL)
  181.             continue;
  182.         if (r->class != RECORD) {
  183.             error("Variable in with statement refers to %s, not to a record", nameof(r));
  184.             continue;
  185.         }
  186.         r = defnl(0, WITHPTR, r, i);
  187.         r->nl_next = withlist;
  188.         withlist = r;
  189.         put1(O_AS2);
  190.     }
  191.     if (sizes[cbn].om_off < sizes[cbn].om_max)
  192.         sizes[cbn].om_max = sizes[cbn].om_off;
  193.     statement(s[3]);
  194.     sizes[cbn].om_off = soffset;
  195.     withlist = swl;
  196. }
  197.  
  198. extern    flagwas;
  199. /*
  200.  * var := expr
  201.  */
  202. asgnop(r)
  203.     int *r;
  204. {
  205.     register struct nl *p;
  206.     register *av;
  207.  
  208.     if (r == NIL)
  209.         return (NIL);
  210.     /*
  211.      * Asgnop's only function is
  212.      * to handle function variable
  213.      * assignments.  All other assignment
  214.      * stuff is handled by asgnop1.
  215.      */
  216.     av = r[2];
  217.     if (av != NIL && av[0] == T_VAR && av[3] == NIL) {
  218.         p = lookup1(av[2]);
  219.         if (p != NIL)
  220.             p->nl_flags = flagwas;
  221.         if (p != NIL && p->class == FVAR) {
  222.             /*
  223.              * Give asgnop1 the func
  224.              * which is the chain of
  225.              * the FVAR.
  226.              */
  227.             p->nl_flags =| NUSED|NMOD;
  228.             p = p->chain;
  229.             if (p == NIL) {
  230.                 rvalue(r[3], NIL);
  231.                 return;
  232.             }
  233.             put2(O_LV | bn << 9, p->value[NL_OFFS]);
  234.             if (isa(p->type, "i") && width(p->type) == 1)
  235.                 asgnop1(r, nl+T2INT);
  236.             else
  237.                 asgnop1(r, p->type);
  238.             return;
  239.         }
  240.     }
  241.     asgnop1(r, NIL);
  242. }
  243.  
  244. /*
  245.  * Asgnop1 handles all assignments.
  246.  * If p is not nil then we are assigning
  247.  * to a function variable, otherwise
  248.  * we look the variable up ourselves.
  249.  */
  250. asgnop1(r, p)
  251.     int *r;
  252.     register struct nl *p;
  253. {
  254.     register struct nl *p1;
  255.  
  256.     if (r == NIL)
  257.         return (NIL);
  258.     if (p == NIL) {
  259.         p = lvalue(r[2], MOD|ASGN|NOUSE);
  260.         if (p == NIL) {
  261.             rvalue(r[3], NIL);
  262.             return (NIL);
  263.         }
  264.     }
  265.     p1 = rvalue(r[3], p);
  266.     if (p1 == NIL)
  267.         return (NIL);
  268.     if (incompat(p1, p, r[3])) {
  269.         cerror("Type of expression clashed with type of variable in assignment");
  270.         return (NIL);
  271.     }
  272.     switch (classify(p)) {
  273.         case TBOOL:
  274.         case TCHAR:
  275.         case TINT:
  276.         case TSCAL:
  277.             rangechk(p, p1);
  278.         case TDOUBLE:
  279.         case TPTR:
  280.             gen(O_AS2, O_AS2, width(p), width(p1));
  281.             break;
  282.         default:
  283.             put2(O_AS, width(p));
  284.     }
  285.     return (p);    /* Used by for statement */
  286. }
  287.  
  288. /*
  289.  * for var := expr [down]to expr do stat
  290.  */
  291. forop(r)
  292.     int *r;
  293. {
  294.     register struct nl *t1, *t2;
  295.     int l1, l2, l3;
  296.     long soffset;
  297.     register op;
  298.     struct nl *p;
  299.     int *rr, goc, i;
  300. #ifdef DEBUG
  301.     int limitrv = (hp21mx ? O_RV2 : O_RV4) | cbn << 9;
  302.     int limitsz = (hp21mx ? 2 : 4);
  303. #endif
  304.  
  305.     p = NIL;
  306.     goc = gocnt;
  307.     if (r == NIL)
  308.         goto aloha;
  309.     putline();
  310.     /*
  311.      * Allocate automatic
  312.      * space for limit variable
  313.      */
  314. #ifndef DEBUG
  315.     sizes[cbn].om_off =- 4;
  316. #else
  317.     sizes[cbn].om_off =- limitsz;
  318. #endif
  319.     if (sizes[cbn].om_off < sizes[cbn].om_max)
  320.         sizes[cbn].om_max = sizes[cbn].om_off;
  321.     i = sizes[cbn].om_off;
  322.     /*
  323.      * Initialize the limit variable
  324.      */
  325.     put2(O_LV | cbn<<9, i);
  326.     t2 = rvalue(r[3], NIL);
  327. #ifndef DEBUG
  328.     put1(width(t2) <= 2 ? O_AS24 : O_AS4);
  329. #else
  330.     if (hp21mx)
  331.         put1(O_AS2);
  332.     else
  333.         put1(width(t2) <= 2 ? O_AS24 : O_AS4);
  334. #endif
  335.     /*
  336.      * Assignment of initial value to for variable
  337.      */
  338.     t1 = asgnop1(r[2], NIL);
  339.     if (t1 == NIL) {
  340.         rvalue(r[3], NIL);
  341.         statement(r[4]);
  342.         goto aloha;
  343.     }
  344.     rr = r[2];        /* Assignment */
  345.     rr = rr[2];        /* Lhs variable */
  346.     if (rr[3] != NIL) {
  347.         error("For variable must be unqualified");
  348.         rvalue(r[3], NIL);
  349.         statement(r[4]);
  350.         goto aloha;
  351.     }
  352.     p = lookup(rr[2]);
  353.     p->value[NL_FORV] = 1;
  354.     if (isnta(t1, "bcis")) {
  355.         error("For variables cannot be %ss", nameof(t1));
  356.         statement(r[4]);
  357.         goto aloha;
  358.     }
  359.     if (incompat(t2, t1, r[3])) {
  360.         cerror("Limit type clashed with index type in 'for' statement");
  361.         statement(r[4]);
  362.         goto aloha;
  363.     }
  364.     /*
  365.      * See if we can skip the loop altogether
  366.      */
  367.     rr = r[2];
  368.     if (rr != NIL)
  369.         rvalue(rr[2], NIL);
  370. #ifndef DEBUG
  371.     put2(O_RV4 | cbn<<9, i);
  372.     gen(NIL, r[0] == T_FORU ? T_LE : T_GE, width(t1), 4);
  373. #else
  374.     put1(limitrv, i);
  375.     gen(NIL, r[0] == T_FORU ? T_LE : T_GE, width(t1), limitsz);
  376. #endif
  377.     /*
  378.      * L1 will be patched to skip the body of the loop.
  379.      * L2 marks the top of the loop when we go around.
  380.      */
  381.     put2(O_IF, (l1 = getlab()));
  382.     putlab(l2 = getlab());
  383.     putcnt();
  384.     statement(r[4]);
  385.     /*
  386.      * now we see if we get to go again
  387.      */
  388.     if (opt('t') == 0) {
  389.         /*
  390.          * Easy if we dont have to test
  391.          */
  392. #ifndef DEBUG
  393.         put2(O_RV4 | cbn<<9, i);
  394. #else
  395.         put2(limitrv, i);
  396. #endif
  397.         if (rr != NIL)
  398.             lvalue(rr[2], MOD);
  399.         put2((r[0] == T_FORU ? O_FOR1U : O_FOR1D) + (width(t1) >> 1), l2);
  400.     } else {
  401.         line = r[1];
  402.         putline();
  403.         if (rr != NIL)
  404.             rvalue(rr[2], NIL);
  405. #ifndef DEBUG
  406.         put2(O_RV4 | cbn << 9, i);
  407.         gen(NIL, (r[0] == T_FORU ? T_LT : T_GT), width(t1), 4);
  408. #else
  409.         put2(limitrv, i);
  410.         gen(NIL, (r[0] == T_FORU ? T_LT : T_GT), width(t1), limitsz);
  411. #endif
  412.         l3 = put2(O_IF, getlab());
  413.         lvalue(rr[2], MOD);
  414.         rvalue(rr[2], NIL);
  415.         put2(O_CON2, 1);
  416.         t2 = gen(NIL, r[0] == T_FORU ? T_ADD: T_SUB, width(t1), 2);
  417.         rangechk(t1, t2);    /* The point of all this */
  418.         gen(O_AS2, O_AS2, width(t1), width(t2));
  419.         put2(O_TRA, l2);
  420.         patch(l3);
  421.     }
  422. #ifdef DEBUG
  423.     sizes[cbn].om_off =+ limitsz;
  424. #else
  425.     sizes[cbn].om_off =+ 4;
  426. #endif
  427.     patch(l1);
  428. aloha:
  429.     noreach = 0;
  430.     if (p != NIL)
  431.         p->value[NL_FORV] = 0;
  432.     if (goc != gocnt)
  433.         putcnt();
  434. }
  435.  
  436. /*
  437.  * if expr then stat [ else stat ]
  438.  */
  439. ifop(r)
  440.     int *r;
  441. {
  442.     register struct nl *p;
  443.     register l1, l2;
  444.     int nr, goc;
  445.  
  446.     goc = gocnt;
  447.     if (r == NIL)
  448.         return;
  449.     putline();
  450.     p = rvalue(r[2], NIL);
  451.     if (p == NIL) {
  452.         statement(r[3]);
  453.         noreach = 0;
  454.         statement(r[4]);
  455.         noreach = 0;
  456.         return;
  457.     }
  458.     if (isnta(p, "b")) {
  459.         error("Type of expression in if statement must be Boolean, not %s", nameof(p));
  460.         statement(r[3]);
  461.         noreach = 0;
  462.         statement(r[4]);
  463.         noreach = 0;
  464.         return;
  465.     }
  466.     l1 = put2(O_IF, getlab());
  467.     putcnt();
  468.     statement(r[3]);
  469.     nr = noreach;
  470.     if (r[4] != NIL) {
  471.         /*
  472.          * else stat
  473.          */
  474.         --level;
  475.         ungoto();
  476.         ++level;
  477.         l2 = put2(O_TRA, getlab());
  478.         patch(l1);
  479.         noreach = 0;
  480.         statement(r[4]);
  481.         noreach =& nr;
  482.         l1 = l2;
  483.     } else
  484.         noreach = 0;
  485.     patch(l1);
  486.     if (goc != gocnt)
  487.         putcnt();
  488. }
  489.  
  490. /*
  491.  * while expr do stat
  492.  */
  493. whilop(r)
  494.     int *r;
  495. {
  496.     register struct nl *p;
  497.     register l1, l2;
  498.     int goc;
  499.  
  500.     goc = gocnt;
  501.     if (r == NIL)
  502.         return;
  503.     putlab(l1 = getlab());
  504.     putline();
  505.     p = rvalue(r[2], NIL);
  506.     if (p == NIL) {
  507.         statement(r[3]);
  508.         noreach = 0;
  509.         return;
  510.     }
  511.     if (isnta(p, "b")) {
  512.         error("Type of expression in while statement must be Boolean, not %s", nameof(p));
  513.         statement(r[3]);
  514.         noreach = 0;
  515.         return;
  516.     }
  517.     put2(O_IF, (l2 = getlab()));
  518.     putcnt();
  519.     statement(r[3]);
  520.     put2(O_TRA, l1);
  521.     patch(l2);
  522.     if (goc != gocnt)
  523.         putcnt();
  524. }
  525.  
  526. /*
  527.  * repeat stat* until expr
  528.  */
  529. repop(r)
  530.     int *r;
  531. {
  532.     register struct nl *p;
  533.     register l;
  534.     int goc;
  535.  
  536.     goc = gocnt;
  537.     if (r == NIL)
  538.         return;
  539.     l = putlab(getlab());
  540.     putcnt();
  541.     statlist(r[2]);
  542.     line = r[1];
  543.     p = rvalue(r[3], NIL);
  544.     if (p == NIL)
  545.         return;
  546.     if (isnta(p,"b")) {
  547.         error("Until expression type must be Boolean, not %s, in repeat statement", nameof(p));
  548.         return;
  549.     }
  550.     put2(O_IF, l);
  551.     if (goc != gocnt)
  552.         putcnt();
  553. }
  554.  
  555. /*
  556.  * assert expr
  557.  */
  558. asrtop(r)
  559.     register int *r;
  560. {
  561.     register struct nl *q;
  562.  
  563.     if (opt('s')) {
  564.         standard();
  565.         error("Assert statement is non-standard");
  566.     }
  567.     if (!opt('t'))
  568.         return;
  569.     r = r[2];
  570.     q = rvalue(r, NIL);
  571.     if (q == NIL)
  572.         return;
  573.     if (isnta(q, "b"))
  574.         error("Assert expression must be Boolean, not %ss", nameof(q));
  575.     put1(O_ASRT);
  576. }
  577.