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 / fdec.c < prev    next >
C/C++ Source or Header  |  1980-02-17  |  9KB  |  447 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. #include "opcode.h"
  13.  
  14. int    cntpatch;
  15. int    nfppatch;
  16. struct    nl *savenl[DSPLYSZ];
  17.  
  18. /*
  19.  * Funchdr inserts
  20.  * declaration of a the
  21.  * prog/proc/func into the
  22.  * namelist. It also handles
  23.  * the arguments and puts out
  24.  * a transfer which defines
  25.  * the entry point of a procedure.
  26.  */
  27.  
  28. funchdr(r)
  29.     int *r;
  30. {
  31.     register struct nl *p;
  32.     register *il, **rl;
  33.     int *rll;
  34.     struct nl *cp, *dp, *sp;
  35.     int o, *pp;
  36.  
  37.     pfcnt++;
  38.     line = r[1];
  39.     if (r[3] == NIL && (p=lookup1(r[2])) != NIL && bn == cbn) {
  40.         /*
  41.          * Symbol already defined
  42.          * in this block. it is either
  43.          * a redeclared symbol (error)
  44.          * or a forward declaration.
  45.          */
  46.         if ((p->class == FUNC || p->class == PROC) && (p->nl_flags & NFORWD) != 0) {
  47.             patch(p->value[NL_PATCH]);
  48.             p->value[NL_PATCH] = getlab();
  49.             put2(monflg ? O_TRACNT : O_TRA, 0);
  50.             putcnt();
  51.             return (p);
  52.         }
  53.     }
  54.     /*
  55.      * Declare the prog/proc/func
  56.      */
  57.     switch (r[0]) {
  58.         case T_PROG:
  59.             if (opt('z'))
  60.                 monflg++;
  61.             program = p = defnl(r[2], PROG, 0, 0);
  62.             p->value[3] = r[1];
  63.             break;
  64.         case T_PDEC:
  65.             p = enter(defnl(r[2], PROC, 0, 0));
  66.             p->nl_flags =| NMOD;
  67.             break;
  68.         case T_FDEC:
  69.             il = r[4];
  70.             if (il == NIL)
  71.                 /* nothing */;
  72.             else if (il[0] != T_TYID)
  73.                 il = NIL;
  74.             else
  75.                 il = gtype(il);
  76.             p = enter(defnl(r[2], FUNC, il, NIL));
  77.             p->nl_flags =| NMOD;
  78.             break;
  79.         default:
  80.             panic("funchdr");
  81.         }
  82.     if (r[0] != T_PROG) {
  83.         /*
  84.          * Mark this proc/func as
  85.          * begin forward declared
  86.          */
  87.         p->nl_flags =| NFORWD;
  88.         /*
  89.          * Enter the parameters
  90.          * in the next block for
  91.          * the time being
  92.          */
  93.         if (++cbn >= DSPLYSZ) {
  94.             error("Procedure/function nesting too deep");
  95.             pexit(ERRS);
  96.         }
  97.         /*
  98.          * For functions, the function variable
  99.          */
  100.         if (p->class == FUNC) {
  101.             cp = defnl(r[2], FVAR, p->type, 0);
  102.             cp->chain = p;
  103.             p->value[NL_FVAR] = cp;
  104.         }
  105.         /*
  106.          * Enter the parameters
  107.          * and compute total size
  108.          */
  109.         cp = sp = p;
  110.         o = 0;
  111.         for (rl = r[3]; rl != NIL; rl = rl[2]) {
  112.             p = NIL;
  113.             if (rl[1] == NIL)
  114.                 continue;
  115.             /*
  116.              * Parametric procedures
  117.              * don't have types 
  118.              */
  119.             if (rl[1][0] != T_PPROC) {
  120.                 rll = rl[1][2];
  121.                 if (rll[0] != T_TYID)
  122.                     p = NIL;
  123.                 else
  124.                     p = gtype(rll);
  125.             }
  126.             for (il = rl[1][1]; il != NIL; il = il[2]) {
  127.                 switch (rl[1][0]) {
  128.                     default:
  129.                         panic("funchdr2");
  130.                     case T_PVAL:
  131.                         dp = defnl(il[1], VAR, p, o=- even(width(p)));
  132.                         dp->nl_flags =| NMOD;
  133.                         break;
  134.                     case T_PVAR:
  135.                         dp = defnl(il[1], REF, p, o=- 2);
  136.                         break;
  137.                     case T_PFUNC:
  138.                     case T_PPROC:
  139.                         continue;
  140.                     }
  141.                 if (dp != NIL) {
  142.                     cp->chain = dp;
  143.                     cp = dp;
  144.                 }
  145.             }
  146.         }
  147.         cbn--;
  148.         p = sp;
  149.         p->value[NL_OFFS] = -o+DPOFF2;
  150.         /*
  151.          * Correct the naievity
  152.          * of our above code to
  153.          * calculate offsets
  154.          */
  155.         for (il = p->chain; il != NIL; il = il->chain)
  156.             il->value[NL_OFFS] =+ p->value[NL_OFFS];
  157.     } else { 
  158.         /*
  159.          * The wonderful
  160.          * program statement!
  161.          */
  162.         if (monflg) {
  163.             cntpatch = put2(O_PXPBUF, 0);
  164.             nfppatch = put3(NIL, 0, 0);
  165.         }
  166.         cp = p;
  167.         for (rl = r[3]; rl; rl = rl[2]) {
  168.             if (rl[1] == NIL)
  169.                 continue;
  170.             dp = defnl(rl[1], VAR, 0, 0);
  171.             cp->chain = dp;
  172.             cp = dp;
  173.         }
  174.     }
  175.     /*
  176.      * Define a branch at
  177.      * the "entry point" of
  178.      * the prog/proc/func.
  179.      */
  180.     p->value[NL_PATCH] = p->value[NL_LOC] = getlab();
  181.     if (monflg) {
  182.         put2(O_TRACNT, 0);
  183.         putcnt();
  184.     } else
  185.         put2(O_TRA, 0);
  186.     return (p);
  187. }
  188.  
  189. /*
  190.  * Funcbody is called
  191.  * when the actual (resolved)
  192.  * declaration of a procedure is
  193.  * encountered. It puts the names
  194.  * of the (function) and parameters
  195.  * into the symbol table.
  196.  */
  197. funcbody(fp)
  198.     struct nl *fp;
  199. {
  200.     register struct nl *q, *p;
  201.  
  202.     cbn++;
  203.     if (cbn >= DSPLYSZ) {
  204.         error("Too many levels of function/procedure nesting");
  205.         pexit(ERRS);
  206.     }
  207.     sizes[cbn].om_off = 0;
  208.     sizes[cbn].om_max = 0;
  209.     gotos[cbn] = NIL;
  210.     if (fp == NIL)
  211.         return (NIL);
  212.     /*
  213.      * Save the virtual name
  214.      * list stack pointer so
  215.      * the space can be freed
  216.      * later (funcend).
  217.      */
  218.     savenl[cbn] = nlp;
  219.     if (fp->class != PROG)
  220.         for (q = fp->chain; q != NIL; q = q->chain)
  221.             enter(q);
  222.     if (fp->class == FUNC) {
  223.         /*
  224.          * For functions, enter the fvar
  225.          */
  226.         enter(fp->value[NL_FVAR]);
  227.     }
  228.     return (fp);
  229. }
  230.  
  231. struct    nl *Fp;
  232. int    pnumcnt;
  233. /*
  234.  * Funcend is called to
  235.  * finish a block by generating
  236.  * the code for the statements.
  237.  * It then looks for unresolved declarations
  238.  * of labels, procedures and functions,
  239.  * and cleans up the name list.
  240.  * For the program, it checks the
  241.  * semantics of the program
  242.  * statement (yuchh).
  243.  */
  244. funcend(fp, bundle, endline, chkref)
  245.     struct nl *fp;
  246.     int *bundle, endline, chkref;
  247. {
  248.     register struct nl *p;
  249.     register int i, b;
  250.     int var, inp, out, *blk;
  251.     struct nl *iop;
  252.     extern int cntstat;
  253.  
  254.     cntstat = 0;
  255.     if (program != NIL)
  256.         line = program->value[3];
  257.     blk = bundle[2];
  258.     if (fp == NIL) {
  259.         cbn--;
  260.         return;
  261.     }
  262.     /*
  263.      * Patch the branch to the
  264.      * entry point of the function
  265.      */
  266.     patch(fp->value[NL_PATCH]);
  267.     /*
  268.      * Put out the block entrance code and the block name.
  269.      * the CONG is overlaid by a patch later!
  270.      */
  271.     var = put1(cbn == 1 && opt('p') == 0 ? O_NODUMP: O_BEG);
  272.     put3(O_CONG, 8, fp->symbol);
  273.     put2(NIL, bundle[1]);
  274.     if (fp->class == PROG) {
  275.         /*
  276.          * The glorious buffers option.
  277.          *          0 = don't buffer output
  278.          *          1 = line buffer output
  279.          *          2 = 512 byte buffer output
  280.          */
  281.         if (opt('b') != 1)
  282.             put1(O_BUFF | opt('b') << 8);
  283.         inp = 0;
  284.         out = 0;
  285.         for (p = fp->chain; p != NIL; p = p->chain) {
  286.             if (strcmp(p->symbol, "input") == 0) {
  287.                 inp++;
  288.                 continue;
  289.             }
  290.             if (strcmp(p->symbol, "output") == 0) {
  291.                 out++;
  292.                 continue;
  293.             }
  294.             iop = lookup1(p->symbol);
  295.             if (iop == NIL || bn != cbn) {
  296.                 error("File %s listed in program statement but not declared", p->symbol);
  297.                 continue;
  298.             }
  299.             if (iop->class != VAR) {
  300.                 error("File %s listed in program statement but declared as a %s", p->symbol, classes[iop->class]);
  301.                 continue;
  302.             }
  303.             if (iop->type == NIL)
  304.                 continue;
  305.             if (iop->type->class != FILE) {
  306.                 error("File %s listed in program statement but defined as %s",
  307.                     p->symbol, nameof(iop->type));
  308.                 continue;
  309.             }
  310.             put2(O_LV | bn << 9, iop->value[NL_OFFS]);
  311.             b = p->symbol;
  312.             while (b->pchar != '\0')
  313.                 b++;
  314.             i = b - p->symbol;
  315.             put3(O_CONG, i, p->symbol);
  316.             put2(O_DEFNAME | i << 8, text(iop->type) ? 0: width(iop->type->type));
  317.         }
  318.         if (out == 0 && fp->chain != NIL) {
  319.             recovered();
  320.             error("The file output must appear in the program statement file list");
  321.         }
  322.     }
  323.     /*
  324.      * Process the prog/proc/func body
  325.      */
  326.     noreach = 0;
  327.     line = bundle[1];
  328.     statlist(blk);
  329.     if (cbn== 1 && monflg != 0) {
  330.         patchfil(cntpatch, cnts);
  331.         patchfil(nfppatch, pfcnt);
  332.     }
  333.     if (fp->class == PROG && inp == 0 && (input->nl_flags & (NUSED|NMOD)) != 0) {
  334.         recovered();
  335.         error("Input is used but not defined in the program statement");
  336.     }
  337.     /*
  338.      * Clean up the symbol table displays and check for unresolves
  339.      */
  340.     line = endline;
  341.     b = cbn;
  342.     Fp = fp;
  343.     chkref =& opt('w') == 0;
  344.     for (i = 0; i <= 077; i++) {
  345.         for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) {
  346.             /*
  347.              * Check for variables defined
  348.              * but not referenced 
  349.              */
  350.             if (chkref && p->symbol != NIL)
  351.             switch (p->class) {
  352.                 case FIELD:
  353.                     /*
  354.                      * If the corresponding record is
  355.                      * unused, we shouldn't complain about
  356.                      * the fields.
  357.                      */
  358.                 default:
  359.                     if ((p->nl_flags & (NUSED|NMOD)) == 0) {
  360.                         warning();
  361.                         nerror("%s %s is neither used nor set", classes[p->class], p->symbol);
  362.                         break;
  363.                     }
  364.                     /*
  365.                      * If a var parameter is either
  366.                      * modified or used that is enough.
  367.                      */
  368.                     if (p->class == REF)
  369.                         continue;
  370.                     if ((p->nl_flags & NUSED) == 0) {
  371.                         warning();
  372.                         nerror("%s %s is never used", classes[p->class], p->symbol);
  373.                         break;
  374.                     }
  375.                     if ((p->nl_flags & NMOD) == 0) {
  376.                         warning();
  377.                         nerror("%s %s is used but never set", classes[p->class], p->symbol);
  378.                         break;
  379.                     }
  380.                 case LABEL:
  381.                 case FVAR:
  382.                 case BADUSE:
  383.                     break;
  384.             }
  385.             switch (p->class) {
  386.                 case FUNC:
  387.                 case PROC:
  388.                     if (p->nl_flags & NFORWD)
  389.                         nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol);
  390.                     break;
  391.  
  392.                 case LABEL:
  393.                     if (p->nl_flags & NFORWD)
  394.                         nerror("label %s was declared but not defined", p->symbol);
  395.                     break;
  396.                 case FVAR:
  397.                     if ((p->nl_flags & NMOD) == 0)
  398.                         nerror("No assignment to the function variable");
  399.                     break;
  400.             }
  401.         }
  402.         /*
  403.          * Pop this symbol
  404.          * table slot
  405.          */
  406.         disptab[i] = p;
  407.     }
  408.     put1(O_END);
  409. #ifdef DEBUG
  410.     dumpnl(savenl[cbn], fp->symbol);
  411. #endif
  412.     /*
  413.      * Restore the
  414.      * (virtual) name list
  415.      * position
  416.      */
  417.     nlfree(savenl[cbn]);
  418.     /*
  419.      * Proc/func has been
  420.      * resolved
  421.      */
  422.     fp->nl_flags =& ~NFORWD;
  423.     /*
  424.      * Patch the beg
  425.      * of the proc/func to
  426.      * the proper variable size
  427.      */
  428.     i = sizes[cbn].om_max;
  429.     if (sizes[cbn].om_max < -50000.)
  430.         nerror("Storage requirement of %ld bytes exceeds hardware capacity", -sizes[cbn].om_max);
  431.     elineon();
  432.     patchfil(var, i);
  433.     cbn--;
  434. }
  435.  
  436. nerror(a1, a2, a3)
  437. {
  438.  
  439.     if (Fp != NIL) {
  440.         yysetfile(filename);
  441.         printf("In %s %s:\n", classes[Fp->class], Fp->symbol);
  442.         Fp = NIL;
  443.         elineoff();
  444.     }
  445.     error(a1, a2, a3);
  446. }
  447.