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