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