1 /* Copyright (c) 1979 Regents of the University of California */ 2 3 static char sccsid[] = "@(#)fdec.c 1.3 09/02/80"; 4 5 #include "whoami.h" 6 #include "0.h" 7 #include "tree.h" 8 #include "opcode.h" 9 #include "objfmt.h" 10 #include "align.h" 11 12 /* 13 * this array keeps the pxp counters associated with 14 * functions and procedures, so that they can be output 15 * when their bodies are encountered 16 */ 17 int bodycnts[ DSPLYSZ ]; 18 19 #ifdef PC 20 # include "pc.h" 21 # include "pcops.h" 22 #endif PC 23 24 #ifdef OBJ 25 int cntpatch; 26 int nfppatch; 27 #endif OBJ 28 29 /* 30 * Funchdr inserts 31 * declaration of a the 32 * prog/proc/func into the 33 * namelist. It also handles 34 * the arguments and puts out 35 * a transfer which defines 36 * the entry point of a procedure. 37 */ 38 39 struct nl * 40 funchdr(r) 41 int *r; 42 { 43 register struct nl *p; 44 register *il, **rl; 45 int *rll; 46 struct nl *cp, *dp, *sp; 47 int s, o, *pp; 48 49 if (inpflist(r[2])) { 50 opush('l'); 51 yyretrieve(); /* kludge */ 52 } 53 pfcnt++; 54 parts[ cbn ] |= RPRT; 55 line = r[1]; 56 if (r[3] == NIL && (p=lookup1(r[2])) != NIL && bn == cbn) { 57 /* 58 * Symbol already defined 59 * in this block. it is either 60 * a redeclared symbol (error) 61 * a forward declaration, 62 * or an external declaration. 63 */ 64 if ((p->class == FUNC || p->class == PROC) && (p->nl_flags & NFORWD) != 0) { 65 /* 66 * Grammar doesnt forbid 67 * types on a resolution 68 * of a forward function 69 * declaration. 70 */ 71 if (p->class == FUNC && r[4]) 72 error("Function type should be given only in forward declaration"); 73 /* 74 * get another counter for the actual 75 */ 76 if ( monflg ) { 77 bodycnts[ cbn ] = getcnt(); 78 } 79 # ifdef PC 80 enclosing[ cbn ] = p -> symbol; 81 # endif PC 82 # ifdef PTREE 83 /* 84 * mark this proc/func as forward 85 * in the pTree. 86 */ 87 pDEF( p -> inTree ).PorFForward = TRUE; 88 # endif PTREE 89 return (p); 90 } 91 } 92 93 /* if a routine segment is being compiled, 94 * do level one processing. 95 */ 96 97 if ((r[0] != T_PROG) && (!progseen)) 98 level1(); 99 100 101 /* 102 * Declare the prog/proc/func 103 */ 104 switch (r[0]) { 105 case T_PROG: 106 progseen++; 107 if (opt('z')) 108 monflg++; 109 program = p = defnl(r[2], PROG, 0, 0); 110 p->value[3] = r[1]; 111 break; 112 case T_PDEC: 113 if (r[4] != NIL) 114 error("Procedures do not have types, only functions do"); 115 p = enter(defnl(r[2], PROC, 0, 0)); 116 p->nl_flags |= NMOD; 117 # ifdef PC 118 enclosing[ cbn ] = r[2]; 119 # endif PC 120 break; 121 case T_FDEC: 122 il = r[4]; 123 if (il == NIL) 124 error("Function type must be specified"); 125 else if (il[0] != T_TYID) { 126 il = NIL; 127 error("Function type can be specified only by using a type identifier"); 128 } else 129 il = gtype(il); 130 p = enter(defnl(r[2], FUNC, il, NIL)); 131 p->nl_flags |= NMOD; 132 /* 133 * An arbitrary restriction 134 */ 135 switch (o = classify(p->type)) { 136 case TFILE: 137 case TARY: 138 case TREC: 139 case TSET: 140 case TSTR: 141 warning(); 142 if (opt('s')) 143 standard(); 144 error("Functions should not return %ss", clnames[o]); 145 } 146 # ifdef PC 147 enclosing[ cbn ] = r[2]; 148 # endif PC 149 break; 150 default: 151 panic("funchdr"); 152 } 153 if (r[0] != T_PROG) { 154 /* 155 * Mark this proc/func as 156 * being forward declared 157 */ 158 p->nl_flags |= NFORWD; 159 /* 160 * Enter the parameters 161 * in the next block for 162 * the time being 163 */ 164 if (++cbn >= DSPLYSZ) { 165 error("Procedure/function nesting too deep"); 166 pexit(ERRS); 167 } 168 /* 169 * For functions, the function variable 170 */ 171 if (p->class == FUNC) { 172 # ifdef OBJ 173 cp = defnl(r[2], FVAR, p->type, 0); 174 # endif OBJ 175 # ifdef PC 176 /* 177 * fvars used to be allocated and deallocated 178 * by the caller right before the arguments. 179 * the offset of the fvar was kept in 180 * value[NL_OFFS] of function (very wierd, 181 * but see asgnop). 182 * now, they are locals to the function 183 * with the offset kept in the fvar. 184 */ 185 186 cp = defnl( r[2] , FVAR , p -> type 187 , -( roundup( DPOFF1+width( p -> type ) 188 , align( p -> type ) ) ) ); 189 # endif PC 190 cp->chain = p; 191 p->ptr[NL_FVAR] = cp; 192 } 193 /* 194 * Enter the parameters 195 * and compute total size 196 */ 197 cp = sp = p; 198 199 # ifdef OBJ 200 o = 0; 201 # endif OBJ 202 # ifdef PC 203 /* 204 * parameters used to be allocated backwards, 205 * then fixed. for pc, they are allocated correctly. 206 * also, they are aligned. 207 */ 208 o = DPOFF2; 209 # endif PC 210 for (rl = r[3]; rl != NIL; rl = rl[2]) { 211 p = NIL; 212 if (rl[1] == NIL) 213 continue; 214 /* 215 * Parametric procedures 216 * don't have types !?! 217 */ 218 if (rl[1][0] != T_PPROC) { 219 rll = rl[1][2]; 220 if (rll[0] != T_TYID) { 221 error("Types for arguments can be specified only by using type identifiers"); 222 p = NIL; 223 } else 224 p = gtype(rll); 225 } 226 for (il = rl[1][1]; il != NIL; il = il[2]) { 227 switch (rl[1][0]) { 228 default: 229 panic("funchdr2"); 230 case T_PVAL: 231 if (p != NIL) { 232 if (p->class == FILET) 233 error("Files cannot be passed by value"); 234 else if (p->nl_flags & NFILES) 235 error("Files cannot be a component of %ss passed by value", 236 nameof(p)); 237 } 238 # ifdef OBJ 239 dp = defnl(il[1], VAR, p, o -= even(width(p))); 240 # endif OBJ 241 # ifdef PC 242 dp = defnl( il[1] , VAR , p 243 , o = roundup( o , A_STACK ) ); 244 o += width( p ); 245 # endif PC 246 dp->nl_flags |= NMOD; 247 break; 248 case T_PVAR: 249 # ifdef OBJ 250 dp = defnl(il[1], REF, p, o -= sizeof ( int * ) ); 251 # endif OBJ 252 # ifdef PC 253 dp = defnl( il[1] , REF , p 254 , o = roundup( o , A_STACK ) ); 255 o += sizeof(char *); 256 # endif PC 257 break; 258 case T_PFUNC: 259 case T_PPROC: 260 error("Procedure/function parameters not implemented"); 261 continue; 262 } 263 if (dp != NIL) { 264 cp->chain = dp; 265 cp = dp; 266 } 267 } 268 } 269 cbn--; 270 p = sp; 271 # ifdef OBJ 272 p->value[NL_OFFS] = -o+DPOFF2; 273 /* 274 * Correct the naivete (naievity) 275 * of our above code to 276 * calculate offsets 277 */ 278 for (il = p->chain; il != NIL; il = il->chain) 279 il->value[NL_OFFS] += p->value[NL_OFFS]; 280 # endif OBJ 281 # ifdef PC 282 p -> value[ NL_OFFS ] = o; 283 # endif PC 284 } else { 285 /* 286 * The wonderful 287 * program statement! 288 */ 289 # ifdef OBJ 290 if (monflg) { 291 put(1, O_PXPBUF); 292 cntpatch = put(2, O_CASE4, 0); 293 nfppatch = put(2, O_CASE4, 0); 294 } 295 # endif OBJ 296 cp = p; 297 for (rl = r[3]; rl; rl = rl[2]) { 298 if (rl[1] == NIL) 299 continue; 300 dp = defnl(rl[1], VAR, 0, 0); 301 cp->chain = dp; 302 cp = dp; 303 } 304 } 305 /* 306 * Define a branch at 307 * the "entry point" of 308 * the prog/proc/func. 309 */ 310 p->entloc = getlab(); 311 if (monflg) { 312 bodycnts[ cbn ] = getcnt(); 313 p->value[ NL_CNTR ] = 0; 314 } 315 # ifdef OBJ 316 put(2, O_TRA4, p->entloc); 317 # endif OBJ 318 # ifdef PTREE 319 { 320 pPointer PF = tCopy( r ); 321 322 pSeize( PorFHeader[ nesting ] ); 323 if ( r[0] != T_PROG ) { 324 pPointer *PFs; 325 326 PFs = &( pDEF( PorFHeader[ nesting ] ).PorFPFs ); 327 *PFs = ListAppend( *PFs , PF ); 328 } else { 329 pDEF( PorFHeader[ nesting ] ).GlobProg = PF; 330 } 331 pRelease( PorFHeader[ nesting ] ); 332 } 333 # endif PTREE 334 return (p); 335 } 336 337 funcfwd(fp) 338 struct nl *fp; 339 { 340 341 /* 342 * save the counter for this function 343 */ 344 if ( monflg ) { 345 fp -> value[ NL_CNTR ] = bodycnts[ cbn ]; 346 } 347 return (fp); 348 } 349 350 /* 351 * Funcext marks the procedure or 352 * function external in the symbol 353 * table. Funcext should only be 354 * called if PC, and is an error 355 * otherwise. 356 */ 357 358 funcext(fp) 359 struct nl *fp; 360 { 361 362 #ifdef PC 363 if (opt('s')) { 364 standard(); 365 error("External procedures and functions are not standard"); 366 } else { 367 if (cbn == 1) { 368 fp->ext_flags |= NEXTERN; 369 stabefunc( fp -> symbol , fp -> class , line ); 370 } 371 else 372 error("External procedures and functions can only be declared at the outermost level."); 373 } 374 #endif PC 375 #ifdef OBJ 376 error("Procedures or functions cannot be declared external."); 377 #endif OBJ 378 379 return(fp); 380 } 381 382 /* 383 * Funcbody is called 384 * when the actual (resolved) 385 * declaration of a procedure is 386 * encountered. It puts the names 387 * of the (function) and parameters 388 * into the symbol table. 389 */ 390 funcbody(fp) 391 struct nl *fp; 392 { 393 register struct nl *q, *p; 394 395 cbn++; 396 if (cbn >= DSPLYSZ) { 397 error("Too many levels of function/procedure nesting"); 398 pexit(ERRS); 399 } 400 sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1; 401 gotos[cbn] = NIL; 402 errcnt[cbn] = syneflg; 403 parts[ cbn ] = NIL; 404 dfiles[ cbn ] = FALSE; 405 if (fp == NIL) 406 return (NIL); 407 /* 408 * Save the virtual name 409 * list stack pointer so 410 * the space can be freed 411 * later (funcend). 412 */ 413 fp->ptr[2] = nlp; 414 # ifdef PC 415 if ( fp -> class != PROG ) { 416 stabfunc( fp -> symbol , fp -> class , line , cbn - 1 ); 417 } else { 418 stabfunc( "program" , fp -> class , line , 0 ); 419 } 420 # endif PC 421 if (fp->class != PROG) { 422 for (q = fp->chain; q != NIL; q = q->chain) { 423 enter(q); 424 # ifdef PC 425 stabparam( q -> symbol , p2type( q -> type ) 426 , q -> value[ NL_OFFS ] 427 , lwidth( q -> type ) ); 428 # endif PC 429 } 430 } 431 if (fp->class == FUNC) { 432 /* 433 * For functions, enter the fvar 434 */ 435 enter(fp->ptr[NL_FVAR]); 436 # ifdef PC 437 q = fp -> ptr[ NL_FVAR ]; 438 sizes[cbn].om_off -= lwidth( q -> type ); 439 sizes[cbn].om_max = sizes[cbn].om_off; 440 stabvar( q -> symbol , p2type( q -> type ) , cbn 441 , q -> value[ NL_OFFS ] , lwidth( q -> type ) 442 , line ); 443 # endif PC 444 } 445 # ifdef PTREE 446 /* 447 * pick up the pointer to porf declaration 448 */ 449 PorFHeader[ ++nesting ] = fp -> inTree; 450 # endif PTREE 451 return (fp); 452 } 453 454 struct nl *Fp; 455 int pnumcnt; 456 /* 457 * Funcend is called to 458 * finish a block by generating 459 * the code for the statements. 460 * It then looks for unresolved declarations 461 * of labels, procedures and functions, 462 * and cleans up the name list. 463 * For the program, it checks the 464 * semantics of the program 465 * statement (yuchh). 466 */ 467 funcend(fp, bundle, endline) 468 struct nl *fp; 469 int *bundle; 470 int endline; 471 { 472 register struct nl *p; 473 register int i, b; 474 int var, inp, out, chkref, *blk; 475 struct nl *iop; 476 char *cp; 477 extern int cntstat; 478 # ifdef PC 479 int toplabel = getlab(); 480 int botlabel = getlab(); 481 # endif PC 482 483 cntstat = 0; 484 /* 485 * yyoutline(); 486 */ 487 if (program != NIL) 488 line = program->value[3]; 489 blk = bundle[2]; 490 if (fp == NIL) { 491 cbn--; 492 # ifdef PTREE 493 nesting--; 494 # endif PTREE 495 return; 496 } 497 #ifdef OBJ 498 /* 499 * Patch the branch to the 500 * entry point of the function 501 */ 502 patch4(fp->entloc); 503 /* 504 * Put out the block entrance code and the block name. 505 * the CONG is overlaid by a patch later! 506 */ 507 var = put(2, (lenstr(fp->symbol,0) << 8) 508 | (cbn == 1 && opt('p') == 0 ? O_NODUMP: O_BEG), 0); 509 put(2, O_CASE2, bundle[1]); 510 putstr(fp->symbol, 0); 511 #endif OBJ 512 #ifdef PC 513 /* 514 * put out the procedure entry code 515 */ 516 if ( fp -> class == PROG ) { 517 putprintf( " .text" , 0 ); 518 putprintf( " .align 1" , 0 ); 519 putprintf( " .globl _main" , 0 ); 520 putprintf( "_main:" , 0 ); 521 putprintf( " .word 0" , 0 ); 522 putprintf( " calls $0,_PCSTART" , 0 ); 523 putprintf( " movl 4(ap),__argc" , 0 ); 524 putprintf( " movl 8(ap),__argv" , 0 ); 525 putprintf( " calls $0,_program" , 0 ); 526 putprintf( " calls $0,_PCEXIT" , 0 ); 527 ftnno = fp -> entloc; 528 putprintf( " .text" , 0 ); 529 putprintf( " .align 1" , 0 ); 530 putprintf( " .globl _program" , 0 ); 531 putprintf( "_program:" , 0 ); 532 } else { 533 ftnno = fp -> entloc; 534 putprintf( " .text" , 0 ); 535 putprintf( " .align 1" , 0 ); 536 putprintf( " .globl " , 1 ); 537 for ( i = 1 ; i < cbn ; i++ ) { 538 putprintf( EXTFORMAT , 1 , enclosing[ i ] ); 539 } 540 putprintf( "" , 0 ); 541 for ( i = 1 ; i < cbn ; i++ ) { 542 putprintf( EXTFORMAT , 1 , enclosing[ i ] ); 543 } 544 putprintf( ":" , 0 ); 545 } 546 stablbrac( cbn ); 547 /* 548 * register save mask 549 */ 550 if ( opt( 't' ) ) { 551 putprintf( " .word 0x%x" , 0 , RUNCHECK | RSAVEMASK ); 552 } else { 553 putprintf( " .word 0x%x" , 0 , RSAVEMASK ); 554 } 555 putjbr( botlabel ); 556 putlab( toplabel ); 557 if ( profflag ) { 558 /* 559 * call mcount for profiling 560 */ 561 putprintf( " moval 1f,r0" , 0 ); 562 putprintf( " jsb mcount" , 0 ); 563 putprintf( " .data" , 0 ); 564 putprintf( " .align 2" , 0 ); 565 putprintf( "1:" , 0 ); 566 putprintf( " .long 0" , 0 ); 567 putprintf( " .text" , 0 ); 568 } 569 /* 570 * set up unwind exception vector. 571 */ 572 putprintf( " moval %s,%d(%s)" , 0 573 , UNWINDNAME , UNWINDOFFSET , P2FPNAME ); 574 /* 575 * save address of display entry, for unwind. 576 */ 577 putprintf( " moval %s+%d,%d(%s)" , 0 578 , DISPLAYNAME , cbn * sizeof(struct dispsave) 579 , DPTROFFSET , P2FPNAME ); 580 /* 581 * save old display 582 */ 583 putprintf( " movq %s+%d,%d(%s)" , 0 584 , DISPLAYNAME , cbn * sizeof(struct dispsave) 585 , DSAVEOFFSET , P2FPNAME ); 586 /* 587 * set up new display by saving AP and FP in appropriate 588 * slot in display structure. 589 */ 590 putprintf( " movq %s,%s+%d" , 0 591 , P2APNAME , DISPLAYNAME , cbn * sizeof(struct dispsave) ); 592 /* 593 * ask second pass to allocate known locals 594 */ 595 putlbracket( ftnno , -sizes[ cbn ].om_max ); 596 /* 597 * and zero them if checking is on 598 * by calling zframe( bytes of locals , highest local address ); 599 */ 600 if ( opt( 't' ) && ( -sizes[ cbn ].om_max ) > DPOFF1 ) { 601 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) 602 , "_ZFRAME" ); 603 putleaf( P2ICON , ( -sizes[ cbn ].om_max ) - DPOFF1 604 , 0 , P2INT , 0 ); 605 putLV( 0 , cbn , sizes[ cbn ].om_max , P2CHAR ); 606 putop( P2LISTOP , P2INT ); 607 putop( P2CALL , P2INT ); 608 putdot( filename , line ); 609 } 610 #endif PC 611 if ( monflg ) { 612 if ( fp -> value[ NL_CNTR ] != 0 ) { 613 inccnt( fp -> value [ NL_CNTR ] ); 614 } 615 inccnt( bodycnts[ fp -> nl_block & 037 ] ); 616 } 617 if (fp->class == PROG) { 618 /* 619 * The glorious buffers option. 620 * 0 = don't buffer output 621 * 1 = line buffer output 622 * 2 = 512 byte buffer output 623 */ 624 # ifdef OBJ 625 if (opt('b') != 1) 626 put(1, O_BUFF | opt('b') << 8); 627 # endif OBJ 628 # ifdef PC 629 if ( opt( 'b' ) != 1 ) { 630 putleaf( P2ICON , 0 , 0 631 , ADDTYPE( P2FTN | P2INT , P2PTR ) , "_BUFF" ); 632 putleaf( P2ICON , opt( 'b' ) , 0 , P2INT , 0 ); 633 putop( P2CALL , P2INT ); 634 putdot( filename , line ); 635 } 636 # endif PC 637 out = 0; 638 for (p = fp->chain; p != NIL; p = p->chain) { 639 if (strcmp(p->symbol, "input") == 0) { 640 inp++; 641 continue; 642 } 643 if (strcmp(p->symbol, "output") == 0) { 644 out++; 645 continue; 646 } 647 iop = lookup1(p->symbol); 648 if (iop == NIL || bn != cbn) { 649 error("File %s listed in program statement but not declared", p->symbol); 650 continue; 651 } 652 if (iop->class != VAR) { 653 error("File %s listed in program statement but declared as a %s", p->symbol, classes[iop->class]); 654 continue; 655 } 656 if (iop->type == NIL) 657 continue; 658 if (iop->type->class != FILET) { 659 error("File %s listed in program statement but defined as %s", 660 p->symbol, nameof(iop->type)); 661 continue; 662 } 663 # ifdef OBJ 664 put(2, O_LV | bn << 8+INDX, iop->value[NL_OFFS]); 665 i = lenstr(p->symbol,0); 666 put(2, O_LVCON, i); 667 putstr(p->symbol, 0); 668 do { 669 i--; 670 } while (p->symbol+i == 0); 671 put(2, O_CON24, i+1); 672 put(2, O_CON24, text(iop->type) ? 0 : width(iop->type->type)); 673 put(1, O_DEFNAME); 674 # endif OBJ 675 # ifdef PC 676 putleaf( P2ICON , 0 , 0 677 , ADDTYPE( P2FTN | P2INT , P2PTR ) 678 , "_DEFNAME" ); 679 putLV( p -> symbol , bn , iop -> value[NL_OFFS] 680 , p2type( iop ) ); 681 putCONG( p -> symbol , strlen( p -> symbol ) 682 , LREQ ); 683 putop( P2LISTOP , P2INT ); 684 putleaf( P2ICON , strlen( p -> symbol ) 685 , 0 , P2INT , 0 ); 686 putop( P2LISTOP , P2INT ); 687 putleaf( P2ICON 688 , text(iop->type) ? 0 : width(iop->type->type) 689 , 0 , P2INT , 0 ); 690 putop( P2LISTOP , P2INT ); 691 putop( P2CALL , P2INT ); 692 putdot( filename , line ); 693 # endif PC 694 } 695 if (out == 0 && fp->chain != NIL) { 696 recovered(); 697 error("The file output must appear in the program statement file list"); 698 } 699 } 700 /* 701 * Process the prog/proc/func body 702 */ 703 noreach = 0; 704 line = bundle[1]; 705 statlist(blk); 706 # ifdef PTREE 707 { 708 pPointer Body = tCopy( blk ); 709 710 pDEF( PorFHeader[ nesting -- ] ).PorFBody = Body; 711 } 712 # endif PTREE 713 # ifdef OBJ 714 if (cbn== 1 && monflg != 0) { 715 patchfil(cntpatch - 2, cnts, 2); 716 patchfil(nfppatch - 2, pfcnt, 2); 717 } 718 # endif OBJ 719 # ifdef PC 720 if ( fp -> class == PROG && monflg ) { 721 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) 722 , "_PMFLUSH" ); 723 putleaf( P2ICON , cnts , 0 , P2INT , 0 ); 724 putleaf( P2ICON , pfcnt , 0 , P2INT , 0 ); 725 putop( P2LISTOP , P2INT ); 726 putop( P2CALL , P2INT ); 727 putdot( filename , line ); 728 } 729 # endif PC 730 if (fp->class == PROG && inp == 0 && (input->nl_flags & (NUSED|NMOD)) != 0) { 731 recovered(); 732 error("Input is used but not defined in the program statement"); 733 } 734 /* 735 * Clean up the symbol table displays and check for unresolves 736 */ 737 line = endline; 738 b = cbn; 739 Fp = fp; 740 chkref = syneflg == errcnt[cbn] && opt('w') == 0; 741 for (i = 0; i <= 077; i++) { 742 for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) { 743 /* 744 * Check for variables defined 745 * but not referenced 746 */ 747 if (chkref && p->symbol != NIL) 748 switch (p->class) { 749 case FIELD: 750 /* 751 * If the corresponding record is 752 * unused, we shouldn't complain about 753 * the fields. 754 */ 755 default: 756 if ((p->nl_flags & (NUSED|NMOD)) == 0) { 757 warning(); 758 nerror("%s %s is neither used nor set", classes[p->class], p->symbol); 759 break; 760 } 761 /* 762 * If a var parameter is either 763 * modified or used that is enough. 764 */ 765 if (p->class == REF) 766 continue; 767 # ifdef OBJ 768 if ((p->nl_flags & NUSED) == 0) { 769 warning(); 770 nerror("%s %s is never used", classes[p->class], p->symbol); 771 break; 772 } 773 # endif OBJ 774 # ifdef PC 775 if (((p->nl_flags & NUSED) == 0) && ((p->ext_flags & NEXTERN) == 0)) { 776 warning(); 777 nerror("%s %s is never used", classes[p->class], p->symbol); 778 break; 779 } 780 # endif PC 781 if ((p->nl_flags & NMOD) == 0) { 782 warning(); 783 nerror("%s %s is used but never set", classes[p->class], p->symbol); 784 break; 785 } 786 case LABEL: 787 case FVAR: 788 case BADUSE: 789 break; 790 } 791 switch (p->class) { 792 case BADUSE: 793 cp = "s"; 794 if (p->chain->ud_next == NIL) 795 cp++; 796 eholdnl(); 797 if (p->value[NL_KINDS] & ISUNDEF) 798 nerror("%s undefined on line%s", p->symbol, cp); 799 else 800 nerror("%s improperly used on line%s", p->symbol, cp); 801 pnumcnt = 10; 802 pnums(p->chain); 803 pchr('\n'); 804 break; 805 806 case FUNC: 807 case PROC: 808 # ifdef OBJ 809 if ((p->nl_flags & NFORWD)) 810 nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); 811 # endif OBJ 812 # ifdef PC 813 if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0)) 814 nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); 815 # endif PC 816 break; 817 818 case LABEL: 819 if (p->nl_flags & NFORWD) 820 nerror("label %s was declared but not defined", p->symbol); 821 break; 822 case FVAR: 823 if ((p->nl_flags & NMOD) == 0) 824 nerror("No assignment to the function variable"); 825 break; 826 } 827 } 828 /* 829 * Pop this symbol 830 * table slot 831 */ 832 disptab[i] = p; 833 } 834 835 # ifdef OBJ 836 put(1, O_END); 837 # endif OBJ 838 # ifdef PC 839 /* 840 * if there were file variables declared at this level 841 * call pclose( &__disply[ cbn ] ) to clean them up. 842 */ 843 if ( dfiles[ cbn ] ) { 844 putleaf( P2ICON , 0 , 0 , ADDTYPE( P2FTN | P2INT , P2PTR ) 845 , "_PCLOSE" ); 846 putRV( DISPLAYNAME , 0 , cbn * sizeof( struct dispsave ) 847 , P2PTR | P2CHAR ); 848 putop( P2CALL , P2INT ); 849 putdot( filename , line ); 850 } 851 /* 852 * if this is a function, 853 * the function variable is the return value. 854 * if it's a scalar valued function, return scalar, 855 * else, return a pointer to the structure value. 856 */ 857 if ( fp -> class == FUNC ) { 858 struct nl *fvar = fp -> ptr[ NL_FVAR ]; 859 long fvartype = p2type( fvar -> type ); 860 861 switch ( classify( fvar -> type ) ) { 862 case TBOOL: 863 case TCHAR: 864 case TINT: 865 case TSCAL: 866 case TDOUBLE: 867 case TPTR: 868 putRV( fvar -> symbol , ( fvar -> nl_block ) & 037 869 , fvar -> value[ NL_OFFS ] , fvartype ); 870 break; 871 default: 872 putLV( fvar -> symbol , ( fvar -> nl_block ) & 037 873 , fvar -> value[ NL_OFFS ] , fvartype ); 874 break; 875 } 876 putop( P2FORCE , fvartype ); 877 putdot( filename , line ); 878 } 879 /* 880 * restore old display entry from save area 881 */ 882 883 putprintf( " movq %d(%s),%s+%d" , 0 884 , DSAVEOFFSET , P2FPNAME 885 , DISPLAYNAME , cbn * sizeof(struct dispsave) ); 886 stabrbrac( cbn ); 887 putprintf( " ret" , 0 ); 888 /* 889 * let the second pass allocate locals 890 */ 891 putlab( botlabel ); 892 putprintf( " subl2 $LF%d,sp" , 0 , ftnno ); 893 putrbracket( ftnno ); 894 putjbr( toplabel ); 895 /* 896 * declare pcp counters, if any 897 */ 898 if ( monflg && fp -> class == PROG ) { 899 putprintf( " .data" , 0 ); 900 putprintf( " .comm " , 1 ); 901 putprintf( PCPCOUNT , 1 ); 902 putprintf( ",%d" , 0 , ( cnts + 1 ) * sizeof (long) ); 903 putprintf( " .text" , 0 ); 904 } 905 # endif PC 906 #ifdef DEBUG 907 dumpnl(fp->ptr[2], fp->symbol); 908 #endif 909 /* 910 * Restore the 911 * (virtual) name list 912 * position 913 */ 914 nlfree(fp->ptr[2]); 915 /* 916 * Proc/func has been 917 * resolved 918 */ 919 fp->nl_flags &= ~NFORWD; 920 /* 921 * Patch the beg 922 * of the proc/func to 923 * the proper variable size 924 */ 925 if (Fp == NIL) 926 elineon(); 927 # ifdef OBJ 928 patchfil(var, sizes[cbn].om_max, 2); 929 # endif OBJ 930 cbn--; 931 if (inpflist(fp->symbol)) { 932 opop('l'); 933 } 934 } 935 936 937 /* 938 * Segend is called to check for 939 * unresolved variables, funcs and 940 * procs, and deliver unresolved and 941 * baduse error diagnostics at the 942 * end of a routine segment (a separately 943 * compiled segment that is not the 944 * main program) for PC. This 945 * routine should only be called 946 * by PC (not standard). 947 */ 948 segend() 949 { 950 register struct nl *p; 951 register int i,b; 952 char *cp; 953 954 #ifdef PC 955 if (opt('s')) { 956 standard(); 957 error("Separately compiled routine segments are not standard."); 958 } else { 959 b = cbn; 960 for (i=0; i<077; i++) { 961 for (p = disptab[i]; p != NIL && (p->nl_block & 037) == b; p = p->nl_next) { 962 switch (p->class) { 963 case BADUSE: 964 cp = 's'; 965 if (p->chain->ud_next == NIL) 966 cp++; 967 eholdnl(); 968 if (p->value[NL_KINDS] & ISUNDEF) 969 nerror("%s undefined on line%s", p->symbol, cp); 970 else 971 nerror("%s improperly used on line%s", p->symbol, cp); 972 pnumcnt = 10; 973 pnums(p->chain); 974 pchr('\n'); 975 break; 976 977 case FUNC: 978 case PROC: 979 if ((p->nl_flags & NFORWD) && ((p->ext_flags & NEXTERN) == 0)) 980 nerror("Unresolved forward declaration of %s %s", classes[p->class], p->symbol); 981 break; 982 983 case FVAR: 984 if (((p->nl_flags & NMOD) == 0) && ((p->chain->ext_flags & NEXTERN) == 0)) 985 nerror("No assignment to the function variable"); 986 break; 987 } 988 } 989 disptab[i] = p; 990 } 991 } 992 #endif PC 993 #ifdef OBJ 994 error("Missing program statement and program body"); 995 #endif OBJ 996 997 } 998 999 1000 /* 1001 * Level1 does level one processing for 1002 * separately compiled routine segments 1003 */ 1004 level1() 1005 { 1006 1007 # ifdef OBJ 1008 error("Missing program statement"); 1009 # endif OBJ 1010 # ifdef PC 1011 if (opt('s')) { 1012 standard(); 1013 error("Missing program statement"); 1014 } 1015 # endif PC 1016 1017 cbn++; 1018 sizes[cbn].om_max = sizes[cbn].om_off = -DPOFF1; 1019 gotos[cbn] = NIL; 1020 errcnt[cbn] = syneflg; 1021 parts[ cbn ] = NIL; 1022 dfiles[ cbn ] = FALSE; 1023 progseen++; 1024 } 1025 1026 1027 1028 pnums(p) 1029 struct udinfo *p; 1030 { 1031 1032 if (p->ud_next != NIL) 1033 pnums(p->ud_next); 1034 if (pnumcnt == 0) { 1035 printf("\n\t"); 1036 pnumcnt = 20; 1037 } 1038 pnumcnt--; 1039 printf(" %d", p->ud_line); 1040 } 1041 1042 nerror(a1, a2, a3) 1043 { 1044 1045 if (Fp != NIL) { 1046 yySsync(); 1047 #ifndef PI1 1048 if (opt('l')) 1049 yyoutline(); 1050 #endif 1051 yysetfile(filename); 1052 printf("In %s %s:\n", classes[Fp->class], Fp->symbol); 1053 Fp = NIL; 1054 elineoff(); 1055 } 1056 error(a1, a2, a3); 1057 } 1058