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