home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Distributions / ucb / spencer_2bsd.tar.gz / 2bsd.tar / src / pi / stat.c < prev    next >
Encoding:
C/C++ Source or Header  |  1980-02-17  |  9.2 KB  |  545 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.0 August 1977
  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.  
  301.     p = NIL;
  302.     goc = gocnt;
  303.     if (r == NIL)
  304.         goto aloha;
  305.     putline();
  306.     /*
  307.      * Start with assignment
  308.      * of initial value to for variable
  309.      */
  310.     t1 = asgnop1(r[2], NIL);
  311.     if (t1 == NIL) {
  312.         rvalue(r[3], NIL);
  313.         statement(r[4]);
  314.         goto aloha;
  315.     }
  316.     rr = r[2];        /* Assignment */
  317.     rr = rr[2];        /* Lhs variable */
  318.     if (rr[3] != NIL) {
  319.         error("For variable must be unqualified");
  320.         rvalue(r[3], NIL);
  321.         statement(r[4]);
  322.         goto aloha;
  323.     }
  324.     p = lookup(rr[2]);
  325.     p->value[NL_FORV] = 1;
  326.     if (isnta(t1, "bcis")) {
  327.         error("For variables cannot be %ss", nameof(t1));
  328.         statement(r[4]);
  329.         goto aloha;
  330.     }
  331.     /*
  332.      * Allocate automatic
  333.      * space for limit variable
  334.      */
  335.     sizes[cbn].om_off =- 4;
  336.     if (sizes[cbn].om_off < sizes[cbn].om_max)
  337.         sizes[cbn].om_max = sizes[cbn].om_off;
  338.     i = sizes[cbn].om_off;
  339.     /*
  340.      * Initialize the limit variable
  341.      */
  342.     put2(O_LV | cbn<<9, i);
  343.     t2 = rvalue(r[3], NIL);
  344.     if (incompat(t2, t1, r[3])) {
  345.         cerror("Limit type clashed with index type in 'for' statement");
  346.         statement(r[4]);
  347.         goto aloha;
  348.     }
  349.     put1(width(t2) <= 2 ? O_AS24 : O_AS4);
  350.     /*
  351.      * See if we can skip the loop altogether
  352.      */
  353.     rr = r[2];
  354.     if (rr != NIL)
  355.         rvalue(rr[2], NIL);
  356.     put2(O_RV4 | cbn<<9, i);
  357.     gen(NIL, r[0] == T_FORU ? T_LE : T_GE, width(t1), 4);
  358.     /*
  359.      * L1 will be patched to skip the body of the loop.
  360.      * L2 marks the top of the loop when we go around.
  361.      */
  362.     put2(O_IF, (l1 = getlab()));
  363.     putlab(l2 = getlab());
  364.     putcnt();
  365.     statement(r[4]);
  366.     /*
  367.      * now we see if we get to go again
  368.      */
  369.     if (opt('t') == 0) {
  370.         /*
  371.          * Easy if we dont have to test
  372.          */
  373.         put2(O_RV4 | cbn<<9, i);
  374.         if (rr != NIL)
  375.             lvalue(rr[2], MOD);
  376.         put2((r[0] == T_FORU ? O_FOR1U : O_FOR1D) + (width(t1) >> 1), l2);
  377.     } else {
  378.         line = r[1];
  379.         putline();
  380.         if (rr != NIL)
  381.             rvalue(rr[2], NIL);
  382.         put2(O_RV4 | cbn << 9, i);
  383.         gen(NIL, (r[0] == T_FORU ? T_LT : T_GT), width(t1), 4);
  384.         l3 = put2(O_IF, getlab());
  385.         lvalue(rr[2], MOD);
  386.         rvalue(rr[2], NIL);
  387.         put2(O_CON2, 1);
  388.         t2 = gen(NIL, r[0] == T_FORU ? T_ADD: T_SUB, width(t1), 2);
  389.         rangechk(t1, t2);    /* The point of all this */
  390.         gen(O_AS2, O_AS2, width(t1), width(t2));
  391.         put2(O_TRA, l2);
  392.         patch(l3);
  393.     }
  394.     sizes[cbn].om_off =+ 4;
  395.     patch(l1);
  396. aloha:
  397.     noreach = 0;
  398.     if (p != NIL)
  399.         p->value[NL_FORV] = 0;
  400.     if (goc != gocnt)
  401.         putcnt();
  402. }
  403.  
  404. /*
  405.  * if expr then stat [ else stat ]
  406.  */
  407. ifop(r)
  408.     int *r;
  409. {
  410.     register struct nl *p;
  411.     register l1, l2;
  412.     int nr, goc;
  413.  
  414.     goc = gocnt;
  415.     if (r == NIL)
  416.         return;
  417.     putline();
  418.     p = rvalue(r[2], NIL);
  419.     if (p == NIL) {
  420.         statement(r[3]);
  421.         noreach = 0;
  422.         statement(r[4]);
  423.         noreach = 0;
  424.         return;
  425.     }
  426.     if (isnta(p, "b")) {
  427.         error("Type of expression in if statement must be Boolean, not %s", nameof(p));
  428.         statement(r[3]);
  429.         noreach = 0;
  430.         statement(r[4]);
  431.         noreach = 0;
  432.         return;
  433.     }
  434.     l1 = put2(O_IF, getlab());
  435.     putcnt();
  436.     statement(r[3]);
  437.     nr = noreach;
  438.     if (r[4] != NIL) {
  439.         /*
  440.          * else stat
  441.          */
  442.         --level;
  443.         ungoto();
  444.         ++level;
  445.         l2 = put2(O_TRA, getlab());
  446.         patch(l1);
  447.         noreach = 0;
  448.         statement(r[4]);
  449.         noreach =& nr;
  450.         l1 = l2;
  451.     } else
  452.         noreach = 0;
  453.     patch(l1);
  454.     if (goc != gocnt)
  455.         putcnt();
  456. }
  457.  
  458. /*
  459.  * while expr do stat
  460.  */
  461. whilop(r)
  462.     int *r;
  463. {
  464.     register struct nl *p;
  465.     register l1, l2;
  466.     int goc;
  467.  
  468.     goc = gocnt;
  469.     if (r == NIL)
  470.         return;
  471.     putlab(l1 = getlab());
  472.     putline();
  473.     p = rvalue(r[2], NIL);
  474.     if (p == NIL) {
  475.         statement(r[3]);
  476.         noreach = 0;
  477.         return;
  478.     }
  479.     if (isnta(p, "b")) {
  480.         error("Type of expression in while statement must be Boolean, not %s", nameof(p));
  481.         statement(r[3]);
  482.         noreach = 0;
  483.         return;
  484.     }
  485.     put2(O_IF, (l2 = getlab()));
  486.     putcnt();
  487.     statement(r[3]);
  488.     put2(O_TRA, l1);
  489.     patch(l2);
  490.     if (goc != gocnt)
  491.         putcnt();
  492. }
  493.  
  494. /*
  495.  * repeat stat* until expr
  496.  */
  497. repop(r)
  498.     int *r;
  499. {
  500.     register struct nl *p;
  501.     register l;
  502.     int goc;
  503.  
  504.     goc = gocnt;
  505.     if (r == NIL)
  506.         return;
  507.     l = putlab(getlab());
  508.     putcnt();
  509.     statlist(r[2]);
  510.     line = r[1];
  511.     p = rvalue(r[3], NIL);
  512.     if (p == NIL)
  513.         return;
  514.     if (isnta(p,"b")) {
  515.         error("Until expression type must be Boolean, not %s, in repeat statement", nameof(p));
  516.         return;
  517.     }
  518.     put2(O_IF, l);
  519.     if (goc != gocnt)
  520.         putcnt();
  521. }
  522.  
  523. /*
  524.  * assert expr
  525.  */
  526. asrtop(r)
  527.     register int *r;
  528. {
  529.     register struct nl *q;
  530.  
  531.     if (opt('s')) {
  532.         standard();
  533.         error("Assert statement is non-standard");
  534.     }
  535.     if (!opt('t'))
  536.         return;
  537.     r = r[2];
  538.     q = rvalue(r, NIL);
  539.     if (q == NIL)
  540.         return;
  541.     if (isnta(q, "b"))
  542.         error("Assert expression must be Boolean, not %ss", nameof(q));
  543.     put1(O_ASRT);
  544. }
  545.