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