# 2.11BSD#431 - /usr/src/ucb/pascal/pi/fdec.c

##### Functions

    funcbody          X
    funcend           X
    funcfwd           X
    funchdr           X
    nerror            X
    pnums             X

##### Variables

    Fp                X
    cntpatch          X
    nfppatch          X
    pnumcnt           X

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

#### Defined functions

funcbody defined in line 240; used 3 times

- in /usr/src/ucb/pascal/pi/pas.y line 138, 147, 292

funcend defined in line 289; used 2 times

- in /usr/src/ucb/pascal/pi/pas.y line 133, 288

funcfwd defined in line 225; used 1 times

- in /usr/src/ucb/pascal/pi/pas.y line 285

funchdr defined in line 29; used 3 times

- in /usr/src/ucb/pascal/pi/pas.y line 138, 147, 296

nerror defined in line 519; used 9 times

- in line 411, 422-427(2), 442-444(2), 453-462(3), 495

pnums defined in line 505; used 2 times

- in line 446, 510

#### Defined variables

Fp defined in line 276; used 6 times

- in line 392, 496, 522, 529-530(3)

cntpatch defined in line 16; used 2 times

- in line 199, 380

nfppatch defined in line 17; used 2 times

- in line 200, 381

pnumcnt defined in line 277; used 4 times

- in line 445, 511-515(3)

Last modified: 1981-07-10 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 1024 |