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

   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

Defined variables