1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 static char sccsid[] = "@(#)fdec.c 1.12 01/16/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 if (fp->class != PROG) { 434 for (q = fp->chain; q != NIL; q = q->chain) { 435 enter(q); 436 } 437 } 438 if (fp->class == FUNC) { 439 /* 440 * For functions, enter the fvar 441 */ 442 enter(fp->ptr[NL_FVAR]); 443 # ifdef PC 444 q = fp -> ptr[ NL_FVAR ]; 445 sizes[cbn].om_off -= lwidth( q -> type ); 446 sizes[cbn].om_max = sizes[cbn].om_off; 447 # endif PC 448 } 449 # ifdef PTREE 450 /* 451 * pick up the pointer to porf declaration 452 */ 453 PorFHeader[ ++nesting ] = fp -> inTree; 454 # endif PTREE 455 return (fp); 456 } 457 458 struct nl *Fp; 459 int pnumcnt; 460 /* 461 * Funcend is called to 462 * finish a block by generating 463 * the code for the statements. 464 * It then looks for unresolved declarations 465 * of labels, procedures and functions, 466 * and cleans up the name list. 467 * For the program, it checks the 468 * semantics of the program 469 * statement (yuchh). 470 */ 471 funcend(fp, bundle, endline) 472 struct nl *fp; 473 int *bundle; 474 int endline; 475 { 476 register struct nl *p; 477 register int i, b; 478 int var, inp, out, chkref, *blk; 479 struct nl *iop; 480 char *cp; 481 extern int cntstat; 482 # ifdef PC 483 int toplabel = getlab(); 484 int botlabel = getlab(); 485 # endif PC 486 487 cntstat = 0; 488 /* 489 * yyoutline(); 490 */ 491 if (program != NIL) 492 line = program->value[3]; 493 blk = bundle[2]; 494 if (fp == NIL) { 495 cbn--; 496 # ifdef PTREE 497 nesting--; 498 # endif PTREE 499 return; 500 } 501 #ifdef OBJ 502 /* 503 * Patch the branch to the 504 * entry point of the function 505 */ 506 patch4(fp->entloc); 507 /* 508 * Put out the block entrance code and the block name. 509 * the CONG is overlaid by a patch later! 510 */ 511 var = put(2, (lenstr(fp->symbol,0) << 8) 512 | (cbn == 1 && opt('p') == 0 ? O_NODUMP: O_BEG), 0); 513 /* 514 * output the number of bytes of arguments 515 * this is only checked on formal calls. 516 */ 517 put(2, O_CASE4, cbn == 1 ? 0 : fp->value[NL_OFFS]-DPOFF2); 518 /* 519 * Output the runtime test mode for the routine 520 */ 521 if (opt('t')) 522 put(2, O_CASE2, TRUE); 523 else 524 put(2, O_CASE2, FALSE); 525 /* 526 * Output line number and routine name 527 */ 528 put(2, O_CASE2, bundle[1]); 529 putstr(fp->symbol, 0); 530 #endif OBJ 531 #ifdef PC 532 /* 533 * put out the procedure entry code 534 */ 535 if ( fp -> class == PROG ) { 536 putprintf( " .text" , 0 ); 537 putprintf( " .align 1" , 0 ); 538 putprintf( " .globl _main" , 0 ); 539 putprintf( "_main:" , 0 ); 540 putprintf( " .word 0" , 0 ); 541 putprintf( " calls $0,_PCSTART" , 0 ); 542 putprintf( " movl 4(ap),__argc" , 0 ); 543 putprintf( " movl 8(ap),__argv" , 0 ); 544 putprintf( " calls $0,_program" , 0 ); 545 putprintf( " calls $0,_PCEXIT" , 0 ); 546 ftnno = fp -> entloc; 547 putprintf( " .text" , 0 ); 548 putprintf( " .align 1" , 0 ); 549 putprintf( " .globl _program" , 0 ); 550 putprintf( "_program:" , 0 ); 551 stabfunc( "program" , fp -> class , bundle[1] , 0 ); 552 } else { 553 ftnno = fp -> entloc; 554 putprintf( " .text" , 0 ); 555 putprintf( " .align 1" , 0 ); 556 putprintf( " .globl " , 1 ); 557 for ( i = 1 ; i < cbn ; i++ ) { 558 putprintf( EXTFORMAT , 1 , enclosing[ i ] ); 559 } 560 putprintf( "" , 0 ); 561 for ( i = 1 ; i < cbn ; i++ ) { 562 putprintf( EXTFORMAT , 1 , enclosing[ i ] ); 563 } 564 putprintf( ":" , 0 ); 565 stabfunc( fp -> symbol , fp -> class , bundle[1] , cbn - 1 ); 566 for ( p = fp -> chain ; p != NIL ; p = p -> chain ) { 567 stabparam( p -> symbol , p2type( p -> type ) 568 , p -> value[ NL_OFFS ] , lwidth( p -> type ) ); 569 } 570 if ( fp -> class == FUNC ) { 571 /* 572 * stab the function variable 573 */ 574 p = fp -> ptr[ NL_FVAR ]; 575 stablvar( p -> symbol , p2type( p -> type ) , cbn 576 , p -> value[ NL_OFFS ] , lwidth( p -> type ) ); 577 } 578 /* 579 * stab local variables 580 * rummage down hash chain links. 581 */ 582 for ( i = 0 ; i <= 077 ; i++ ) { 583 for ( p = disptab[ i ] ; p != NIL ; p = p->nl_next) { 584 if ( ( p -> nl_block & 037 ) != cbn ) { 585 break; 586 } 587 /* 588 * stab local variables 589 * that's named variables, but not params 590 */ 591 if ( ( p -> symbol != NIL ) 592 && ( p -> class == VAR ) 593 && ( p -> value[ NL_OFFS ] < 0 ) ) { 594 stablvar( p -> symbol , p2type( p -> type ) , cbn 595 , p -> value[ NL_OFFS ] , lwidth( p -> type ) ); 596 } 597 } 598 } 599 } 600 stablbrac( cbn ); 601 /* 602 * register save mask 603 */ 604 if ( opt( 't' ) ) { 605 putprintf( " .word 0x%x" , 0 , RUNCHECK | RSAVEMASK ); 606 } else { 607 putprintf( " .word 0x%x" , 0 , RSAVEMASK ); 608 } 609 putjbr( botlabel ); 610 putlab( toplabel ); 611 if ( profflag ) { 612 /* 613 * call mcount for profiling 614 */ 615 putprintf( " moval 1f,r0" , 0 ); 616 putprintf( " jsb mcount" , 0 ); 617 putprintf( " .data" , 0 ); 618 putprintf( " .align 2" , 0 ); 619 putprintf( "1:" , 0 ); 620 putprintf( " .long 0" , 0 ); 621 putprintf( " .text" , 0 ); 622 } 623 /* 624 * set up unwind exception vector. 625 */ 626 putprintf( " moval %s,%d(%s)" , 0 627 , UNWINDNAME , UNWINDOFFSET , P2FPNAME ); 628 /* 629 * save address of display entry, for unwind. 630 */ 631 putprintf( " moval %s+%d,%d(%s)" , 0 632 , DISPLAYNAME , cbn * sizeof(struct dispsave) 633 , DPTROFFSET , P2FPNAME ); 634 /* 635 * save old display 636 */ 637 putprintf( " movq %s+%d,%d(%s)" , 0 638 , DISPLAYNAME , cbn * sizeof(struct dispsave) 639 , DSAVEOFFSET , P2FPNAME ); 640 /* 641 * set up new display by saving AP and FP in appropriate 642 * slot in display structure. 643 */ 644 putprintf( " movq %s,%s+%d" , 0 645 , P2APNAME , DISPLAYNAME , cbn * sizeof(struct dispsave) ); 646 /* 647 * ask second pass to allocate known locals 648 */ 649 putlbracket( ftnno , -sizes[ cbn ].om_max ); 650 /* 651 * and zero them if checking is on 652 * by calling blkclr( bytes of locals , starting local address ); 653 */ 654 if ( opt( 't' ) ) { 655 if ( ( -sizes[ cbn ].om_max ) > DPOFF1 ) { 656 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) 657 , "_blkclr" ); 658 putleaf( P2ICON , ( -sizes[ cbn ].om_max ) - DPOFF1 659 , 0 , P2INT , 0 ); 660 putLV( 0 , cbn , sizes[ cbn ].om_max , P2CHAR ); 661 putop( P2LISTOP , P2INT ); 662 putop( P2CALL , P2INT ); 663 putdot( filename , line ); 664 } 665 /* 666 * check number of longs of arguments 667 * this can only be wrong for formal calls. 668 */ 669 if ( fp -> class != PROG ) { 670 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2PTR , P2FTN | P2INT ) , 671 "_NARGCHK" ); 672 putleaf( P2ICON , 673 (fp->value[NL_OFFS] - DPOFF2) / sizeof(long) , 674 0 , P2INT , 0 ); 675 putop( P2CALL , P2INT ); 676 putdot( filename , line ); 677 } 678 } 679 #endif PC 680 if ( monflg ) { 681 if ( fp -> value[ NL_CNTR ] != 0 ) { 682 inccnt( fp -> value [ NL_CNTR ] ); 683 } 684 inccnt( bodycnts[ fp -> nl_block & 037 ] ); 685 } 686 if (fp->class == PROG) { 687 /* 688 * The glorious buffers option. 689 * 0 = don't buffer output 690 * 1 = line buffer output 691 * 2 = 512 byte buffer output 692 */ 693 # ifdef OBJ 694 if (opt('b') != 1) 695 put(1, O_BUFF | opt('b') << 8); 696 # endif OBJ 697 # ifdef PC 698 if ( opt( 'b' ) != 1 ) { 699 putleaf( P2ICON , 0 , 0 700 , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_BUFF" ); 701 putleaf( P2ICON , opt( 'b' ) , 0 , P2INT , 0 ); 702 putop( P2CALL , P2INT ); 703 putdot( filename , line ); 704 } 705 # endif PC 706 out = 0; 707 for (p = fp->chain; p != NIL; p = p->chain) { 708 if (strcmp(p->symbol, "input") == 0) { 709 inp++; 710 continue; 711 } 712 if (strcmp(p->symbol, "output") == 0) { 713 out++; 714 continue; 715 } 716 iop = lookup1(p->symbol); 717 if (iop == NIL || bn != cbn) { 718 error("File %s listed in program statement but not declared", p->symbol); 719 continue; 720 } 721 if (iop->class != VAR) { 722 error("File %s listed in program statement but declared as a %s", p->symbol, classes[iop->class]); 723 continue; 724 } 725 if (iop->type == NIL) 726 continue; 727 if (iop->type->class != FILET) { 728 error("File %s listed in program statement but defined as %s", 729 p->symbol, nameof(iop->type)); 730 continue; 731 } 732 # ifdef OBJ 733 put(2, O_CON24, text(iop->type) ? 0 : width(iop->type->type)); 734 i = lenstr(p->symbol,0); 735 put(2, O_CON24, i); 736 put(2, O_LVCON, i); 737 putstr(p->symbol, 0); 738 put(2, O_LV | bn << 8+INDX, iop->value[NL_OFFS]); 739 put(1, O_DEFNAME); 740 # endif OBJ 741 # ifdef PC 742 putleaf( P2ICON , 0 , 0 743 , ADDTYPE( P2FTN | P2INT , P2PTR ) 744 , "_DEFNAME" ); 745 putLV( p -> symbol , bn , iop -> value[NL_OFFS] 746 , p2type( iop ) ); 747 putCONG( p -> symbol , strlen( p -> symbol ) 748 , LREQ ); 749 putop( P2LISTOP , P2INT ); 750 putleaf( P2ICON , strlen( p -> symbol ) 751 , 0 , P2INT , 0 ); 752 putop( P2LISTOP , P2INT ); 753 putleaf( P2ICON 754 , text(iop->type) ? 0 : width(iop->type->type) 755 , 0 , P2INT , 0 ); 756 putop( P2LISTOP , P2INT ); 757 putop( P2CALL , P2INT ); 758 putdot( filename , line ); 759 # endif PC 760 } 761 if (out == 0 && fp->chain != NIL) { 762 recovered(); 763 error("The file output must appear in the program statement file list"); 764 } 765 } 766 /* 767 * Process the prog/proc/func body 768 */ 769 noreach = 0; 770 line = bundle[1]; 771 statlist(blk); 772 # ifdef PTREE 773 { 774 pPointer Body = tCopy( blk ); 775 776 pDEF( PorFHeader[ nesting -- ] ).PorFBody = Body; 777 } 778 # endif PTREE 779 # ifdef OBJ 780 if (cbn== 1 && monflg != 0) { 781 patchfil(cntpatch - 2, cnts, 2); 782 patchfil(nfppatch - 2, pfcnt, 2); 783 } 784 # endif OBJ 785 # ifdef PC 786 if ( fp -> class == PROG && monflg ) { 787 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) 788 , "_PMFLUSH" ); 789 putleaf( P2ICON , cnts , 0 , P2INT , 0 ); 790 putleaf( P2ICON , pfcnt , 0 , P2INT , 0 ); 791 putop( P2LISTOP , P2INT ); 792 putLV( PCPCOUNT , 0 , 0 , P2INT ); 793 putop( P2LISTOP , P2INT ); 794 putop( P2CALL , P2INT ); 795 putdot( filename , line ); 796 } 797 # endif PC 798 if (fp->class == PROG && inp == 0 && (input->nl_flags & (NUSED|NMOD)) != 0) { 799 recovered(); 800 error("Input is used but not defined in the program statement"); 801 } 802 /* 803 * Clean up the symbol table displays and check for unresolves 804 */ 805 line = endline; 806 b = cbn; 807 Fp = fp; 808 chkref = syneflg == errcnt[cbn] && opt('w') == 0; 809 for (i = 0; i <= 077; i++) { 810 for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) { 811 /* 812 * Check for variables defined 813 * but not referenced 814 */ 815 if (chkref && p->symbol != NIL) 816 switch (p->class) { 817 case FIELD: 818 /* 819 * If the corresponding record is 820 * unused, we shouldn't complain about 821 * the fields. 822 */ 823 default: 824 if ((p->nl_flags & (NUSED|NMOD)) == 0) { 825 warning(); 826 nerror("%s %s is neither used nor set", classes[p->class], p->symbol); 827 break; 828 } 829 /* 830 * If a var parameter is either 831 * modified or used that is enough. 832 */ 833 if (p->class == REF) 834 continue; 835 # ifdef OBJ 836 if ((p->nl_flags & NUSED) == 0) { 837 warning(); 838 nerror("%s %s is never used", classes[p->class], p->symbol); 839 break; 840 } 841 # endif OBJ 842 # ifdef PC 843 if (((p->nl_flags & NUSED) == 0) && ((p->ext_flags & NEXTERN) == 0)) { 844 warning(); 845 nerror("%s %s is never used", classes[p->class], p->symbol); 846 break; 847 } 848 # endif PC 849 if ((p->nl_flags & NMOD) == 0) { 850 warning(); 851 nerror("%s %s is used but never set", classes[p->class], p->symbol); 852 break; 853 } 854 case LABEL: 855 case FVAR: 856 case BADUSE: 857 break; 858 } 859 switch (p->class) { 860 case BADUSE: 861 cp = "s"; 862 if (p->chain->ud_next == NIL) 863 cp++; 864 eholdnl(); 865 if (p->value[NL_KINDS] & ISUNDEF) 866 nerror("%s undefined on line%s", p->symbol, cp); 867 else 868 nerror("%s improperly used on line%s", p->symbol, cp); 869 pnumcnt = 10; 870 pnums(p->chain); 871 pchr('\n'); 872 break; 873 874 case FUNC: 875 case PROC: 876 # ifdef OBJ 877 if ((p->nl_flags & NFORWD)) 878 nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); 879 # endif OBJ 880 # ifdef PC 881 if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0)) 882 nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); 883 # endif PC 884 break; 885 886 case LABEL: 887 if (p->nl_flags & NFORWD) 888 nerror("label %s was declared but not defined", p->symbol); 889 break; 890 case FVAR: 891 if ((p->nl_flags & NMOD) == 0) 892 nerror("No assignment to the function variable"); 893 break; 894 } 895 } 896 /* 897 * Pop this symbol 898 * table slot 899 */ 900 disptab[i] = p; 901 } 902 903 # ifdef OBJ 904 put(1, O_END); 905 # endif OBJ 906 # ifdef PC 907 /* 908 * if there were file variables declared at this level 909 * call pclose( &__disply[ cbn ] ) to clean them up. 910 */ 911 if ( dfiles[ cbn ] ) { 912 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) 913 , "_PCLOSE" ); 914 putRV( DISPLAYNAME , 0 , cbn * sizeof( struct dispsave ) 915 , P2PTR | P2CHAR ); 916 putop( P2CALL , P2INT ); 917 putdot( filename , line ); 918 } 919 /* 920 * if this is a function, 921 * the function variable is the return value. 922 * if it's a scalar valued function, return scalar, 923 * else, return a pointer to the structure value. 924 */ 925 if ( fp -> class == FUNC ) { 926 struct nl *fvar = fp -> ptr[ NL_FVAR ]; 927 long fvartype = p2type( fvar -> type ); 928 long label; 929 char labelname[ BUFSIZ ]; 930 931 switch ( classify( fvar -> type ) ) { 932 case TBOOL: 933 case TCHAR: 934 case TINT: 935 case TSCAL: 936 case TDOUBLE: 937 case TPTR: 938 putRV( fvar -> symbol , ( fvar -> nl_block ) & 037 939 , fvar -> value[ NL_OFFS ] , fvartype ); 940 break; 941 default: 942 label = getlab(); 943 sprintf( labelname , PREFIXFORMAT , 944 LABELPREFIX , label ); 945 putprintf( " .data" , 0 ); 946 putprintf( " .lcomm %s,%d" , 0 , 947 labelname , lwidth( fvar -> type ) ); 948 putprintf( " .text" , 0 ); 949 putleaf( P2NAME , 0 , 0 , fvartype , labelname ); 950 putLV( fvar -> symbol , ( fvar -> nl_block ) & 037 951 , fvar -> value[ NL_OFFS ] , fvartype ); 952 putstrop( P2STASG , fvartype , lwidth( fvar -> type ) , 953 align( fvar -> type ) ); 954 putdot( filename , line ); 955 putleaf( P2ICON , 0 , 0 , fvartype , labelname ); 956 break; 957 } 958 putop( P2FORCE , fvartype ); 959 putdot( filename , line ); 960 } 961 /* 962 * restore old display entry from save area 963 */ 964 965 putprintf( " movq %d(%s),%s+%d" , 0 966 , DSAVEOFFSET , P2FPNAME 967 , DISPLAYNAME , cbn * sizeof(struct dispsave) ); 968 stabrbrac( cbn ); 969 putprintf( " ret" , 0 ); 970 /* 971 * let the second pass allocate locals 972 */ 973 putlab( botlabel ); 974 putprintf( " subl2 $LF%d,sp" , 0 , ftnno ); 975 putrbracket( ftnno ); 976 putjbr( toplabel ); 977 /* 978 * declare pcp counters, if any 979 */ 980 if ( monflg && fp -> class == PROG ) { 981 putprintf( " .data" , 0 ); 982 putprintf( " .comm " , 1 ); 983 putprintf( PCPCOUNT , 1 ); 984 putprintf( ",%d" , 0 , ( cnts + 1 ) * sizeof (long) ); 985 putprintf( " .text" , 0 ); 986 } 987 # endif PC 988 #ifdef DEBUG 989 dumpnl(fp->ptr[2], fp->symbol); 990 #endif 991 /* 992 * Restore the 993 * (virtual) name list 994 * position 995 */ 996 nlfree(fp->ptr[2]); 997 /* 998 * Proc/func has been 999 * resolved 1000 */ 1001 fp->nl_flags &= ~NFORWD; 1002 /* 1003 * Patch the beg 1004 * of the proc/func to 1005 * the proper variable size 1006 */ 1007 if (Fp == NIL) 1008 elineon(); 1009 # ifdef OBJ 1010 patchfil(var, -sizes[cbn].om_max, 2); 1011 # endif OBJ 1012 cbn--; 1013 if (inpflist(fp->symbol)) { 1014 opop('l'); 1015 } 1016 } 1017 1018 1019 /* 1020 * Segend is called to check for 1021 * unresolved variables, funcs and 1022 * procs, and deliver unresolved and 1023 * baduse error diagnostics at the 1024 * end of a routine segment (a separately 1025 * compiled segment that is not the 1026 * main program) for PC. This 1027 * routine should only be called 1028 * by PC (not standard). 1029 */ 1030 segend() 1031 { 1032 register struct nl *p; 1033 register int i,b; 1034 char *cp; 1035 1036 #ifdef PC 1037 if (opt('s')) { 1038 standard(); 1039 error("Separately compiled routine segments are not standard."); 1040 } else { 1041 b = cbn; 1042 for (i=0; i<077; i++) { 1043 for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) { 1044 switch (p->class) { 1045 case BADUSE: 1046 cp = 's'; 1047 if (p->chain->ud_next == NIL) 1048 cp++; 1049 eholdnl(); 1050 if (p->value[NL_KINDS] & ISUNDEF) 1051 nerror("%s undefined on line%s", p->symbol, cp); 1052 else 1053 nerror("%s improperly used on line%s", p->symbol, cp); 1054 pnumcnt = 10; 1055 pnums(p->chain); 1056 pchr('\n'); 1057 break; 1058 1059 case FUNC: 1060 case PROC: 1061 if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0)) 1062 nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); 1063 break; 1064 1065 case FVAR: 1066 if (((p->nl_flags & NMOD) == 0) && ((p->chain->ext_flags & NEXTERN) == 0)) 1067 nerror("No assignment to the function variable"); 1068 break; 1069 } 1070 } 1071 disptab[i] = p; 1072 } 1073 } 1074 #endif PC 1075 #ifdef OBJ 1076 error("Missing program statement and program body"); 1077 #endif OBJ 1078 1079 } 1080 1081 1082 /* 1083 * Level1 does level one processing for 1084 * separately compiled routine segments 1085 */ 1086 level1() 1087 { 1088 1089 # ifdef OBJ 1090 error("Missing program statement"); 1091 # endif OBJ 1092 # ifdef PC 1093 if (opt('s')) { 1094 standard(); 1095 error("Missing program statement"); 1096 } 1097 # endif PC 1098 1099 cbn++; 1100 sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1; 1101 gotos[cbn] = NIL; 1102 errcnt[cbn] = syneflg; 1103 parts[ cbn ] = NIL; 1104 dfiles[ cbn ] = FALSE; 1105 progseen++; 1106 } 1107 1108 1109 1110 pnums(p) 1111 struct udinfo *p; 1112 { 1113 1114 if (p->ud_next != NIL) 1115 pnums(p->ud_next); 1116 if (pnumcnt == 0) { 1117 printf("\n\t"); 1118 pnumcnt = 20; 1119 } 1120 pnumcnt--; 1121 printf(" %d", p->ud_line); 1122 } 1123 1124 nerror(a1, a2, a3) 1125 { 1126 1127 if (Fp != NIL) { 1128 yySsync(); 1129 #ifndef PI1 1130 if (opt('l')) 1131 yyoutline(); 1132 #endif 1133 yysetfile(filename); 1134 printf("In %s %s:\n", classes[Fp->class], Fp->symbol); 1135 Fp = NIL; 1136 elineoff(); 1137 } 1138 error(a1, a2, a3); 1139 } 1140