1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 static char sccsid[] = "@(#)fdec.c 1.7 10/28/80"; 4 5 #include "whoami.h" 6 #include "0.h" 7 #include "tree.h" 8 #include "opcode.h" 9 #include "objfmt.h" 10 #include "align.h" 11 12 /* 13 * this array keeps the pxp counters associated with 14 * functions and procedures, so that they can be output 15 * when their bodies are encountered 16 */ 17 int bodycnts[ DSPLYSZ ]; 18 19 #ifdef PC 20 # include "pc.h" 21 # include "pcops.h" 22 #endif PC 23 24 #ifdef OBJ 25 int cntpatch; 26 int nfppatch; 27 #endif OBJ 28 29 /* 30 * Funchdr inserts 31 * declaration of a the 32 * prog/proc/func into the 33 * namelist. It also handles 34 * the arguments and puts out 35 * a transfer which defines 36 * the entry point of a procedure. 37 */ 38 39 struct nl * 40 funchdr(r) 41 int *r; 42 { 43 register struct nl *p; 44 register *il, **rl; 45 int *rll; 46 struct nl *cp, *dp, *sp; 47 int s, o, *pp; 48 49 if (inpflist(r[2])) { 50 opush('l'); 51 yyretrieve(); /* kludge */ 52 } 53 pfcnt++; 54 parts[ cbn ] |= RPRT; 55 line = r[1]; 56 if (r[3] == NIL && (p=lookup1(r[2])) != NIL && bn == cbn) { 57 /* 58 * Symbol already defined 59 * in this block. it is either 60 * a redeclared symbol (error) 61 * a forward declaration, 62 * or an external declaration. 63 */ 64 if ((p->class == FUNC || p->class == PROC) && (p->nl_flags & NFORWD) != 0) { 65 /* 66 * Grammar doesnt forbid 67 * types on a resolution 68 * of a forward function 69 * declaration. 70 */ 71 if (p->class == FUNC && r[4]) 72 error("Function type should be given only in forward declaration"); 73 /* 74 * get another counter for the actual 75 */ 76 if ( monflg ) { 77 bodycnts[ cbn ] = getcnt(); 78 } 79 # ifdef PC 80 enclosing[ cbn ] = p -> symbol; 81 # endif PC 82 # ifdef PTREE 83 /* 84 * mark this proc/func as forward 85 * in the pTree. 86 */ 87 pDEF( p -> inTree ).PorFForward = TRUE; 88 # endif PTREE 89 return (p); 90 } 91 } 92 93 /* if a routine segment is being compiled, 94 * do level one processing. 95 */ 96 97 if ((r[0] != T_PROG) && (!progseen)) 98 level1(); 99 100 101 /* 102 * Declare the prog/proc/func 103 */ 104 switch (r[0]) { 105 case T_PROG: 106 progseen++; 107 if (opt('z')) 108 monflg++; 109 program = p = defnl(r[2], PROG, 0, 0); 110 p->value[3] = r[1]; 111 break; 112 case T_PDEC: 113 if (r[4] != NIL) 114 error("Procedures do not have types, only functions do"); 115 p = enter(defnl(r[2], PROC, 0, 0)); 116 p->nl_flags |= NMOD; 117 # ifdef PC 118 enclosing[ cbn ] = r[2]; 119 # endif PC 120 break; 121 case T_FDEC: 122 il = r[4]; 123 if (il == NIL) 124 error("Function type must be specified"); 125 else if (il[0] != T_TYID) { 126 il = NIL; 127 error("Function type can be specified only by using a type identifier"); 128 } else 129 il = gtype(il); 130 p = enter(defnl(r[2], FUNC, il, NIL)); 131 p->nl_flags |= NMOD; 132 /* 133 * An arbitrary restriction 134 */ 135 switch (o = classify(p->type)) { 136 case TFILE: 137 case TARY: 138 case TREC: 139 case TSET: 140 case TSTR: 141 warning(); 142 if (opt('s')) { 143 standard(); 144 } 145 error("Functions should not return %ss", clnames[o]); 146 } 147 # ifdef PC 148 enclosing[ cbn ] = r[2]; 149 # endif PC 150 break; 151 default: 152 panic("funchdr"); 153 } 154 if (r[0] != T_PROG) { 155 /* 156 * Mark this proc/func as 157 * being forward declared 158 */ 159 p->nl_flags |= NFORWD; 160 /* 161 * Enter the parameters 162 * in the next block for 163 * the time being 164 */ 165 if (++cbn >= DSPLYSZ) { 166 error("Procedure/function nesting too deep"); 167 pexit(ERRS); 168 } 169 /* 170 * For functions, the function variable 171 */ 172 if (p->class == FUNC) { 173 # ifdef OBJ 174 cp = defnl(r[2], FVAR, p->type, 0); 175 # endif OBJ 176 # ifdef PC 177 /* 178 * fvars used to be allocated and deallocated 179 * by the caller right before the arguments. 180 * the offset of the fvar was kept in 181 * value[NL_OFFS] of function (very wierd, 182 * but see asgnop). 183 * now, they are locals to the function 184 * with the offset kept in the fvar. 185 */ 186 187 cp = defnl( r[2] , FVAR , p -> type 188 , -( roundup( DPOFF1+width( p -> type ) 189 , align( p -> type ) ) ) ); 190 # endif PC 191 cp->chain = p; 192 p->ptr[NL_FVAR] = cp; 193 } 194 /* 195 * Enter the parameters 196 * and compute total size 197 */ 198 cp = sp = p; 199 200 # ifdef OBJ 201 o = 0; 202 # endif OBJ 203 # ifdef PC 204 /* 205 * parameters used to be allocated backwards, 206 * then fixed. for pc, they are allocated correctly. 207 * also, they are aligned. 208 */ 209 o = DPOFF2; 210 # endif PC 211 for (rl = r[3]; rl != NIL; rl = rl[2]) { 212 p = NIL; 213 if (rl[1] == NIL) 214 continue; 215 /* 216 * Parametric procedures 217 * don't have types !?! 218 */ 219 if (rl[1][0] != T_PPROC) { 220 rll = rl[1][2]; 221 if (rll[0] != T_TYID) { 222 error("Types for arguments can be specified only by using type identifiers"); 223 p = NIL; 224 } else 225 p = gtype(rll); 226 } 227 for (il = rl[1][1]; il != NIL; il = il[2]) { 228 switch (rl[1][0]) { 229 default: 230 panic("funchdr2"); 231 case T_PVAL: 232 if (p != NIL) { 233 if (p->class == FILET) 234 error("Files cannot be passed by value"); 235 else if (p->nl_flags & NFILES) 236 error("Files cannot be a component of %ss passed by value", 237 nameof(p)); 238 } 239 # ifdef OBJ 240 dp = defnl(il[1], VAR, p, o -= even(width(p))); 241 # endif OBJ 242 # ifdef PC 243 dp = defnl( il[1] , VAR , p 244 , o = roundup( o , A_STACK ) ); 245 o += width( p ); 246 # endif PC 247 dp->nl_flags |= NMOD; 248 break; 249 case T_PVAR: 250 # ifdef OBJ 251 dp = defnl(il[1], REF, p, o -= sizeof ( int * ) ); 252 # endif OBJ 253 # ifdef PC 254 dp = defnl( il[1] , REF , p 255 , o = roundup( o , A_STACK ) ); 256 o += sizeof(char *); 257 # endif PC 258 break; 259 case T_PFUNC: 260 # ifdef OBJ 261 dp = defnl(il[1], FFUNC, p, o -= sizeof ( int * ) ); 262 # endif OBJ 263 # ifdef PC 264 dp = defnl( il[1] , FFUNC , p 265 , o = roundup( o , A_STACK ) ); 266 o += sizeof(char *); 267 # endif PC 268 dp -> nl_flags |= NMOD; 269 break; 270 case T_PPROC: 271 # ifdef OBJ 272 dp = defnl(il[1], FPROC, p, o -= sizeof ( int * ) ); 273 # endif OBJ 274 # ifdef PC 275 dp = defnl( il[1] , FPROC , p 276 , o = roundup( o , A_STACK ) ); 277 o += sizeof(char *); 278 # endif PC 279 dp -> nl_flags |= NMOD; 280 break; 281 } 282 if (dp != NIL) { 283 cp->chain = dp; 284 cp = dp; 285 } 286 } 287 } 288 cbn--; 289 p = sp; 290 # ifdef OBJ 291 p->value[NL_OFFS] = -o+DPOFF2; 292 /* 293 * Correct the naivete (naievity) 294 * of our above code to 295 * calculate offsets 296 */ 297 for (il = p->chain; il != NIL; il = il->chain) 298 il->value[NL_OFFS] += p->value[NL_OFFS]; 299 # endif OBJ 300 # ifdef PC 301 p -> value[ NL_OFFS ] = roundup( o , A_STACK ); 302 # endif PC 303 } else { 304 /* 305 * The wonderful 306 * program statement! 307 */ 308 # ifdef OBJ 309 if (monflg) { 310 put(1, O_PXPBUF); 311 cntpatch = put(2, O_CASE4, 0); 312 nfppatch = put(2, O_CASE4, 0); 313 } 314 # endif OBJ 315 cp = p; 316 for (rl = r[3]; rl; rl = rl[2]) { 317 if (rl[1] == NIL) 318 continue; 319 dp = defnl(rl[1], VAR, 0, 0); 320 cp->chain = dp; 321 cp = dp; 322 } 323 } 324 /* 325 * Define a branch at 326 * the "entry point" of 327 * the prog/proc/func. 328 */ 329 p->entloc = getlab(); 330 if (monflg) { 331 bodycnts[ cbn ] = getcnt(); 332 p->value[ NL_CNTR ] = 0; 333 } 334 # ifdef OBJ 335 put(2, O_TRA4, p->entloc); 336 # endif OBJ 337 # ifdef PTREE 338 { 339 pPointer PF = tCopy( r ); 340 341 pSeize( PorFHeader[ nesting ] ); 342 if ( r[0] != T_PROG ) { 343 pPointer *PFs; 344 345 PFs = &( pDEF( PorFHeader[ nesting ] ).PorFPFs ); 346 *PFs = ListAppend( *PFs , PF ); 347 } else { 348 pDEF( PorFHeader[ nesting ] ).GlobProg = PF; 349 } 350 pRelease( PorFHeader[ nesting ] ); 351 } 352 # endif PTREE 353 return (p); 354 } 355 356 funcfwd(fp) 357 struct nl *fp; 358 { 359 360 /* 361 * save the counter for this function 362 */ 363 if ( monflg ) { 364 fp -> value[ NL_CNTR ] = bodycnts[ cbn ]; 365 } 366 return (fp); 367 } 368 369 /* 370 * Funcext marks the procedure or 371 * function external in the symbol 372 * table. Funcext should only be 373 * called if PC, and is an error 374 * otherwise. 375 */ 376 377 funcext(fp) 378 struct nl *fp; 379 { 380 381 #ifdef PC 382 if (opt('s')) { 383 standard(); 384 error("External procedures and functions are not standard"); 385 } else { 386 if (cbn == 1) { 387 fp->ext_flags |= NEXTERN; 388 stabefunc( fp -> symbol , fp -> class , line ); 389 } 390 else 391 error("External procedures and functions can only be declared at the outermost level."); 392 } 393 #endif PC 394 #ifdef OBJ 395 error("Procedures or functions cannot be declared external."); 396 #endif OBJ 397 398 return(fp); 399 } 400 401 /* 402 * Funcbody is called 403 * when the actual (resolved) 404 * declaration of a procedure is 405 * encountered. It puts the names 406 * of the (function) and parameters 407 * into the symbol table. 408 */ 409 funcbody(fp) 410 struct nl *fp; 411 { 412 register struct nl *q, *p; 413 414 cbn++; 415 if (cbn >= DSPLYSZ) { 416 error("Too many levels of function/procedure nesting"); 417 pexit(ERRS); 418 } 419 sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1; 420 gotos[cbn] = NIL; 421 errcnt[cbn] = syneflg; 422 parts[ cbn ] = NIL; 423 dfiles[ cbn ] = FALSE; 424 if (fp == NIL) 425 return (NIL); 426 /* 427 * Save the virtual name 428 * list stack pointer so 429 * the space can be freed 430 * later (funcend). 431 */ 432 fp->ptr[2] = nlp; 433 # ifdef PC 434 if ( fp -> class != PROG ) { 435 stabfunc( fp -> symbol , fp -> class , line , cbn - 1 ); 436 } else { 437 stabfunc( "program" , fp -> class , line , 0 ); 438 } 439 # endif PC 440 if (fp->class != PROG) { 441 for (q = fp->chain; q != NIL; q = q->chain) { 442 enter(q); 443 # ifdef PC 444 stabparam( q -> symbol , p2type( q -> type ) 445 , q -> value[ NL_OFFS ] 446 , lwidth( q -> type ) ); 447 # endif PC 448 } 449 } 450 if (fp->class == FUNC) { 451 /* 452 * For functions, enter the fvar 453 */ 454 enter(fp->ptr[NL_FVAR]); 455 # ifdef PC 456 q = fp -> ptr[ NL_FVAR ]; 457 sizes[cbn].om_off -= lwidth( q -> type ); 458 sizes[cbn].om_max = sizes[cbn].om_off; 459 stabvar( q -> symbol , p2type( q -> type ) , cbn 460 , q -> value[ NL_OFFS ] , lwidth( q -> type ) 461 , line ); 462 # endif PC 463 } 464 # ifdef PTREE 465 /* 466 * pick up the pointer to porf declaration 467 */ 468 PorFHeader[ ++nesting ] = fp -> inTree; 469 # endif PTREE 470 return (fp); 471 } 472 473 struct nl *Fp; 474 int pnumcnt; 475 /* 476 * Funcend is called to 477 * finish a block by generating 478 * the code for the statements. 479 * It then looks for unresolved declarations 480 * of labels, procedures and functions, 481 * and cleans up the name list. 482 * For the program, it checks the 483 * semantics of the program 484 * statement (yuchh). 485 */ 486 funcend(fp, bundle, endline) 487 struct nl *fp; 488 int *bundle; 489 int endline; 490 { 491 register struct nl *p; 492 register int i, b; 493 int var, inp, out, chkref, *blk; 494 struct nl *iop; 495 char *cp; 496 extern int cntstat; 497 # ifdef PC 498 int toplabel = getlab(); 499 int botlabel = getlab(); 500 # endif PC 501 502 cntstat = 0; 503 /* 504 * yyoutline(); 505 */ 506 if (program != NIL) 507 line = program->value[3]; 508 blk = bundle[2]; 509 if (fp == NIL) { 510 cbn--; 511 # ifdef PTREE 512 nesting--; 513 # endif PTREE 514 return; 515 } 516 #ifdef OBJ 517 /* 518 * Patch the branch to the 519 * entry point of the function 520 */ 521 patch4(fp->entloc); 522 /* 523 * Put out the block entrance code and the block name. 524 * the CONG is overlaid by a patch later! 525 */ 526 var = put(2, (lenstr(fp->symbol,0) << 8) 527 | (cbn == 1 && opt('p') == 0 ? O_NODUMP: O_BEG), 0); 528 /* 529 * output the number of bytes of arguments 530 * this is only checked on formal calls. 531 */ 532 put(2, O_CASE4, cbn == 1 ? 0 : fp->value[NL_OFFS]-DPOFF2); 533 put(2, O_CASE2, bundle[1]); 534 putstr(fp->symbol, 0); 535 #endif OBJ 536 #ifdef PC 537 /* 538 * put out the procedure entry code 539 */ 540 if ( fp -> class == PROG ) { 541 putprintf( " .text" , 0 ); 542 putprintf( " .align 1" , 0 ); 543 putprintf( " .globl _main" , 0 ); 544 putprintf( "_main:" , 0 ); 545 putprintf( " .word 0" , 0 ); 546 putprintf( " calls $0,_PCSTART" , 0 ); 547 putprintf( " movl 4(ap),__argc" , 0 ); 548 putprintf( " movl 8(ap),__argv" , 0 ); 549 putprintf( " calls $0,_program" , 0 ); 550 putprintf( " calls $0,_PCEXIT" , 0 ); 551 ftnno = fp -> entloc; 552 putprintf( " .text" , 0 ); 553 putprintf( " .align 1" , 0 ); 554 putprintf( " .globl _program" , 0 ); 555 putprintf( "_program:" , 0 ); 556 } else { 557 ftnno = fp -> entloc; 558 putprintf( " .text" , 0 ); 559 putprintf( " .align 1" , 0 ); 560 putprintf( " .globl " , 1 ); 561 for ( i = 1 ; i < cbn ; i++ ) { 562 putprintf( EXTFORMAT , 1 , enclosing[ i ] ); 563 } 564 putprintf( "" , 0 ); 565 for ( i = 1 ; i < cbn ; i++ ) { 566 putprintf( EXTFORMAT , 1 , enclosing[ i ] ); 567 } 568 putprintf( ":" , 0 ); 569 } 570 stablbrac( cbn ); 571 /* 572 * register save mask 573 */ 574 if ( opt( 't' ) ) { 575 putprintf( " .word 0x%x" , 0 , RUNCHECK | RSAVEMASK ); 576 } else { 577 putprintf( " .word 0x%x" , 0 , RSAVEMASK ); 578 } 579 putjbr( botlabel ); 580 putlab( toplabel ); 581 if ( profflag ) { 582 /* 583 * call mcount for profiling 584 */ 585 putprintf( " moval 1f,r0" , 0 ); 586 putprintf( " jsb mcount" , 0 ); 587 putprintf( " .data" , 0 ); 588 putprintf( " .align 2" , 0 ); 589 putprintf( "1:" , 0 ); 590 putprintf( " .long 0" , 0 ); 591 putprintf( " .text" , 0 ); 592 } 593 /* 594 * set up unwind exception vector. 595 */ 596 putprintf( " moval %s,%d(%s)" , 0 597 , UNWINDNAME , UNWINDOFFSET , P2FPNAME ); 598 /* 599 * save address of display entry, for unwind. 600 */ 601 putprintf( " moval %s+%d,%d(%s)" , 0 602 , DISPLAYNAME , cbn * sizeof(struct dispsave) 603 , DPTROFFSET , P2FPNAME ); 604 /* 605 * save old display 606 */ 607 putprintf( " movq %s+%d,%d(%s)" , 0 608 , DISPLAYNAME , cbn * sizeof(struct dispsave) 609 , DSAVEOFFSET , P2FPNAME ); 610 /* 611 * set up new display by saving AP and FP in appropriate 612 * slot in display structure. 613 */ 614 putprintf( " movq %s,%s+%d" , 0 615 , P2APNAME , DISPLAYNAME , cbn * sizeof(struct dispsave) ); 616 /* 617 * ask second pass to allocate known locals 618 */ 619 putlbracket( ftnno , -sizes[ cbn ].om_max ); 620 /* 621 * and zero them if checking is on 622 * by calling zframe( bytes of locals , highest local address ); 623 */ 624 if ( opt( 't' ) ) { 625 if ( ( -sizes[ cbn ].om_max ) > DPOFF1 ) { 626 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) 627 , "_ZFRAME" ); 628 putleaf( P2ICON , ( -sizes[ cbn ].om_max ) - DPOFF1 629 , 0 , P2INT , 0 ); 630 putLV( 0 , cbn , sizes[ cbn ].om_max , P2CHAR ); 631 putop( P2LISTOP , P2INT ); 632 putop( P2CALL , P2INT ); 633 putdot( filename , line ); 634 } 635 /* 636 * check number of longs of arguments 637 * this can only be wrong for formal calls. 638 */ 639 if ( fp -> class != PROG ) { 640 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2PTR , P2FTN | P2INT ) , 641 "_NARGCHK" ); 642 putleaf( P2ICON , 643 (fp->value[NL_OFFS] - DPOFF2) / sizeof(long) , 644 0 , P2INT , 0 ); 645 putop( P2CALL , P2INT ); 646 putdot( filename , line ); 647 } 648 } 649 #endif PC 650 if ( monflg ) { 651 if ( fp -> value[ NL_CNTR ] != 0 ) { 652 inccnt( fp -> value [ NL_CNTR ] ); 653 } 654 inccnt( bodycnts[ fp -> nl_block & 037 ] ); 655 } 656 if (fp->class == PROG) { 657 /* 658 * The glorious buffers option. 659 * 0 = don't buffer output 660 * 1 = line buffer output 661 * 2 = 512 byte buffer output 662 */ 663 # ifdef OBJ 664 if (opt('b') != 1) 665 put(1, O_BUFF | opt('b') << 8); 666 # endif OBJ 667 # ifdef PC 668 if ( opt( 'b' ) != 1 ) { 669 putleaf( P2ICON , 0 , 0 670 , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_BUFF" ); 671 putleaf( P2ICON , opt( 'b' ) , 0 , P2INT , 0 ); 672 putop( P2CALL , P2INT ); 673 putdot( filename , line ); 674 } 675 # endif PC 676 out = 0; 677 for (p = fp->chain; p != NIL; p = p->chain) { 678 if (strcmp(p->symbol, "input") == 0) { 679 inp++; 680 continue; 681 } 682 if (strcmp(p->symbol, "output") == 0) { 683 out++; 684 continue; 685 } 686 iop = lookup1(p->symbol); 687 if (iop == NIL || bn != cbn) { 688 error("File %s listed in program statement but not declared", p->symbol); 689 continue; 690 } 691 if (iop->class != VAR) { 692 error("File %s listed in program statement but declared as a %s", p->symbol, classes[iop->class]); 693 continue; 694 } 695 if (iop->type == NIL) 696 continue; 697 if (iop->type->class != FILET) { 698 error("File %s listed in program statement but defined as %s", 699 p->symbol, nameof(iop->type)); 700 continue; 701 } 702 # ifdef OBJ 703 put(2, O_LV | bn << 8+INDX, iop->value[NL_OFFS]); 704 i = lenstr(p->symbol,0); 705 put(2, O_LVCON, i); 706 putstr(p->symbol, 0); 707 do { 708 i--; 709 } while (p->symbol+i == 0); 710 put(2, O_CON24, i+1); 711 put(2, O_CON24, text(iop->type) ? 0 : width(iop->type->type)); 712 put(1, O_DEFNAME); 713 # endif OBJ 714 # ifdef PC 715 putleaf( P2ICON , 0 , 0 716 , ADDTYPE( P2FTN | P2INT , P2PTR ) 717 , "_DEFNAME" ); 718 putLV( p -> symbol , bn , iop -> value[NL_OFFS] 719 , p2type( iop ) ); 720 putCONG( p -> symbol , strlen( p -> symbol ) 721 , LREQ ); 722 putop( P2LISTOP , P2INT ); 723 putleaf( P2ICON , strlen( p -> symbol ) 724 , 0 , P2INT , 0 ); 725 putop( P2LISTOP , P2INT ); 726 putleaf( P2ICON 727 , text(iop->type) ? 0 : width(iop->type->type) 728 , 0 , P2INT , 0 ); 729 putop( P2LISTOP , P2INT ); 730 putop( P2CALL , P2INT ); 731 putdot( filename , line ); 732 # endif PC 733 } 734 if (out == 0 && fp->chain != NIL) { 735 recovered(); 736 error("The file output must appear in the program statement file list"); 737 } 738 } 739 /* 740 * Process the prog/proc/func body 741 */ 742 noreach = 0; 743 line = bundle[1]; 744 statlist(blk); 745 # ifdef PTREE 746 { 747 pPointer Body = tCopy( blk ); 748 749 pDEF( PorFHeader[ nesting -- ] ).PorFBody = Body; 750 } 751 # endif PTREE 752 # ifdef OBJ 753 if (cbn== 1 && monflg != 0) { 754 patchfil(cntpatch - 2, cnts, 2); 755 patchfil(nfppatch - 2, pfcnt, 2); 756 } 757 # endif OBJ 758 # ifdef PC 759 if ( fp -> class == PROG && monflg ) { 760 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) 761 , "_PMFLUSH" ); 762 putleaf( P2ICON , cnts , 0 , P2INT , 0 ); 763 putleaf( P2ICON , pfcnt , 0 , P2INT , 0 ); 764 putop( P2LISTOP , P2INT ); 765 putop( P2CALL , P2INT ); 766 putdot( filename , line ); 767 } 768 # endif PC 769 if (fp->class == PROG && inp == 0 && (input->nl_flags & (NUSED|NMOD)) != 0) { 770 recovered(); 771 error("Input is used but not defined in the program statement"); 772 } 773 /* 774 * Clean up the symbol table displays and check for unresolves 775 */ 776 line = endline; 777 b = cbn; 778 Fp = fp; 779 chkref = syneflg == errcnt[cbn] && opt('w') == 0; 780 for (i = 0; i <= 077; i++) { 781 for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) { 782 /* 783 * Check for variables defined 784 * but not referenced 785 */ 786 if (chkref && p->symbol != NIL) 787 switch (p->class) { 788 case FIELD: 789 /* 790 * If the corresponding record is 791 * unused, we shouldn't complain about 792 * the fields. 793 */ 794 default: 795 if ((p->nl_flags & (NUSED|NMOD)) == 0) { 796 warning(); 797 nerror("%s %s is neither used nor set", classes[p->class], p->symbol); 798 break; 799 } 800 /* 801 * If a var parameter is either 802 * modified or used that is enough. 803 */ 804 if (p->class == REF) 805 continue; 806 # ifdef OBJ 807 if ((p->nl_flags & NUSED) == 0) { 808 warning(); 809 nerror("%s %s is never used", classes[p->class], p->symbol); 810 break; 811 } 812 # endif OBJ 813 # ifdef PC 814 if (((p->nl_flags & NUSED) == 0) && ((p->ext_flags & NEXTERN) == 0)) { 815 warning(); 816 nerror("%s %s is never used", classes[p->class], p->symbol); 817 break; 818 } 819 # endif PC 820 if ((p->nl_flags & NMOD) == 0) { 821 warning(); 822 nerror("%s %s is used but never set", classes[p->class], p->symbol); 823 break; 824 } 825 case LABEL: 826 case FVAR: 827 case BADUSE: 828 break; 829 } 830 switch (p->class) { 831 case BADUSE: 832 cp = "s"; 833 if (p->chain->ud_next == NIL) 834 cp++; 835 eholdnl(); 836 if (p->value[NL_KINDS] & ISUNDEF) 837 nerror("%s undefined on line%s", p->symbol, cp); 838 else 839 nerror("%s improperly used on line%s", p->symbol, cp); 840 pnumcnt = 10; 841 pnums(p->chain); 842 pchr('\n'); 843 break; 844 845 case FUNC: 846 case PROC: 847 # ifdef OBJ 848 if ((p->nl_flags & NFORWD)) 849 nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); 850 # endif OBJ 851 # ifdef PC 852 if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0)) 853 nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); 854 # endif PC 855 break; 856 857 case LABEL: 858 if (p->nl_flags & NFORWD) 859 nerror("label %s was declared but not defined", p->symbol); 860 break; 861 case FVAR: 862 if ((p->nl_flags & NMOD) == 0) 863 nerror("No assignment to the function variable"); 864 break; 865 } 866 } 867 /* 868 * Pop this symbol 869 * table slot 870 */ 871 disptab[i] = p; 872 } 873 874 # ifdef OBJ 875 put(1, O_END); 876 # endif OBJ 877 # ifdef PC 878 /* 879 * if there were file variables declared at this level 880 * call pclose( &__disply[ cbn ] ) to clean them up. 881 */ 882 if ( dfiles[ cbn ] ) { 883 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) 884 , "_PCLOSE" ); 885 putRV( DISPLAYNAME , 0 , cbn * sizeof( struct dispsave ) 886 , P2PTR | P2CHAR ); 887 putop( P2CALL , P2INT ); 888 putdot( filename , line ); 889 } 890 /* 891 * if this is a function, 892 * the function variable is the return value. 893 * if it's a scalar valued function, return scalar, 894 * else, return a pointer to the structure value. 895 */ 896 if ( fp -> class == FUNC ) { 897 struct nl *fvar = fp -> ptr[ NL_FVAR ]; 898 long fvartype = p2type( fvar -> type ); 899 long label; 900 char labelname[ BUFSIZ ]; 901 902 switch ( classify( fvar -> type ) ) { 903 case TBOOL: 904 case TCHAR: 905 case TINT: 906 case TSCAL: 907 case TDOUBLE: 908 case TPTR: 909 putRV( fvar -> symbol , ( fvar -> nl_block ) & 037 910 , fvar -> value[ NL_OFFS ] , fvartype ); 911 break; 912 default: 913 label = getlab(); 914 sprintf( labelname , PREFIXFORMAT , 915 LABELPREFIX , label ); 916 putprintf( " .data" , 0 ); 917 putprintf( " .lcomm %s,%d" , 0 , 918 labelname , lwidth( fvar -> type ) ); 919 putprintf( " .text" , 0 ); 920 putleaf( P2NAME , 0 , 0 , fvartype , labelname ); 921 putLV( fvar -> symbol , ( fvar -> nl_block ) & 037 922 , fvar -> value[ NL_OFFS ] , fvartype ); 923 putstrop( P2STASG , fvartype , lwidth( fvar -> type ) , 924 align( fvar -> type ) ); 925 putdot( filename , line ); 926 putleaf( P2ICON , 0 , 0 , fvartype , labelname ); 927 break; 928 } 929 putop( P2FORCE , fvartype ); 930 putdot( filename , line ); 931 } 932 /* 933 * restore old display entry from save area 934 */ 935 936 putprintf( " movq %d(%s),%s+%d" , 0 937 , DSAVEOFFSET , P2FPNAME 938 , DISPLAYNAME , cbn * sizeof(struct dispsave) ); 939 stabrbrac( cbn ); 940 putprintf( " ret" , 0 ); 941 /* 942 * let the second pass allocate locals 943 */ 944 putlab( botlabel ); 945 putprintf( " subl2 $LF%d,sp" , 0 , ftnno ); 946 putrbracket( ftnno ); 947 putjbr( toplabel ); 948 /* 949 * declare pcp counters, if any 950 */ 951 if ( monflg && fp -> class == PROG ) { 952 putprintf( " .data" , 0 ); 953 putprintf( " .comm " , 1 ); 954 putprintf( PCPCOUNT , 1 ); 955 putprintf( ",%d" , 0 , ( cnts + 1 ) * sizeof (long) ); 956 putprintf( " .text" , 0 ); 957 } 958 # endif PC 959 #ifdef DEBUG 960 dumpnl(fp->ptr[2], fp->symbol); 961 #endif 962 /* 963 * Restore the 964 * (virtual) name list 965 * position 966 */ 967 nlfree(fp->ptr[2]); 968 /* 969 * Proc/func has been 970 * resolved 971 */ 972 fp->nl_flags &= ~NFORWD; 973 /* 974 * Patch the beg 975 * of the proc/func to 976 * the proper variable size 977 */ 978 if (Fp == NIL) 979 elineon(); 980 # ifdef OBJ 981 patchfil(var, sizes[cbn].om_max, 2); 982 # endif OBJ 983 cbn--; 984 if (inpflist(fp->symbol)) { 985 opop('l'); 986 } 987 } 988 989 990 /* 991 * Segend is called to check for 992 * unresolved variables, funcs and 993 * procs, and deliver unresolved and 994 * baduse error diagnostics at the 995 * end of a routine segment (a separately 996 * compiled segment that is not the 997 * main program) for PC. This 998 * routine should only be called 999 * by PC (not standard). 1000 */ 1001 segend() 1002 { 1003 register struct nl *p; 1004 register int i,b; 1005 char *cp; 1006 1007 #ifdef PC 1008 if (opt('s')) { 1009 standard(); 1010 error("Separately compiled routine segments are not standard."); 1011 } else { 1012 b = cbn; 1013 for (i=0; i<077; i++) { 1014 for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) { 1015 switch (p->class) { 1016 case BADUSE: 1017 cp = 's'; 1018 if (p->chain->ud_next == NIL) 1019 cp++; 1020 eholdnl(); 1021 if (p->value[NL_KINDS] & ISUNDEF) 1022 nerror("%s undefined on line%s", p->symbol, cp); 1023 else 1024 nerror("%s improperly used on line%s", p->symbol, cp); 1025 pnumcnt = 10; 1026 pnums(p->chain); 1027 pchr('\n'); 1028 break; 1029 1030 case FUNC: 1031 case PROC: 1032 if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0)) 1033 nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); 1034 break; 1035 1036 case FVAR: 1037 if (((p->nl_flags & NMOD) == 0) && ((p->chain->ext_flags & NEXTERN) == 0)) 1038 nerror("No assignment to the function variable"); 1039 break; 1040 } 1041 } 1042 disptab[i] = p; 1043 } 1044 } 1045 #endif PC 1046 #ifdef OBJ 1047 error("Missing program statement and program body"); 1048 #endif OBJ 1049 1050 } 1051 1052 1053 /* 1054 * Level1 does level one processing for 1055 * separately compiled routine segments 1056 */ 1057 level1() 1058 { 1059 1060 # ifdef OBJ 1061 error("Missing program statement"); 1062 # endif OBJ 1063 # ifdef PC 1064 if (opt('s')) { 1065 standard(); 1066 error("Missing program statement"); 1067 } 1068 # endif PC 1069 1070 cbn++; 1071 sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1; 1072 gotos[cbn] = NIL; 1073 errcnt[cbn] = syneflg; 1074 parts[ cbn ] = NIL; 1075 dfiles[ cbn ] = FALSE; 1076 progseen++; 1077 } 1078 1079 1080 1081 pnums(p) 1082 struct udinfo *p; 1083 { 1084 1085 if (p->ud_next != NIL) 1086 pnums(p->ud_next); 1087 if (pnumcnt == 0) { 1088 printf("\n\t"); 1089 pnumcnt = 20; 1090 } 1091 pnumcnt--; 1092 printf(" %d", p->ud_line); 1093 } 1094 1095 nerror(a1, a2, a3) 1096 { 1097 1098 if (Fp != NIL) { 1099 yySsync(); 1100 #ifndef PI1 1101 if (opt('l')) 1102 yyoutline(); 1103 #endif 1104 yysetfile(filename); 1105 printf("In %s %s:\n", classes[Fp->class], Fp->symbol); 1106 Fp = NIL; 1107 elineoff(); 1108 } 1109 error(a1, a2, a3); 1110 } 1111