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