1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 static char sccsid[] = "@(#)fdec.c 1.4 10/03/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 putRV( labelname , 0 , 0 , fvartype ); 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 putLV( labelname , 0 , 0 , fvartype ); 925 break; 926 } 927 putop( P2FORCE , fvartype ); 928 putdot( filename , line ); 929 } 930 /* 931 * restore old display entry from save area 932 */ 933 934 putprintf( " movq %d(%s),%s+%d" , 0 935 , DSAVEOFFSET , P2FPNAME 936 , DISPLAYNAME , cbn * sizeof(struct dispsave) ); 937 stabrbrac( cbn ); 938 putprintf( " ret" , 0 ); 939 /* 940 * let the second pass allocate locals 941 */ 942 putlab( botlabel ); 943 putprintf( " subl2 $LF%d,sp" , 0 , ftnno ); 944 putrbracket( ftnno ); 945 putjbr( toplabel ); 946 /* 947 * declare pcp counters, if any 948 */ 949 if ( monflg && fp -> class == PROG ) { 950 putprintf( " .data" , 0 ); 951 putprintf( " .comm " , 1 ); 952 putprintf( PCPCOUNT , 1 ); 953 putprintf( ",%d" , 0 , ( cnts + 1 ) * sizeof (long) ); 954 putprintf( " .text" , 0 ); 955 } 956 # endif PC 957 #ifdef DEBUG 958 dumpnl(fp->ptr[2], fp->symbol); 959 #endif 960 /* 961 * Restore the 962 * (virtual) name list 963 * position 964 */ 965 nlfree(fp->ptr[2]); 966 /* 967 * Proc/func has been 968 * resolved 969 */ 970 fp->nl_flags &= ~NFORWD; 971 /* 972 * Patch the beg 973 * of the proc/func to 974 * the proper variable size 975 */ 976 if (Fp == NIL) 977 elineon(); 978 # ifdef OBJ 979 patchfil(var, sizes[cbn].om_max, 2); 980 # endif OBJ 981 cbn--; 982 if (inpflist(fp->symbol)) { 983 opop('l'); 984 } 985 } 986 987 988 /* 989 * Segend is called to check for 990 * unresolved variables, funcs and 991 * procs, and deliver unresolved and 992 * baduse error diagnostics at the 993 * end of a routine segment (a separately 994 * compiled segment that is not the 995 * main program) for PC. This 996 * routine should only be called 997 * by PC (not standard). 998 */ 999 segend() 1000 { 1001 register struct nl *p; 1002 register int i,b; 1003 char *cp; 1004 1005 #ifdef PC 1006 if (opt('s')) { 1007 standard(); 1008 error("Separately compiled routine segments are not standard."); 1009 } else { 1010 b = cbn; 1011 for (i=0; i<077; i++) { 1012 for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) { 1013 switch (p->class) { 1014 case BADUSE: 1015 cp = 's'; 1016 if (p->chain->ud_next == NIL) 1017 cp++; 1018 eholdnl(); 1019 if (p->value[NL_KINDS] & ISUNDEF) 1020 nerror("%s undefined on line%s", p->symbol, cp); 1021 else 1022 nerror("%s improperly used on line%s", p->symbol, cp); 1023 pnumcnt = 10; 1024 pnums(p->chain); 1025 pchr('\n'); 1026 break; 1027 1028 case FUNC: 1029 case PROC: 1030 if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0)) 1031 nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); 1032 break; 1033 1034 case FVAR: 1035 if (((p->nl_flags & NMOD) == 0) && ((p->chain->ext_flags & NEXTERN) == 0)) 1036 nerror("No assignment to the function variable"); 1037 break; 1038 } 1039 } 1040 disptab[i] = p; 1041 } 1042 } 1043 #endif PC 1044 #ifdef OBJ 1045 error("Missing program statement and program body"); 1046 #endif OBJ 1047 1048 } 1049 1050 1051 /* 1052 * Level1 does level one processing for 1053 * separately compiled routine segments 1054 */ 1055 level1() 1056 { 1057 1058 # ifdef OBJ 1059 error("Missing program statement"); 1060 # endif OBJ 1061 # ifdef PC 1062 if (opt('s')) { 1063 standard(); 1064 error("Missing program statement"); 1065 } 1066 # endif PC 1067 1068 cbn++; 1069 sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1; 1070 gotos[cbn] = NIL; 1071 errcnt[cbn] = syneflg; 1072 parts[ cbn ] = NIL; 1073 dfiles[ cbn ] = FALSE; 1074 progseen++; 1075 } 1076 1077 1078 1079 pnums(p) 1080 struct udinfo *p; 1081 { 1082 1083 if (p->ud_next != NIL) 1084 pnums(p->ud_next); 1085 if (pnumcnt == 0) { 1086 printf("\n\t"); 1087 pnumcnt = 20; 1088 } 1089 pnumcnt--; 1090 printf(" %d", p->ud_line); 1091 } 1092 1093 nerror(a1, a2, a3) 1094 { 1095 1096 if (Fp != NIL) { 1097 yySsync(); 1098 #ifndef PI1 1099 if (opt('l')) 1100 yyoutline(); 1101 #endif 1102 yysetfile(filename); 1103 printf("In %s %s:\n", classes[Fp->class], Fp->symbol); 1104 Fp = NIL; 1105 elineoff(); 1106 } 1107 error(a1, a2, a3); 1108 } 1109