1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 static char sccsid[] = "@(#)fdec.c 1.9 01/10/81"; 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_CON24, text(iop->type) ? 0 : width(iop->type->type)); 704 i = lenstr(p->symbol,0); 705 put(2, O_CON24, i); 706 put(2, O_LVCON, i); 707 putstr(p->symbol, 0); 708 put(2, O_LV | bn << 8+INDX, iop->value[NL_OFFS]); 709 put(1, O_DEFNAME); 710 # endif OBJ 711 # ifdef PC 712 putleaf( P2ICON , 0 , 0 713 , ADDTYPE( P2FTN | P2INT , P2PTR ) 714 , "_DEFNAME" ); 715 putLV( p -> symbol , bn , iop -> value[NL_OFFS] 716 , p2type( iop ) ); 717 putCONG( p -> symbol , strlen( p -> symbol ) 718 , LREQ ); 719 putop( P2LISTOP , P2INT ); 720 putleaf( P2ICON , strlen( p -> symbol ) 721 , 0 , P2INT , 0 ); 722 putop( P2LISTOP , P2INT ); 723 putleaf( P2ICON 724 , text(iop->type) ? 0 : width(iop->type->type) 725 , 0 , P2INT , 0 ); 726 putop( P2LISTOP , P2INT ); 727 putop( P2CALL , P2INT ); 728 putdot( filename , line ); 729 # endif PC 730 } 731 if (out == 0 && fp->chain != NIL) { 732 recovered(); 733 error("The file output must appear in the program statement file list"); 734 } 735 } 736 /* 737 * Process the prog/proc/func body 738 */ 739 noreach = 0; 740 line = bundle[1]; 741 statlist(blk); 742 # ifdef PTREE 743 { 744 pPointer Body = tCopy( blk ); 745 746 pDEF( PorFHeader[ nesting -- ] ).PorFBody = Body; 747 } 748 # endif PTREE 749 # ifdef OBJ 750 if (cbn== 1 && monflg != 0) { 751 patchfil(cntpatch - 2, cnts, 2); 752 patchfil(nfppatch - 2, pfcnt, 2); 753 } 754 # endif OBJ 755 # ifdef PC 756 if ( fp -> class == PROG && monflg ) { 757 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) 758 , "_PMFLUSH" ); 759 putleaf( P2ICON , cnts , 0 , P2INT , 0 ); 760 putleaf( P2ICON , pfcnt , 0 , P2INT , 0 ); 761 putop( P2LISTOP , P2INT ); 762 putLV( PCPCOUNT , 0 , 0 , P2INT ); 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