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