home *** CD-ROM | disk | FTP | other *** search
/ minnie.tuhs.org / unixen.tar / unixen / PDP-11 / Distributions / ucb / spencer_2bsd.tar.gz / 2bsd.tar / src / pi0 / fdec.c < prev    next >
C/C++ Source or Header  |  1980-02-17  |  6KB  |  329 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. /*
  14.  * Funchdr inserts
  15.  * declaration of a the
  16.  * prog/proc/func into the
  17.  * namelist. It also handles
  18.  * the arguments and puts out
  19.  * a transfer which defines
  20.  * the entry point of a procedure.
  21.  */
  22.  
  23. funchdr(r)
  24.     int *r;
  25. {
  26.     register struct nl *p;
  27.     register *il, **rl;
  28.     int *rll, o;
  29.     struct nl *cp, *dp, *sp;
  30.     int *pp;
  31.  
  32.     send(REVFHDR, r);
  33.     if (inpflist(r[2])) {
  34.         opush('l');
  35.         yyretrieve();    /* kludge */
  36.     }
  37.     line = r[1];
  38.     if (r[3] == NIL && (p=lookup1(r[2])) != NIL && bn == cbn) {
  39.         /*
  40.          * Symbol already defined
  41.          * in this block. it is either
  42.          * a redeclared symbol (error)
  43.          * or a forward declaration.
  44.          */
  45.         if ((p->class == FUNC || p->class == PROC) && (p->nl_flags & NFORWD) != 0) {
  46.             /*
  47.              * Grammar doesnt forbid
  48.              * types on a resolution
  49.              * of a forward function
  50.              * declaration.
  51.              */
  52.             if (p->class == FUNC && r[4])
  53.                 error("Function type should be given only in forward declaration");
  54.             return (p);
  55.         }
  56.     }
  57.     /*
  58.      * Declare the prog/proc/func
  59.      */
  60.     switch (r[0]) {
  61.         case T_PROG:
  62.             program = p = defnl(r[2], PROG, 0, 0);
  63.             break;
  64.         case T_PDEC:
  65.             if (r[4] != NIL)
  66.                 error("Procedures do not have types, only functions do");
  67.             p = enter(defnl(r[2], PROC, 0, 0));
  68.             break;
  69.         case T_FDEC:
  70.             il = r[4];
  71.             if (il == NIL)
  72.                 error("Function type must be specified");
  73.             else if (il[0] != T_TYID) {
  74.                 il = NIL;
  75.                 error("Function type can be specified only by using a type identifier");
  76.             } else
  77.                 il = gtype(il);
  78.             p = enter(defnl(r[2], FUNC, il, NIL));
  79.             /*
  80.              * An arbitrary restriction
  81.              */
  82.             switch (o = classify(p->type)) {
  83.                 case TFILE:
  84.                 case TARY:
  85.                 case TREC:
  86.                 case TSET:
  87.                 case TSTR:
  88.                     warning();
  89.                     if (opt('s'))
  90.                         standard();
  91.                     error("Functions should not return %ss", clnames[o]);
  92.             }
  93.             break;
  94.         default:
  95.             panic("funchdr");
  96.         }
  97.     if (r[0] != T_PROG) {
  98.         /*
  99.          * Mark this proc/func as
  100.          * begin forward declared
  101.          */
  102.         p->nl_flags =| NFORWD;
  103.         /*
  104.          * Enter the parameters
  105.          * in the next block for
  106.          * the time being
  107.          */
  108.         if (++cbn >= DSPLYSZ) {
  109.             error("Procedure/function nesting too deep");
  110.             pexit(ERRS);
  111.         }
  112.         /*
  113.          * For functions, the function variable
  114.          */
  115.         if (p->class == FUNC) {
  116.             cp = defnl(r[2], FVAR, p->type, 0);
  117.             cp->chain = p;
  118.             p->value[NL_FVAR] = cp;
  119.         }
  120.         /*
  121.          * Enter the parameters
  122.          */
  123.         cp = sp = p;
  124.         for (rl = r[3]; rl != NIL; rl = rl[2]) {
  125.             p = NIL;
  126.             if (rl[1] == NIL)
  127.                 continue;
  128.             /*
  129.              * Parametric procedures
  130.              * don't have types
  131.              */
  132.             if (rl[1][0] != T_PPROC) {
  133.                 rll = rl[1][2];
  134.                 if (rll[0] != T_TYID) {
  135.                     error("Types for arguments can be specified only by using type identifiers");
  136.                     p = NIL;
  137.                 } else
  138.                     p = gtype(rll);
  139.             }
  140.             for (il = rl[1][1]; il != NIL; il = il[2]) {
  141.                 switch (rl[1][0]) {
  142.                     default:
  143.                         panic("funchdr2");
  144.                     case T_PVAL:
  145.                         if (p != NIL) {
  146.                             if (p->class == FILE)
  147.                                 error("Files cannot be passed by value");
  148.                             else if (p->nl_flags & NFILES)
  149.                                 error("Files cannot be a component of %ss passed by value",
  150.                                     nameof(p));
  151.                         }
  152.                         dp = defnl(il[1], VAR, p, 0);
  153.                         break;
  154.                     case T_PVAR:
  155.                         dp = defnl(il[1], REF, p, 0);
  156.                         break;
  157.                     case T_PFUNC:
  158.                     case T_PPROC:
  159.                         error("Procedure/function parameters not implemented");
  160.                         continue;
  161.                     }
  162.                 if (dp != NIL) {
  163.                     cp->chain = dp;
  164.                     cp = dp;
  165.                 }
  166.             }
  167.         }
  168.         cbn--;
  169.         p = sp;
  170.     } else { 
  171.         cp = p;
  172.         for (rl = r[3]; rl; rl = rl[2]) {
  173.             if (rl[1] == NIL)
  174.                 continue;
  175.             dp = defnl(rl[1], VAR, 0, 0);
  176.             cp->chain = dp;
  177.             cp = dp;
  178.         }
  179.     }
  180.     return (p);
  181. }
  182.  
  183. /*
  184.  * Funcbody is called
  185.  * when the actual (resolved)
  186.  * declaration of a procedure is
  187.  * encountered. It puts the names
  188.  * of the (function) and parameters
  189.  * into the symbol table.
  190.  */
  191. funcbody(fp)
  192.     struct nl *fp;
  193. {
  194.     register struct nl *q, *p;
  195.  
  196.     cbn++;
  197.     if (cbn >= DSPLYSZ) {
  198.         error("Too many levels of function/procedure nesting");
  199.         pexit(ERRS);
  200.     }
  201.     send(REVFBDY);
  202.     errcnt[cbn] = syneflg;
  203.     parts = NIL;
  204.     if (fp == NIL)
  205.         return (NIL);
  206.     /*
  207.      * Save the virtual name
  208.      * list stack pointer so
  209.      * the space can be freed
  210.      * later (funcend).
  211.      */
  212.     fp->value[2] = nlp;
  213.     if (fp->class != PROG)
  214.         for (q = fp->chain; q != NIL; q = q->chain)
  215.             enter(q);
  216.     if (fp->class == FUNC) {
  217.         /*
  218.          * For functions, enter the fvar
  219.          */
  220.         enter(fp->value[NL_FVAR]);
  221.     }
  222.     return (fp);
  223. }
  224.  
  225. int    pnumcnt;
  226. struct    nl *Fp;
  227. /*
  228.  * Funcend is called to
  229.  * finish a block by generating
  230.  * the code for the statements.
  231.  * It then looks for unresolved declarations
  232.  * of labels, procedures and functions,
  233.  * and cleans up the name list.
  234.  * For the program, it checks the
  235.  * semantics of the program
  236.  * statement (yuchh).
  237.  */
  238. funcend(fp, bundle, endline)
  239.     struct nl *fp;
  240.     int *bundle;
  241.     int endline;
  242. {
  243.     register struct nl *p;
  244.     register int i, b;
  245.     int *blk;
  246.     char *cp;
  247.  
  248.     blk = bundle[2];
  249.     if (fp == NIL) {
  250.         cbn--;
  251.         return;
  252.     }
  253.     send(REVFEND, bundle, endline, syneflg == errcnt[cbn]);
  254.     if (Fp != NIL)
  255.         Fp = fp;
  256.     /*
  257.      * Clean up the symbol table displays and check for unresolves
  258.      */
  259.     line = endline;
  260.     b = cbn;
  261.     for (i = 0; i <= 077; i++) {
  262.         for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next)
  263.         if (p->class == BADUSE) {
  264.             cp = "s";
  265.             if (p->chain->ud_next == NIL)
  266.                 cp++;
  267.             eholdnl();
  268.             if (p->value[NL_KINDS] & ISUNDEF)
  269.                 nerror("%s undefined on line%s", p->symbol, cp);
  270.             else
  271.                 nerror("%s improperly used on line%s", p->symbol, cp);
  272.             pnumcnt = 10;
  273.             pnums(p->chain);
  274.             putchar('\n');
  275.         }
  276.         /*
  277.          * Pop this symbol
  278.          * table slot
  279.          */
  280.         disptab[i] = p;
  281.     }
  282.  
  283. #ifdef DEBUG
  284.     dumpnl(fp->value[2], fp->symbol);
  285. #endif
  286.     /*
  287.      * Restore the
  288.      * (virtual) name list
  289.      * position
  290.      */
  291.     nlfree(fp->value[2]);
  292.     /*
  293.      * Proc/func has been
  294.      * resolved
  295.      */
  296.     fp->nl_flags =& ~NFORWD;
  297.     elineon();
  298.     cbn--;
  299.     if (inpflist(fp->symbol)) {
  300.         opop('l');
  301.     }
  302. }
  303.  
  304. pnums(p)
  305.     struct udinfo *p;
  306. {
  307.  
  308.     if (p->ud_next != NIL)
  309.         pnums(p->ud_next);
  310.     if (pnumcnt == 0) {
  311.         printf("\n\t");
  312.         pnumcnt = 20;
  313.     }
  314.     pnumcnt--;
  315.     printf(" %d", p->ud_line);
  316. }
  317.  
  318. nerror(a1, a2, a3)
  319. {
  320.  
  321.     if (Fp != NIL) {
  322.         yySsync();
  323.         printf("In %s %s:\n", classes[Fp->class], Fp->symbol);
  324.         Fp = NIL;
  325.     }
  326.     elineoff();
  327.     error(a1, a2, a3);
  328. }
  329.