1: #if !defined(lint) && defined(DOSCCS)
   2: static char *sccsid ="@(#)pftn.c	1.12.1 (2.11BSD GTE) 1/17/95";
   3: #endif lint
   4: 
   5: # include "pass1.h"
   6: 
   7: OFFSZ offsz;
   8: 
   9: struct symtab *schain[MAXSCOPES];   /* sym chains for clearst */
  10: int chaintop;               /* highest active entry */
  11: 
  12: struct instk {
  13:     OFFSZ in_sz; /* size of array element */
  14:     int in_x;    /* current index for structure member in structure initializations */
  15:     int in_n;    /* number of initializations seen */
  16:     int in_s;    /* sizoff */
  17:     int in_d;    /* dimoff */
  18:     TWORD in_t;    /* type */
  19:     int in_id;   /* stab index */
  20:     int in_fl;   /* flag which says if this level is controlled by {} */
  21:     OFFSZ in_off;  /* offset of the beginning of this level */
  22:     }
  23: instack[10],
  24: *pstk;
  25: 
  26:     /* defines used for getting things off of the initialization stack */
  27: 
  28: 
  29: struct symtab *relook();
  30: 
  31: 
  32: int ddebug = 0;
  33: 
  34: struct symtab * mknonuniq();
  35: 
  36: defid( q, class ) register NODE *q; register int class; {
  37:     register struct symtab *p;
  38:     int idp;
  39:     register TWORD type;
  40:     TWORD stp;
  41:     register int scl;
  42:     int dsym, ddef;
  43:     int slev, temp;
  44:     int changed;
  45: 
  46:     if( q == NIL ) return;  /* an error was detected */
  47: 
  48:     if( q < node || q >= &node[TREESZ] ) cerror("defid call" );
  49: 
  50:     idp = q->tn.rval;
  51: 
  52:     if( idp < 0 ) cerror("tyreduce" );
  53:     p = &stab[idp];
  54: 
  55: # ifndef BUG1
  56:     if( ddebug ){
  57: #ifndef FLEXNAMES
  58:         printf( "defid( %.8s (%d), ", p->sname, idp );
  59: #else
  60:         printf( "defid( %s (%d), ", p->sname, idp );
  61: #endif
  62:         tprint( q->in.type );
  63:         printf( ", %s, (%d,%d) ), level %d\n", scnames(class), q->fn.cdim, q->fn.csiz, blevel );
  64:         }
  65: # endif
  66: 
  67:     fixtype( q, class );
  68: 
  69:     type = q->in.type;
  70:     class = fixclass( class, type );
  71: 
  72:     stp = p->stype;
  73:     slev = p->slevel;
  74: 
  75: # ifndef BUG1
  76:     if( ddebug ){
  77:         printf( "	modified to " );
  78:         tprint( type );
  79:         printf( ", %s\n", scnames(class) );
  80:         printf( "	previous def'n: " );
  81:         tprint( stp );
  82:         printf( ", %s, (%d,%d) ), level %d\n", scnames(p->sclass), p->dimoff, p->sizoff, slev );
  83:         }
  84: # endif
  85: 
  86:     if( stp == FTN && p->sclass == SNULL )goto enter;
  87:         /* name encountered as function, not yet defined */
  88:     if( stp == UNDEF|| stp == FARG ){
  89:         if( blevel==1 && stp!=FARG ) switch( class ){
  90: 
  91:         default:
  92: #ifndef FLEXNAMES
  93:             if(!(class&FIELD)) uerror("declared argument %.8s is missing", p->sname );
  94: #else
  95:             if(!(class&FIELD)) uerror("declared argument %s is missing", p->sname );
  96: #endif
  97:         case MOS:
  98:         case STNAME:
  99:         case MOU:
 100:         case UNAME:
 101:         case MOE:
 102:         case ENAME:
 103:         case TYPEDEF:
 104:             ;
 105:             }
 106:         goto enter;
 107:         }
 108: 
 109:     if( type != stp ) goto mismatch;
 110:     /* test (and possibly adjust) dimensions */
 111:     dsym = p->dimoff;
 112:     ddef = q->fn.cdim;
 113:     changed = 0;
 114:     for( temp=type; temp&TMASK; temp = DECREF(temp) ){
 115:         if( ISARY(temp) ){
 116:             if (dimtab[dsym] == 0) {
 117:                 dimtab[dsym] = dimtab[ddef];
 118:                 changed = 1;
 119:                 }
 120:             else if (dimtab[ddef]!=0&&dimtab[dsym]!=dimtab[ddef]) {
 121:                 goto mismatch;
 122:                 }
 123:             ++dsym;
 124:             ++ddef;
 125:             }
 126:         }
 127: 
 128:     if (changed) {
 129:         FIXDEF(p);
 130:         }
 131: 
 132:     /* check that redeclarations are to the same structure */
 133:     if( (temp==STRTY||temp==UNIONTY||temp==ENUMTY) && p->sizoff != q->fn.csiz
 134:          && class!=STNAME && class!=UNAME && class!=ENAME ){
 135:         goto mismatch;
 136:         }
 137: 
 138:     scl = ( p->sclass );
 139: 
 140: # ifndef BUG1
 141:     if( ddebug ){
 142:         printf( "	previous class: %s\n", scnames(scl) );
 143:         }
 144: # endif
 145: 
 146:     if( class&FIELD ){
 147:         /* redefinition */
 148:         if( !falloc( p, class&FLDSIZ, 1, NIL ) ) {
 149:             /* successful allocation */
 150:             psave( (OFFSZ)idp );
 151:             return;
 152:             }
 153:         /* blew it: resume at end of switch... */
 154:         }
 155: 
 156:     else switch( class ){
 157: 
 158:     case EXTERN:
 159:         switch( scl ){
 160:         case STATIC:
 161:         case USTATIC:
 162:             if( slev==0 ) return;
 163:             break;
 164:         case EXTDEF:
 165:         case EXTERN:
 166:         case FORTRAN:
 167:         case UFORTRAN:
 168:             return;
 169:             }
 170:         break;
 171: 
 172:     case STATIC:
 173:         if( scl==USTATIC || (scl==EXTERN && blevel==0) ){
 174:             p->sclass = STATIC;
 175:             if( ISFTN(type) ) curftn = idp;
 176:             return;
 177:             }
 178:         break;
 179: 
 180:     case USTATIC:
 181:         if( scl==STATIC || scl==USTATIC ) return;
 182:         break;
 183: 
 184:     case LABEL:
 185:         if( scl == ULABEL ){
 186:             p->sclass = LABEL;
 187:             deflab( (int)p->offset );
 188:             return;
 189:             }
 190:         break;
 191: 
 192:     case TYPEDEF:
 193:         if( scl == class ) return;
 194:         break;
 195: 
 196:     case UFORTRAN:
 197:         if( scl == UFORTRAN || scl == FORTRAN ) return;
 198:         break;
 199: 
 200:     case FORTRAN:
 201:         if( scl == UFORTRAN ){
 202:             p->sclass = FORTRAN;
 203:             if( ISFTN(type) ) curftn = idp;
 204:             return;
 205:             }
 206:         break;
 207: 
 208:     case MOU:
 209:     case MOS:
 210:         if( scl == class ) {
 211:             if( oalloc( p, &strucoff ) ) break;
 212:             if( class == MOU ) strucoff = 0;
 213:             psave( (OFFSZ)idp );
 214:             return;
 215:             }
 216:         break;
 217: 
 218:     case MOE:
 219:         if( scl == class ){
 220:             if( p->offset!= strucoff++ ) break;
 221:             psave( (OFFSZ)idp );
 222:             }
 223:         break;
 224: 
 225:     case EXTDEF:
 226:         if( scl == EXTERN ) {
 227:             p->sclass = EXTDEF;
 228:             if( ISFTN(type) ) curftn = idp;
 229:             return;
 230:             }
 231:         break;
 232: 
 233:     case STNAME:
 234:     case UNAME:
 235:     case ENAME:
 236:         if( scl != class ) break;
 237:         if( dimtab[p->sizoff] == 0 ) return;  /* previous entry just a mention */
 238:         break;
 239: 
 240:     case ULABEL:
 241:         if( scl == LABEL || scl == ULABEL ) return;
 242:     case PARAM:
 243:     case AUTO:
 244:     case REGISTER:
 245:         ;  /* mismatch.. */
 246: 
 247:         }
 248: 
 249:     mismatch:
 250:     /* allow nonunique structure/union member names */
 251: 
 252:     if( class==MOU || class==MOS || class & FIELD ){/* make a new entry */
 253:         register OFFSZ *memp;
 254:         p->sflags |= SNONUNIQ;  /* old entry is nonunique */
 255:         /* determine if name has occurred in this structure/union */
 256:         if (paramno > 0) for( memp = &paramstk[paramno-1];
 257:             /* while */ *memp>=0 && stab[*memp].sclass != STNAME
 258:                 && stab[*memp].sclass != UNAME;
 259:             /* iterate */ --memp){ char *cname, *oname;
 260:             if( stab[*memp].sflags & SNONUNIQ ){int k;
 261:                 cname=p->sname;
 262:                 oname=stab[*memp].sname;
 263: #ifndef FLEXNAMES
 264:                 for(k=1; k<=NCHNAM; ++k){
 265:                     if(*cname++ != *oname)goto diff;
 266:                     if(!*oname++)break;
 267:                     }
 268: #else
 269:                 if (cname != oname) goto diff;
 270: #endif
 271:                 uerror("redeclaration of: %s",p->sname);
 272:                 break;
 273:                 diff: continue;
 274:                 }
 275:             }
 276:         p = mknonuniq( &idp ); /* update p and idp to new entry */
 277:         goto enter;
 278:         }
 279:     if( blevel > slev && class != EXTERN && class != FORTRAN &&
 280:         class != UFORTRAN && !( class == LABEL && slev >= 2 ) ){
 281:         q->tn.rval = idp = hide( p );
 282:         p = &stab[idp];
 283:         goto enter;
 284:         }
 285: #ifndef FLEXNAMES
 286:     uerror("redeclaration of %.8s", p->sname );
 287: #else
 288:     uerror("redeclaration of %s", p->sname );
 289: #endif
 290:     if( class==EXTDEF && ISFTN(type) ) curftn = idp;
 291:     return;
 292: 
 293:     enter:  /* make a new entry */
 294: 
 295: # ifndef BUG1
 296:     if( ddebug ) printf( "	new entry made\n" );
 297: # endif
 298:     if( type == UNDEF ) uerror("void type for %s",p->sname);
 299:     p->stype = type;
 300:     p->sclass = class;
 301:     p->slevel = blevel;
 302:     p->offset = NOOFFSET;
 303:     p->suse = lineno;
 304:     if( class == STNAME || class == UNAME || class == ENAME ) {
 305:         p->sizoff = curdim;
 306:         dstash( (OFFSZ)0 );  /* size */
 307:         dstash( (OFFSZ)-1 ); /* index to members of str or union */
 308:         dstash( (OFFSZ)ALSTRUCT );  /* alignment */
 309:         dstash( (OFFSZ)idp );
 310:         }
 311:     else {
 312:         switch( BTYPE(type) ){
 313:         case STRTY:
 314:         case UNIONTY:
 315:         case ENUMTY:
 316:             p->sizoff = q->fn.csiz;
 317:             break;
 318:         default:
 319:             p->sizoff = BTYPE(type);
 320:             }
 321:         }
 322: 
 323:     /* copy dimensions */
 324: 
 325:     p->dimoff = q->fn.cdim;
 326: 
 327:     /* allocate offsets */
 328:     if( class&FIELD ){
 329:         falloc( p, class&FLDSIZ, 0, NIL );  /* new entry */
 330:         psave( (OFFSZ)idp );
 331:         }
 332:     else switch( class ){
 333: 
 334:     case AUTO:
 335:         oalloc( p, &autooff );
 336:         break;
 337:     case STATIC:
 338:     case EXTDEF:
 339:         p->offset = getlab();
 340:         if( ISFTN(type) ) curftn = idp;
 341:         break;
 342:     case ULABEL:
 343:     case LABEL:
 344:         p->offset = getlab();
 345:         p->slevel = 2;
 346:         if( class == LABEL ){
 347:             locctr( PROG );
 348:             deflab( (int)p->offset );
 349:             }
 350:         break;
 351: 
 352:     case EXTERN:
 353:     case UFORTRAN:
 354:     case FORTRAN:
 355:         p->offset = getlab();
 356:         p->slevel = 0;
 357:         break;
 358:     case MOU:
 359:     case MOS:
 360:         oalloc( p, &strucoff );
 361:         if( class == MOU ) strucoff = 0;
 362:         psave( (OFFSZ)idp );
 363:         break;
 364: 
 365:     case MOE:
 366:         p->offset = strucoff++;
 367:         psave( (OFFSZ)idp );
 368:         break;
 369:     case REGISTER:
 370:         p->offset = regvar--;
 371:         if( blevel == 1 ) p->sflags |= SSET;
 372:         if( regvar < minrvar ) minrvar = regvar;
 373:         break;
 374:         }
 375: 
 376:     {
 377:         register int l = p->slevel;
 378: 
 379:         if( l >= MAXSCOPES )
 380:             cerror("scopes nested too deep" );
 381: 
 382:         p->snext = schain[l];
 383:         schain[l] = p;
 384:         if( l >= chaintop )
 385:             chaintop = l + 1;
 386:         }
 387: 
 388:     /* user-supplied routine to fix up new definitions */
 389: 
 390:     FIXDEF(p);
 391: 
 392: # ifndef BUG1
 393:     if( ddebug ) printf( "	dimoff, sizoff, offset: %d, %d, %d\n", p->dimoff, p->sizoff, p->offset );
 394: # endif
 395: 
 396:     }
 397: 
 398: psave( i ) OFFSZ i;{
 399:     if( paramno >= PARAMSZ ){
 400:         cerror("parameter stack overflow");
 401:         }
 402:     paramstk[ paramno++ ] = i;
 403:     }
 404: 
 405: ftnend(){ /* end of function */
 406:     if( retlab != NOLAB ){ /* inside a real function */
 407:         efcode();
 408:         }
 409:     checkst(0);
 410:     retstat = 0;
 411:     tcheck();
 412:     curclass = SNULL;
 413:     brklab = contlab = retlab = NOLAB;
 414:     flostat = 0;
 415:     if( nerrors == 0 ){
 416:         if( psavbc != & asavbc[0] ) cerror("bcsave error");
 417:         if( paramno != 0 ) cerror("parameter reset error");
 418:         if( swx != 0 ) cerror("switch error");
 419:         }
 420:     psavbc = &asavbc[0];
 421:     paramno = 0;
 422:     autooff = AUTOINIT;
 423:     minrvar = regvar = MAXRVAR;
 424:     reached = 1;
 425:     swx = 0;
 426:     swp = swtab;
 427:     locctr(DATA);
 428:     }
 429: 
 430: dclargs(){
 431:     register i;
 432:     OFFSZ   j;
 433:     register struct symtab *p;
 434:     register NODE *q;
 435:     argoff = ARGINIT;
 436: # ifndef BUG1
 437:     if( ddebug > 2) printf("dclargs()\n");
 438: # endif
 439:     for( i=0; i<paramno; ++i ){
 440:         if( (j = paramstk[i]) < 0 ) continue;
 441:         p = &stab[j];
 442: # ifndef BUG1
 443:         if( ddebug > 2 ){
 444:             printf("\t%s (%d) ",p->sname, j);
 445:             tprint(p->stype);
 446:             printf("\n");
 447:             }
 448: # endif
 449:         if( p->stype == FARG ) {
 450:             q = block(FREE,NIL,NIL,INT,0,INT);
 451:             q->tn.rval = (int)j;
 452:             defid( q, PARAM );
 453:             }
 454:         FIXARG(p); /* local arg hook, eg. for sym. debugger */
 455:         oalloc( p, &argoff );  /* always set aside space, even for register arguments */
 456:         }
 457:     cendarg();
 458:     locctr(PROG);
 459:     defalign(ALINT);
 460:     ftnno = getlab();
 461:     bfcode( paramstk, paramno );
 462:     paramno = 0;
 463:     }
 464: 
 465: NODE *
 466: rstruct( idn, soru ){ /* reference to a structure or union, with no definition */
 467:     register struct symtab *p;
 468:     register NODE *q;
 469:     p = &stab[idn];
 470:     switch( p->stype ){
 471: 
 472:     case UNDEF:
 473:     def:
 474:         q = block( FREE, NIL, NIL, 0, 0, 0 );
 475:         q->tn.rval = idn;
 476:         q->in.type = (soru&INSTRUCT) ? STRTY : ( (soru&INUNION) ? UNIONTY : ENUMTY );
 477:         defid( q, (soru&INSTRUCT) ? STNAME : ( (soru&INUNION) ? UNAME : ENAME ) );
 478:         break;
 479: 
 480:     case STRTY:
 481:         if( soru & INSTRUCT ) break;
 482:         goto def;
 483: 
 484:     case UNIONTY:
 485:         if( soru & INUNION ) break;
 486:         goto def;
 487: 
 488:     case ENUMTY:
 489:         if( !(soru&(INUNION|INSTRUCT)) ) break;
 490:         goto def;
 491: 
 492:         }
 493:     stwart = instruct;
 494:     return( mkty( p->stype, 0, p->sizoff ) );
 495:     }
 496: 
 497: moedef( idn ){
 498:     register NODE *q;
 499: 
 500:     q = block( FREE, NIL, NIL, MOETY, 0, 0 );
 501:     q->tn.rval = idn;
 502:     if( idn>=0 ) defid( q, MOE );
 503:     }
 504: 
 505: bstruct( idn, soru ){ /* begining of structure or union declaration */
 506:     register NODE *q;
 507: 
 508:     psave( (OFFSZ)instruct );
 509:     psave( (OFFSZ)curclass );
 510:     psave( strucoff );
 511:     strucoff = 0;
 512:     instruct = soru;
 513:     q = block( FREE, NIL, NIL, 0, 0, 0 );
 514:     q->tn.rval = idn;
 515:     if( instruct==INSTRUCT ){
 516:         curclass = MOS;
 517:         q->in.type = STRTY;
 518:         if( idn >= 0 ) defid( q, STNAME );
 519:         }
 520:     else if( instruct == INUNION ) {
 521:         curclass = MOU;
 522:         q->in.type = UNIONTY;
 523:         if( idn >= 0 ) defid( q, UNAME );
 524:         }
 525:     else { /* enum */
 526:         curclass = MOE;
 527:         q->in.type = ENUMTY;
 528:         if( idn >= 0 ) defid( q, ENAME );
 529:         }
 530:     psave( (OFFSZ)(idn = q->tn.rval) );
 531:     /* the "real" definition is where the members are seen */
 532:     if ( idn >= 0 ) stab[idn].suse = lineno;
 533:     return( paramno-4 );
 534:     }
 535: 
 536: NODE *
 537: dclstruct( oparam ){
 538:     register struct symtab *p;
 539:     register sa, al;
 540:     int szindex;
 541:     OFFSZ sz, i, j;
 542:     register TWORD temp;
 543:     OFFSZ high, low;
 544: 
 545:     /* paramstack contains:
 546: 		paramstack[ oparam ] = previous instruct
 547: 		paramstack[ oparam+1 ] = previous class
 548: 		paramstk[ oparam+2 ] = previous strucoff
 549: 		paramstk[ oparam+3 ] = structure name
 550: 
 551: 		paramstk[ oparam+4, ... ]  = member stab indices
 552: 
 553: 		*/
 554: 
 555:     if( (i=paramstk[oparam+3]) < 0 ){
 556:         szindex = curdim;
 557:         dstash( (OFFSZ)0 );  /* size */
 558:         dstash( (OFFSZ)-1 );  /* index to member names */
 559:         dstash( (OFFSZ)ALSTRUCT );  /* alignment */
 560:         dstash( (OFFSZ)-lineno );   /* name of structure */
 561:         }
 562:     else {
 563:         szindex = stab[i].sizoff;
 564:         }
 565: 
 566: # ifndef BUG1
 567:     if( ddebug ){
 568: #ifndef FLEXNAMES
 569:         printf( "dclstruct( %.8s ), szindex = %d\n", (i>=0)? stab[i].sname : "??", szindex );
 570: #else
 571:         printf( "dclstruct( %s ), szindex = %d\n", (i>=0)? stab[i].sname : "??", szindex );
 572: #endif
 573:         }
 574: # endif
 575:     temp = (instruct&INSTRUCT)?STRTY:((instruct&INUNION)?UNIONTY:ENUMTY);
 576:     stwart = instruct = paramstk[ oparam ];
 577:     curclass = paramstk[ oparam+1 ];
 578:     dimtab[ szindex+1 ] = curdim;
 579:     al = ALSTRUCT;
 580: 
 581:     high = low = 0;
 582: 
 583:     for( i = oparam+4;  i< paramno; ++i ){
 584:         dstash( j=paramstk[i] );
 585:         if( j<0 || j>= SYMTSZ ) cerror("gummy structure member" );
 586:         p = &stab[j];
 587:         if( temp == ENUMTY ){
 588:             if( p->offset < low ) low = p->offset;
 589:             if( p->offset > high ) high = p->offset;
 590:             p->sizoff = szindex;
 591:             continue;
 592:             }
 593:         sa = talign( p->stype, p->sizoff );
 594:         if( p->sclass & FIELD ){
 595:             sz = p->sclass&FLDSIZ;
 596:             }
 597:         else {
 598:             sz = tsize( p->stype, p->dimoff, p->sizoff );
 599:             }
 600:         if( sz == 0 ){
 601: #ifndef FLEXNAMES
 602:             werror("illegal zero sized structure member: %.8s", p->sname );
 603: #else
 604:             werror("illegal zero sized structure member: %s", p->sname );
 605: #endif
 606:             }
 607:         if( sz > strucoff ) strucoff = sz;  /* for use with unions */
 608:         SETOFF( al, sa );
 609:         /* set al, the alignment, to the lcm of the alignments of the members */
 610:         }
 611:     dstash( (OFFSZ)-1 );  /* endmarker */
 612:     SETOFF( strucoff, al );
 613: 
 614:     if( temp == ENUMTY ){
 615:         register TWORD ty;
 616: 
 617: # ifdef ENUMSIZE
 618:         ty = ENUMSIZE(high,low);
 619: # else
 620:         if( (char)high == high && (char)low == low ) ty = ctype( CHAR );
 621:         else if( (short)high == high && (short)low == low ) ty = ctype( SHORT );
 622:         else ty = ctype(INT);
 623: #endif
 624:         strucoff = tsize( ty, 0, (int)ty );
 625:         dimtab[ szindex+2 ] = al = talign( ty, (int)ty );
 626:         }
 627: 
 628:     if( strucoff == 0 ) uerror("zero sized structure" );
 629:     dimtab[ szindex ] = strucoff;
 630:     dimtab[ szindex+2 ] = al;
 631:     dimtab[ szindex+3 ] = paramstk[ oparam+3 ];  /* name index */
 632: 
 633:     FIXSTRUCT( szindex, oparam ); /* local hook, eg. for sym debugger */
 634: # ifndef BUG1
 635:     if( ddebug>1 ){
 636:         printf( "\tdimtab[%d,%d,%d] = %ld,%ld,%ld\n", szindex,szindex+1,szindex+2,
 637:                 dimtab[szindex],dimtab[szindex+1],dimtab[szindex+2] );
 638:         for( i = (int)dimtab[szindex+1]; dimtab[i] >= 0; ++i ){
 639: #ifndef FLEXNAMES
 640:             printf( "\tmember %.8s(%ld)\n", stab[dimtab[i]].sname, dimtab[i] );
 641: #else
 642:             printf( "\tmember %s(%ld)\n", stab[dimtab[i]].sname, dimtab[i] );
 643: #endif
 644:             }
 645:         }
 646: # endif
 647: 
 648:     strucoff = paramstk[ oparam+2 ];
 649:     paramno = oparam;
 650: 
 651:     return( mkty( temp, 0, szindex ) );
 652:     }
 653: 
 654:     /* VARARGS */
 655: yyerror(s ) char *s; { /* error printing routine in parser */
 656: 
 657:     uerror(s );
 658: 
 659:     }
 660: 
 661: yyaccpt(){
 662:     ftnend();
 663:     }
 664: 
 665: ftnarg( idn ) {
 666:     switch( stab[idn].stype ){
 667: 
 668:     case UNDEF:
 669:         /* this parameter, entered at scan */
 670:         break;
 671:     case FARG:
 672: #ifndef FLEXNAMES
 673:         uerror("redeclaration of formal parameter, %.8s",
 674: #else
 675:         uerror("redeclaration of formal parameter, %s",
 676: #endif
 677:             stab[idn].sname);
 678:         /* fall thru */
 679:     case FTN:
 680:         /* the name of this function matches parm */
 681:         /* fall thru */
 682:     default:
 683:         idn = hide( &stab[idn]);
 684:         break;
 685:     case TNULL:
 686:         /* unused entry, fill it */
 687:         ;
 688:         }
 689:     stab[idn].stype = FARG;
 690:     stab[idn].sclass = PARAM;
 691:     psave( (OFFSZ)idn );
 692:     }
 693: 
 694: talign( ty, s) register unsigned ty; register s; {
 695:     /* compute the alignment of an object with type ty, sizeoff index s */
 696: 
 697:     register i;
 698:     if( s<0 && ty!=INT && ty!=CHAR && ty!=SHORT && ty!=UNSIGNED && ty!=UCHAR && ty!=USHORT
 699: #ifdef LONGFIELDS
 700:         && ty!=LONG && ty!=ULONG
 701: #endif
 702:                     ){
 703:         return( fldal( ty ) );
 704:         }
 705: 
 706:     for( i=0; i<=(SZINT-BTSHIFT-1); i+=TSHIFT ){
 707:         switch( (ty>>i)&TMASK ){
 708: 
 709:         case FTN:
 710:             cerror("compiler takes alignment of function");
 711:         case PTR:
 712:             return( ALPOINT );
 713:         case ARY:
 714:             continue;
 715:         case 0:
 716:             break;
 717:             }
 718:         }
 719: 
 720:     switch( BTYPE(ty) ){
 721: 
 722:     case UNIONTY:
 723:     case ENUMTY:
 724:     case STRTY:
 725:         return( (unsigned int) dimtab[ s+2 ] );
 726:     case CHAR:
 727:     case UCHAR:
 728:         return( ALCHAR );
 729:     case FLOAT:
 730:         return( ALFLOAT );
 731:     case DOUBLE:
 732:         return( ALDOUBLE );
 733:     case LONG:
 734:     case ULONG:
 735:         return( ALLONG );
 736:     case SHORT:
 737:     case USHORT:
 738:         return( ALSHORT );
 739:     default:
 740:         return( ALINT );
 741:         }
 742:     }
 743: 
 744: OFFSZ
 745: tsize( ty, d, s )  TWORD ty; {
 746:     /* compute the size associated with type ty,
 747: 	    dimoff d, and sizoff s */
 748:     /* BETTER NOT BE CALLED WHEN t, d, and s REFER TO A BIT FIELD... */
 749: 
 750:     int i;
 751:     OFFSZ mult;
 752: 
 753:     mult = 1;
 754: 
 755:     for( i=0; i<=(SZINT-BTSHIFT-1); i+=TSHIFT ){
 756:         switch( (ty>>i)&TMASK ){
 757: 
 758:         case FTN:
 759:             cerror("compiler takes size of function");
 760:         case PTR:
 761:             return( SZPOINT * mult );
 762:         case ARY:
 763:             mult *= dimtab[ d++ ];
 764:             continue;
 765:         case 0:
 766:             break;
 767: 
 768:             }
 769:         }
 770: 
 771:     if( dimtab[s]==0 ) {
 772:         if( ty == STRTY )
 773:             uerror("undefined structure" );
 774:         else
 775:             uerror("unknown size");
 776:         return( SZINT );
 777:         }
 778:     return( dimtab[ s ] * mult );
 779:     }
 780: 
 781: inforce( n ) OFFSZ n; {  /* force inoff to have the value n */
 782:     /* inoff is updated to have the value n */
 783:     OFFSZ wb;
 784:     register rest;
 785:     /* rest is used to do a lot of conversion to ints... */
 786: 
 787:     if( inoff == n ) return;
 788:     if( inoff > n ) {
 789:         cerror("initialization alignment error");
 790:         }
 791: 
 792:     wb = inoff;
 793:     SETOFF( wb, SZINT );
 794: 
 795:     /* wb now has the next higher word boundary */
 796: 
 797:     if( wb >= n ){ /* in the same word */
 798:         rest = n - inoff;
 799:         vfdzero( rest );
 800:         return;
 801:         }
 802: 
 803:     /* otherwise, extend inoff to be word aligned */
 804: 
 805:     rest = wb - inoff;
 806:     vfdzero( rest );
 807: 
 808:     /* now, skip full words until near to n */
 809: 
 810:     rest = (n-inoff)/SZINT;
 811:     zecode( rest );
 812: 
 813:     /* now, the remainder of the last word */
 814: 
 815:     rest = n-inoff;
 816:     vfdzero( rest );
 817:     if( inoff != n ) cerror("inoff error");
 818: 
 819:     }
 820: 
 821: vfdalign( n ) OFFSZ n;{ /* make inoff have the offset the next alignment of n */
 822:     OFFSZ m;
 823: 
 824:     m = inoff;
 825:     SETOFF( m, n );
 826:     inforce( m );
 827:     }
 828: 
 829: 
 830: int idebug = 0;
 831: 
 832: int ibseen = 0;  /* the number of } constructions which have been filled */
 833: 
 834: int ifull = 0; /* 1 if all initializers have been seen */
 835: 
 836: int iclass;  /* storage class of thing being initialized */
 837: 
 838: int ilocctr = 0;  /* location counter for current initialization */
 839: 
 840: beginit(curid){
 841:     /* beginning of initilization; set location ctr and set type */
 842:     register struct symtab *p;
 843: 
 844: # ifndef BUG1
 845:     if( idebug >= 3 ) printf( "beginit(), curid = %d\n", curid );
 846: # endif
 847: 
 848:     p = &stab[curid];
 849: 
 850:     iclass = p->sclass;
 851:     if( curclass == EXTERN || curclass == FORTRAN ) iclass = EXTERN;
 852:     switch( iclass ){
 853: 
 854:     case UNAME:
 855:     case EXTERN:
 856:         return;
 857:     case AUTO:
 858:     case REGISTER:
 859:         break;
 860:     case EXTDEF:
 861:     case STATIC:
 862:         ilocctr = ISARY(p->stype)?ADATA:DATA;
 863:         locctr( ilocctr );
 864:         defalign( talign( p->stype, p->sizoff ) );
 865:         defnam( p );
 866: 
 867:         }
 868: 
 869:     inoff = 0;
 870:     ibseen = 0;
 871:     ifull = 0;
 872: 
 873:     pstk = 0;
 874: 
 875:     instk( curid, p->stype, p->dimoff, p->sizoff, inoff );
 876: 
 877:     }
 878: 
 879: instk( id, t, d, s, off ) OFFSZ off; TWORD t; {
 880:     /* make a new entry on the parameter stack to initialize id */
 881: 
 882:     register struct symtab *p;
 883: 
 884:     for(;;){
 885: # ifndef BUG1
 886:         if( idebug ) printf( "instk((%d, %o,%d,%d, %ld)\n", id, t, d, s, off );
 887: # endif
 888: 
 889:         /* save information on the stack */
 890: 
 891:         if( !pstk ) pstk = instack;
 892:         else ++pstk;
 893: 
 894:         pstk->in_fl = 0;    /* { flag */
 895:         pstk->in_id =  id ;
 896:         pstk->in_t =  t ;
 897:         pstk->in_d =  d ;
 898:         pstk->in_s =  s ;
 899:         pstk->in_n = 0;  /* number seen */
 900:         pstk->in_x =  t==STRTY ?dimtab[s+1] : 0 ;
 901:         pstk->in_off =  off;   /* offset at the beginning of this element */
 902:         /* if t is an array, DECREF(t) can't be a field */
 903:         /* INS_sz has size of array elements, and -size for fields */
 904:         if( ISARY(t) ){
 905:             pstk->in_sz = tsize( DECREF(t), d+1, s );
 906:             }
 907:         else if( stab[id].sclass & FIELD ){
 908:             pstk->in_sz = - ( stab[id].sclass & FLDSIZ );
 909:             }
 910:         else {
 911:             pstk->in_sz = 0;
 912:             }
 913: 
 914:         if( (iclass==AUTO || iclass == REGISTER ) &&
 915:             (ISARY(t) || t==STRTY) ) uerror("no automatic aggregate initialization" );
 916: 
 917:         /* now, if this is not a scalar, put on another element */
 918: 
 919:         if( ISARY(t) ){
 920:             t = DECREF(t);
 921:             ++d;
 922:             continue;
 923:             }
 924:         else if( t == STRTY ){
 925:             if( dimtab[pstk->in_s] == 0 ){
 926:                 uerror("can't initialize undefined structure" );
 927:                 iclass = -1;
 928:                 return;
 929:                 }
 930:             id = (int)dimtab[pstk->in_x];
 931:             p = &stab[id];
 932:             if( p->sclass != MOS && !(p->sclass&FIELD) ) cerror("insane structure member list" );
 933:             t = p->stype;
 934:             d = p->dimoff;
 935:             s = p->sizoff;
 936:             off += p->offset;
 937:             continue;
 938:             }
 939:         else return;
 940:         }
 941:     }
 942: 
 943: NODE *
 944: getstr(){ /* decide if the string is external or an initializer, and get the contents accordingly */
 945: 
 946:     register l, temp;
 947:     register NODE *p;
 948: 
 949:     if( (iclass==EXTDEF||iclass==STATIC) && (pstk->in_t == CHAR || pstk->in_t == UCHAR) &&
 950:             pstk!=instack && ISARY( pstk[-1].in_t ) ){
 951:         /* treat "abc" as { 'a', 'b', 'c', 0 } */
 952:         strflg = 1;
 953:         ilbrace();  /* simulate { */
 954:         inforce( pstk->in_off );
 955:         /* if the array is inflexible (not top level), pass in the size and
 956: 			be prepared to throw away unwanted initializers */
 957:         lxstr((pstk-1)!=instack?(int)dimtab[(pstk-1)->in_d]:0);  /* get the contents */
 958:         irbrace();  /* simulate } */
 959:         return( NIL );
 960:         }
 961:     else { /* make a label, and get the contents and stash them away */
 962:         if( iclass != SNULL ){ /* initializing */
 963:             /* fill out previous word, to permit pointer */
 964:             vfdalign( (OFFSZ)ALPOINT );
 965:             }
 966:         temp = locctr( blevel==0?ISTRNG:STRNG ); /* set up location counter */
 967:         deflab( l = getlab() );
 968:         strflg = 0;
 969:         lxstr(0); /* get the contents */
 970:         locctr( blevel==0?ilocctr:temp );
 971:         p = buildtree( STRING, NIL, NIL );
 972:         p->tn.rval = -l;
 973:         return(p);
 974:         }
 975:     }
 976: 
 977: putbyte( v ){ /* simulate byte v appearing in a list of integer values */
 978:     register NODE *p;
 979:     p = bcon(v);
 980:     incode( p, SZCHAR );
 981:     tfree( p );
 982:     gotscal();
 983:     }
 984: 
 985: endinit(){
 986:     register TWORD t;
 987:     register d, n, d1;
 988:     int s;
 989: 
 990: # ifndef BUG1
 991:     if( idebug ) printf( "endinit(), inoff = %ld\n", inoff );
 992: # endif
 993: 
 994:     switch( iclass ){
 995: 
 996:     case EXTERN:
 997:     case AUTO:
 998:     case REGISTER:
 999:     case -1:
1000:         return;
1001:         }
1002: 
1003:     pstk = instack;
1004: 
1005:     t = pstk->in_t;
1006:     d = pstk->in_d;
1007:     s = pstk->in_s;
1008:     n = pstk->in_n;
1009: 
1010:     if( ISARY(t) ){
1011:         d1 = (int)dimtab[d];
1012: 
1013:         vfdalign( pstk->in_sz );  /* fill out part of the last element, if needed */
1014:         n = inoff/pstk->in_sz;  /* real number of initializers */
1015:         if( d1 >= n ){
1016:             /* once again, t is an array, so no fields */
1017:             inforce( tsize( t, d, s ) );
1018:             n = d1;
1019:             }
1020:         if( d1!=0 && d1!=n ) uerror("too many initializers");
1021:         if( n==0 ) werror("empty array declaration");
1022:         dimtab[d] = n;
1023:         if( d1==0 ) FIXDEF(&stab[pstk->in_id]);
1024:         }
1025: 
1026:     else if( t == STRTY || t == UNIONTY ){
1027:         /* clearly not fields either */
1028:         inforce( tsize( t, d, s ) );
1029:         }
1030:     else if( n > 1 ) uerror("bad scalar initialization");
1031:     /* this will never be called with a field element... */
1032:     else inforce( tsize(t,d,s) );
1033: 
1034:     paramno = 0;
1035:     vfdalign( (OFFSZ)AL_INIT );
1036:     inoff = 0;
1037:     iclass = SNULL;
1038: 
1039:     }
1040: 
1041: doinit( p ) register NODE *p; {
1042: 
1043:     /* take care of generating a value for the initializer p */
1044:     /* inoff has the current offset (last bit written)
1045: 		in the current word being generated */
1046: 
1047:     register d, s;
1048:     OFFSZ sz;
1049:     register TWORD t;
1050:     int o;
1051: 
1052:     /* note: size of an individual initializer is assumed to fit into an int */
1053: 
1054:     if( iclass < 0 ) goto leave;
1055:     if( iclass == EXTERN || iclass == UNAME ){
1056:         uerror("cannot initialize extern or union" );
1057:         iclass = -1;
1058:         goto leave;
1059:         }
1060: 
1061:     if( iclass == AUTO || iclass == REGISTER ){
1062:         /* do the initialization and get out, without regard
1063: 		    for filing out the variable with zeros, etc. */
1064:         bccode();
1065:         idname = pstk->in_id;
1066:         p = buildtree( ASSIGN, buildtree( NAME, NIL, NIL ), p );
1067:         ecomp(p);
1068:         return;
1069:         }
1070: 
1071:     if( p == NIL ) return;  /* for throwing away strings that have been turned into lists */
1072: 
1073:     if( ifull ){
1074:         uerror("too many initializers" );
1075:         iclass = -1;
1076:         goto leave;
1077:         }
1078:     if( ibseen ){
1079:         uerror("} expected");
1080:         goto leave;
1081:         }
1082: 
1083: # ifndef BUG1
1084:     if( idebug > 1 ) printf( "doinit(%o)\n", p );
1085: # endif
1086: 
1087:     t = pstk->in_t;  /* type required */
1088:     d = pstk->in_d;
1089:     s = pstk->in_s;
1090:     if( pstk->in_sz < 0 ){  /* bit field */
1091:         sz = -pstk->in_sz;
1092:         }
1093:     else {
1094:         sz = tsize( t, d, s );
1095:         }
1096: 
1097:     inforce( pstk->in_off );
1098: 
1099:     p = buildtree( ASSIGN, block( NAME, NIL,NIL, t, d, s ), p );
1100:     p->in.left->in.op = FREE;
1101:     p->in.left = p->in.right;
1102:     p->in.right = NIL;
1103:     p->in.left = optim( p->in.left );
1104:     o = p->in.left->in.op;
1105:     if( o == UNARY AND ){
1106:         o = p->in.left->in.op = FREE;
1107:         p->in.left = p->in.left->in.left;
1108:         }
1109:     p->in.op = INIT;
1110: 
1111:     if( sz < SZINT ){ /* special case: bit fields, etc. */
1112:         if( o != ICON ) uerror("illegal initialization" );
1113:         else incode( p->in.left, sz );
1114:         }
1115:     else if( o == FCON ){
1116:         fincode( p->in.left->fpn.fval, sz );
1117:         }
1118:     else if( o == DCON ){
1119:         fincode( p->in.left->dpn.dval, sz );
1120:         }
1121:     else {
1122:         p = optim(p);
1123:         if( p->in.left->in.op != ICON ) uerror("illegal initialization" );
1124:         else cinit( p, sz );
1125:         }
1126: 
1127:     gotscal();
1128: 
1129:     leave:
1130:     tfree(p);
1131:     }
1132: 
1133: gotscal(){
1134:     register t, ix;
1135:     register n, id;
1136:     struct symtab *p;
1137:     OFFSZ temp;
1138: 
1139:     for( ; pstk > instack; ) {
1140: 
1141:         if( pstk->in_fl ) ++ibseen;
1142: 
1143:         --pstk;
1144: 
1145:         t = pstk->in_t;
1146: 
1147:         if( t == STRTY ){
1148:             ix = ++pstk->in_x;
1149:             if( (id=(int)dimtab[ix]) < 0 ) continue;
1150: 
1151:             /* otherwise, put next element on the stack */
1152: 
1153:             p = &stab[id];
1154:             instk( id, p->stype, p->dimoff, p->sizoff, p->offset+pstk->in_off );
1155:             return;
1156:             }
1157:         else if( ISARY(t) ){
1158:             n = ++pstk->in_n;
1159:             if( n >= dimtab[pstk->in_d] && pstk > instack ) continue;
1160: 
1161:             /* put the new element onto the stack */
1162: 
1163:             temp = pstk->in_sz;
1164:             instk( pstk->in_id, (TWORD)DECREF(pstk->in_t), pstk->in_d+1, pstk->in_s,
1165:                 pstk->in_off+n*temp );
1166:             return;
1167:             }
1168: 
1169:         }
1170:     ifull = 1;
1171:     }
1172: 
1173: ilbrace(){ /* process an initializer's left brace */
1174:     register t;
1175:     struct instk *temp;
1176: 
1177:     temp = pstk;
1178: 
1179:     for( ; pstk > instack; --pstk ){
1180: 
1181:         t = pstk->in_t;
1182:         if( t != STRTY && !ISARY(t) ) continue; /* not an aggregate */
1183:         if( pstk->in_fl ){ /* already associated with a { */
1184:             if( pstk->in_n ) uerror("illegal {");
1185:             continue;
1186:             }
1187: 
1188:         /* we have one ... */
1189:         pstk->in_fl = 1;
1190:         break;
1191:         }
1192: 
1193:     /* cannot find one */
1194:     /* ignore such right braces */
1195: 
1196:     pstk = temp;
1197:     }
1198: 
1199: irbrace(){
1200:     /* called when a '}' is seen */
1201: 
1202: # ifndef BUG1
1203:     if( idebug ) printf( "irbrace(): paramno = %d on entry\n", paramno );
1204: # endif
1205: 
1206:     if( ibseen ) {
1207:         --ibseen;
1208:         return;
1209:         }
1210: 
1211:     for( ; pstk > instack; --pstk ){
1212:         if( !pstk->in_fl ) continue;
1213: 
1214:         /* we have one now */
1215: 
1216:         pstk->in_fl = 0;  /* cancel { */
1217:         gotscal();  /* take it away... */
1218:         return;
1219:         }
1220: 
1221:     /* these right braces match ignored left braces: throw out */
1222:     ifull = 1;
1223: 
1224:     }
1225: 
1226: OFFSZ
1227: upoff( size, alignment, poff ) OFFSZ size; register alignment; register OFFSZ *poff; {
1228:     /* update the offset pointed to by poff; return the
1229: 	/* offset of a value of size `size', alignment `alignment',
1230: 	/* given that off is increasing */
1231: 
1232:     OFFSZ off;
1233: 
1234:     off = *poff;
1235:     SETOFF( off, alignment );
1236:     if( (offsz-off) <  size ){
1237:         if( instruct!=INSTRUCT )cerror("too many local variables");
1238:         else cerror("Structure too large");
1239:         }
1240:     *poff = off+size;
1241:     return( off );
1242:     }
1243: 
1244: oalloc( p, poff ) register struct symtab *p; register OFFSZ *poff; {
1245:     /* allocate p with offset *poff, and update *poff */
1246:     OFFSZ al, off, tsz;
1247:     OFFSZ noff;
1248: 
1249:     al = talign( p->stype, p->sizoff );
1250:     noff = off = *poff;
1251:     tsz = tsize( p->stype, p->dimoff, p->sizoff );
1252: #ifdef BACKAUTO
1253:     if( p->sclass == AUTO ){
1254:         if( (offsz-off) < tsz ) cerror("too many local variables");
1255:         noff = off + tsz;
1256:         SETOFF( noff, al );
1257:         off = -noff;
1258:         }
1259:     else
1260: #endif
1261:         if( p->sclass == PARAM && ( tsz < SZINT ) ){
1262:             off = upoff( (OFFSZ)SZINT, ALINT, &noff );
1263: # ifndef RTOLBYTES
1264:             off = noff - tsz;
1265: #endif
1266:             }
1267:         else
1268:         {
1269:         off = upoff( tsz, (int)al, &noff );
1270:         }
1271: 
1272:     if( p->sclass != REGISTER ){ /* in case we are allocating stack space for register arguments */
1273:         if( p->offset == NOOFFSET ) p->offset = off;
1274:         else if( off != p->offset ) return(1);
1275:         }
1276: 
1277:     *poff = noff;
1278:     return(0);
1279:     }
1280: 
1281: falloc( p, w, new, pty )  register struct symtab *p; NODE *pty; {
1282:     /* allocate a field of width w */
1283:     /* new is 0 if new entry, 1 if redefinition, -1 if alignment */
1284: 
1285:     register al,sz,type;
1286: 
1287:     type = (new<0)? pty->in.type : p->stype;
1288: 
1289:     /* this must be fixed to use the current type in alignments */
1290:     switch( new<0?pty->in.type:p->stype ){
1291: 
1292:     case ENUMTY:
1293:         {
1294:             int s;
1295:             s = new<0 ? pty->fn.csiz : p->sizoff;
1296:             al = dimtab[s+2];
1297:             sz = dimtab[s];
1298:             break;
1299:             }
1300: 
1301:     case CHAR:
1302:     case UCHAR:
1303:         al = ALCHAR;
1304:         sz = SZCHAR;
1305:         break;
1306: 
1307:     case SHORT:
1308:     case USHORT:
1309:         al = ALSHORT;
1310:         sz = SZSHORT;
1311:         break;
1312: 
1313:     case INT:
1314:     case UNSIGNED:
1315:         al = ALINT;
1316:         sz = SZINT;
1317:         break;
1318: #ifdef LONGFIELDS
1319: 
1320:     case LONG:
1321:     case ULONG:
1322:         al = ALLONG;
1323:         sz = SZLONG;
1324:         break;
1325: #endif
1326: 
1327:     default:
1328:         if( new < 0 ) {
1329:             uerror("illegal field type" );
1330:             al = ALINT;
1331:             }
1332:         else {
1333:             al = fldal( p->stype );
1334:             sz =SZINT;
1335:             }
1336:         }
1337: 
1338:     if( w > sz ) {
1339:         uerror("field too big");
1340:         w = sz;
1341:         }
1342: 
1343:     if( w == 0 ){ /* align only */
1344:         SETOFF( strucoff, al );
1345:         if( new >= 0 ) uerror("zero size field");
1346:         return(0);
1347:         }
1348: 
1349:     if( strucoff%al + w > sz ) SETOFF( strucoff, al );
1350:     if( new < 0 ) {
1351:         if( (offsz-strucoff) < w )
1352:             cerror("structure too large");
1353:         strucoff += w;  /* we know it will fit */
1354:         return(0);
1355:         }
1356: 
1357:     /* establish the field */
1358: 
1359:     if( new == 1 ) { /* previous definition */
1360:         if( p->offset != strucoff || p->sclass != (FIELD|w) ) return(1);
1361:         }
1362:     p->offset = strucoff;
1363:     if( (offsz-strucoff) < w ) cerror("structure too large");
1364:     strucoff += w;
1365:     p->stype = type;
1366:     fldty( p );
1367:     return(0);
1368:     }
1369: 
1370: nidcl( p ) NODE *p; { /* handle unitialized declarations */
1371:     /* assumed to be not functions */
1372:     register class;
1373:     register commflag;  /* flag for labelled common declarations */
1374: 
1375:     commflag = 0;
1376: 
1377:     /* compute class */
1378:     if( (class=curclass) == SNULL ){
1379:         if( blevel > 1 ) class = AUTO;
1380:         else if( blevel != 0 || instruct ) cerror("nidcl error" );
1381:         else { /* blevel = 0 */
1382:             class = noinit();
1383:             if( class == EXTERN ) commflag = 1;
1384:             }
1385:         }
1386: #ifdef LCOMM
1387:     /* hack so stab will come at as LCSYM rather than STSYM */
1388:     if (class == STATIC) {
1389:         extern int stabLCSYM;
1390:         stabLCSYM = 1;
1391:     }
1392: #endif
1393: 
1394:     defid( p, class );
1395: 
1396: #ifndef LCOMM
1397:     if( class==EXTDEF || class==STATIC )
1398: #else
1399:     if (class==STATIC) {
1400:         register struct symtab *s = &stab[p->tn.rval];
1401:         extern int stabLCSYM;
1402:         int sz = tsize(s->stype, s->dimoff, s->sizoff)/SZCHAR;
1403: 
1404:         stabLCSYM = 0;
1405:         if (sz % sizeof (int))
1406:             sz += sizeof (int) - (sz % sizeof (int));
1407:         if (s->slevel > 1)
1408:             printf("	.lcomm	L%d,%d\n", s->offset, sz);
1409:         else
1410:             printf("	.lcomm	%s,%d\n", exname(s->sname), sz);
1411:     }else if (class == EXTDEF)
1412: #endif
1413:         {
1414:         /* simulate initialization by 0 */
1415:         beginit(p->tn.rval);
1416:         endinit();
1417:         }
1418:     if( commflag ) commdec( p->tn.rval );
1419:     }
1420: 
1421: TWORD
1422: types( t1, t2, t3 ) TWORD t1, t2, t3; {
1423:     /* return a basic type from basic types t1, t2, and t3 */
1424: 
1425:     TWORD t[3], noun, adj, unsg;
1426:     register i;
1427: 
1428:     t[0] = t1;
1429:     t[1] = t2;
1430:     t[2] = t3;
1431: 
1432:     unsg = INT;  /* INT or UNSIGNED */
1433:     noun = UNDEF;  /* INT, CHAR, or FLOAT */
1434:     adj = INT;  /* INT, LONG, or SHORT */
1435: 
1436:     for( i=0; i<3; ++i ){
1437:         switch( t[i] ){
1438: 
1439:         default:
1440:         bad:
1441:             uerror("illegal type combination" );
1442:             return( INT );
1443: 
1444:         case UNDEF:
1445:             continue;
1446: 
1447:         case UNSIGNED:
1448:             if( unsg != INT ) goto bad;
1449:             unsg = UNSIGNED;
1450:             continue;
1451: 
1452:         case LONG:
1453:         case SHORT:
1454:             if( adj != INT ) goto bad;
1455:             adj = t[i];
1456:             continue;
1457: 
1458:         case INT:
1459:         case CHAR:
1460:         case FLOAT:
1461:             if( noun != UNDEF ) goto bad;
1462:             noun = t[i];
1463:             continue;
1464:             }
1465:         }
1466: 
1467:     /* now, construct final type */
1468:     if( noun == UNDEF ) noun = INT;
1469:     else if( noun == FLOAT ){
1470:         if( unsg != INT || adj == SHORT ) goto bad;
1471:         return( adj==LONG ? DOUBLE : FLOAT );
1472:         }
1473:     else if( noun == CHAR && adj != INT ) goto bad;
1474: 
1475:     /* now, noun is INT or CHAR */
1476:     if( adj != INT ) noun = adj;
1477:     if( unsg == UNSIGNED ) return( noun + (UNSIGNED-INT) );
1478:     else return( noun );
1479:     }
1480: 
1481: NODE *
1482: tymerge( typ, idp ) NODE *typ, *idp; {
1483:     /* merge type typ with identifier idp  */
1484: 
1485:     register unsigned t;
1486:     register i;
1487:     extern int eprint();
1488: 
1489:     if( typ->in.op != TYPE ) cerror("tymerge: arg 1" );
1490:     if(idp == NIL ) return( NIL );
1491: 
1492: # ifndef BUG1
1493:     if( ddebug > 2 ) fwalk( idp, eprint, 0 );
1494: # endif
1495: 
1496:     idp->in.type = typ->in.type;
1497:     idp->fn.cdim = curdim;
1498:     tyreduce( idp );
1499:     idp->fn.csiz = typ->fn.csiz;
1500: 
1501:     for( t=typ->in.type, i=typ->fn.cdim; t&TMASK; t = DECREF(t) ){
1502:         if( ISARY(t) ) dstash( dimtab[i++] );
1503:         }
1504: 
1505:     /* now idp is a single node: fix up type */
1506: 
1507:     idp->in.type = ctype( idp->in.type );
1508: 
1509:     if( (t = BTYPE(idp->in.type)) != STRTY && t != UNIONTY && t != ENUMTY ){
1510:         idp->fn.csiz = t;  /* in case ctype has rewritten things */
1511:         }
1512: 
1513:     return( idp );
1514:     }
1515: 
1516: tyreduce( p ) register NODE *p; {
1517: 
1518:     /* build a type, and stash away dimensions, from a parse tree of the declaration */
1519:     /* the type is build top down, the dimensions bottom up */
1520:     register o;
1521:     CONSZ temp;
1522:     register unsigned t;
1523: 
1524:     o = p->in.op;
1525:     p->in.op = FREE;
1526: 
1527:     if( o == NAME ) return;
1528: 
1529:     t = INCREF( p->in.type );
1530:     if( o == UNARY CALL ) t += (FTN-PTR);
1531:     else if( o == LB ){
1532:         t += (ARY-PTR);
1533:         temp = p->in.right->tn.lval;
1534:         p->in.right->in.op = FREE;
1535:         if( ( temp == 0 ) & ( p->in.left->tn.op == LB ) )
1536:             uerror("Null dimension" );
1537:         }
1538: 
1539:     p->in.left->in.type = t;
1540:     tyreduce( p->in.left );
1541: 
1542:     if( o == LB ) dstash( temp );
1543: 
1544:     p->tn.rval = p->in.left->tn.rval;
1545:     p->in.type = p->in.left->in.type;
1546: 
1547:     }
1548: 
1549: fixtype( p, class ) register NODE *p; {
1550:     register unsigned t, type;
1551:     register mod1, mod2;
1552:     /* fix up the types, and check for legality */
1553: 
1554:     if( (type = p->in.type) == UNDEF ) return;
1555:     if( mod2 = (type&TMASK) ){
1556:         t = DECREF(type);
1557:         while( mod1=mod2, mod2 = (t&TMASK) ){
1558:             if( mod1 == ARY && mod2 == FTN ){
1559:                 uerror("array of functions is illegal" );
1560:                 type = 0;
1561:                 }
1562:             else if( mod1 == FTN && ( mod2 == ARY || mod2 == FTN ) ){
1563:                 uerror("function returns illegal type" );
1564:                 type = 0;
1565:                 }
1566:             t = DECREF(t);
1567:             }
1568:         }
1569: 
1570:     /* detect function arguments, watching out for structure declarations */
1571:     /* for example, beware of f(x) struct [ int a[10]; } *x; { ... } */
1572:     /* the danger is that "a" will be converted to a pointer */
1573: 
1574:     if( class==SNULL && blevel==1 && !(instruct&(INSTRUCT|INUNION)) ) class = PARAM;
1575:     if( class == PARAM || ( class==REGISTER && blevel==1 ) ){
1576:         if( type == FLOAT ) type = DOUBLE;
1577:         else if( ISARY(type) ){
1578:             ++p->fn.cdim;
1579:             type += (PTR-ARY);
1580:             }
1581:         else if( ISFTN(type) ){
1582:             werror("a function is declared as an argument" );
1583:             type = INCREF(type);
1584:             }
1585: 
1586:         }
1587: 
1588:     if( instruct && ISFTN(type) ){
1589:         uerror("function illegal in structure or union" );
1590:         type = INCREF(type);
1591:         }
1592:     p->in.type = type;
1593:     }
1594: 
1595: uclass( class ) register class; {
1596:     /* give undefined version of class */
1597:     if( class == SNULL ) return( EXTERN );
1598:     else if( class == STATIC ) return( USTATIC );
1599:     else if( class == FORTRAN ) return( UFORTRAN );
1600:     else return( class );
1601:     }
1602: 
1603: fixclass( class, type ) TWORD type; {
1604: 
1605:     /* first, fix null class */
1606: 
1607:     if( class == SNULL ){
1608:         if( instruct&INSTRUCT ) class = MOS;
1609:         else if( instruct&INUNION ) class = MOU;
1610:         else if( blevel == 0 ) class = EXTDEF;
1611:         else if( blevel == 1 ) class = PARAM;
1612:         else class = AUTO;
1613: 
1614:         }
1615: 
1616:     /* now, do general checking */
1617: 
1618:     if( ISFTN( type ) ){
1619:         switch( class ) {
1620:         default:
1621:             uerror("function has illegal storage class" );
1622:         case AUTO:
1623:             class = EXTERN;
1624:         case EXTERN:
1625:         case EXTDEF:
1626:         case FORTRAN:
1627:         case TYPEDEF:
1628:         case STATIC:
1629:         case UFORTRAN:
1630:         case USTATIC:
1631:             ;
1632:             }
1633:         }
1634: 
1635:     if( class&FIELD ){
1636:         if( !(instruct&INSTRUCT) ) uerror("illegal use of field" );
1637:         return( class );
1638:         }
1639: 
1640:     switch( class ){
1641: 
1642:     case MOU:
1643:         if( !(instruct&INUNION) ) uerror("illegal class" );
1644:         return( class );
1645: 
1646:     case MOS:
1647:         if( !(instruct&INSTRUCT) ) uerror("illegal class" );
1648:         return( class );
1649: 
1650:     case MOE:
1651:         if( instruct & (INSTRUCT|INUNION) ) uerror("illegal class" );
1652:         return( class );
1653: 
1654:     case REGISTER:
1655:         if( blevel == 0 ) uerror("illegal register declaration" );
1656:         else if( regvar >= MINRVAR && cisreg( type ) ) return( class );
1657:         if( blevel == 1 ) return( PARAM );
1658:         else return( AUTO );
1659: 
1660:     case AUTO:
1661:     case LABEL:
1662:     case ULABEL:
1663:         if( blevel < 2 ) uerror("illegal class" );
1664:         return( class );
1665: 
1666:     case PARAM:
1667:         if( blevel != 1 ) uerror("illegal class" );
1668:         return( class );
1669: 
1670:     case UFORTRAN:
1671:     case FORTRAN:
1672: # ifdef NOFORTRAN
1673:             NOFORTRAN;    /* a condition which can regulate the FORTRAN usage */
1674: # endif
1675:         if( !ISFTN(type) ) uerror("fortran declaration must apply to function" );
1676:         else {
1677:             type = DECREF(type);
1678:             if( ISFTN(type) || ISARY(type) || ISPTR(type) ) {
1679:                 uerror("fortran function has wrong type" );
1680:                 }
1681:             }
1682:     case EXTERN:
1683:     case STATIC:
1684:     case EXTDEF:
1685:     case TYPEDEF:
1686:     case USTATIC:
1687:         if( blevel == 1 ){
1688:             uerror("illegal class" );
1689:             return( PARAM );
1690:             }
1691:     case STNAME:
1692:     case UNAME:
1693:     case ENAME:
1694:         return( class );
1695: 
1696:     default:
1697:         cerror("illegal class: %d", class );
1698:         /* NOTREACHED */
1699: 
1700:         }
1701:     }
1702: 
1703: struct symtab *
1704: mknonuniq(idindex) int *idindex; {/* locate a symbol table entry for */
1705:     /* an occurrence of a nonunique structure member name */
1706:     /* or field */
1707:     register i;
1708:     register struct symtab * sp;
1709:     char *p,*q;
1710: 
1711:     sp = & stab[ i= *idindex ]; /* position search at old entry */
1712:     while( sp->stype != TNULL ){ /* locate unused entry */
1713:         if( ++i >= SYMTSZ ){/* wrap around symbol table */
1714:             i = 0;
1715:             sp = stab;
1716:             }
1717:         else ++sp;
1718:         if( i == *idindex ) cerror("Symbol table full");
1719:         }
1720:     sp->sflags = SNONUNIQ | SMOS;
1721:     p = sp->sname;
1722:     q = stab[*idindex].sname; /* old entry name */
1723: #ifdef FLEXNAMES
1724:     sp->sname = stab[*idindex].sname;
1725: #endif
1726: # ifndef BUG1
1727:     if( ddebug ){
1728:         printf("\tnonunique entry for %s from %d to %d\n",
1729:             q, *idindex, i );
1730:         }
1731: # endif
1732:     *idindex = i;
1733: #ifndef FLEXNAMES
1734:     for( i=1; i<=NCHNAM; ++i ){ /* copy name */
1735:         if( *p++ = *q /* assign */ ) ++q;
1736:         }
1737: #endif
1738:     return ( sp );
1739:     }
1740: 
1741: lookup( name, s) char *name; {
1742:     /* look up name: must agree with s w.r.t. STAG, SMOS and SHIDDEN */
1743: 
1744:     register char *p, *q;
1745:     unsigned int i, j, ii;
1746:     register struct symtab *sp;
1747: 
1748:     /* compute initial hash index */
1749: # ifndef BUG1
1750:     if( ddebug > 2 ){
1751:         printf( "lookup( %s, %d ), stwart=%d, instruct=%d\n", name, s, stwart, instruct );
1752:         }
1753: # endif
1754: 
1755:     i = 0;
1756: #ifndef FLEXNAMES
1757:     for( p=name, j=0; *p != '\0'; ++p ){
1758:         i += *p;
1759:         if( ++j >= NCHNAM ) break;
1760:         }
1761: #else
1762:     i = (int)name;
1763: #endif
1764:     i = i%SYMTSZ;
1765:     sp = &stab[ii=i];
1766: 
1767:     for(;;){ /* look for name */
1768: 
1769:         if( sp->stype == TNULL ){ /* empty slot */
1770:             sp->sflags = s;  /* set STAG, SMOS if needed, turn off all others */
1771: #ifndef FLEXNAMES
1772:             p = sp->sname;
1773:             for( j=0; j<NCHNAM; ++j ) if( *p++ = *name ) ++name;
1774: #else
1775:             sp->sname = name;
1776: #endif
1777:             sp->stype = UNDEF;
1778:             sp->sclass = SNULL;
1779:             return( i );
1780:             }
1781:         if( (sp->sflags & (STAG|SMOS|SHIDDEN)) != s ) goto next;
1782:         p = sp->sname;
1783:         q = name;
1784: #ifndef FLEXNAMES
1785:         for( j=0; j<NCHNAM;++j ){
1786:             if( *p++ != *q ) goto next;
1787:             if( !*q++ ) break;
1788:             }
1789:         return( i );
1790: #else
1791:         if (p == q)
1792:             return ( i );
1793: #endif
1794:     next:
1795:         if( ++i >= SYMTSZ ){
1796:             i = 0;
1797:             sp = stab;
1798:             }
1799:         else ++sp;
1800:         if( i == ii ) cerror("symbol table full" );
1801:         }
1802:     }
1803: 
1804: #ifndef checkst
1805: /* if not debugging, make checkst a macro */
1806: checkst(lev){
1807:     register int s, i, j;
1808:     register struct symtab *p, *q;
1809: 
1810:     for( i=0, p=stab; i<SYMTSZ; ++i, ++p ){
1811:         if( p->stype == TNULL ) continue;
1812:         j = lookup( p->sname, p->sflags&(SMOS|STAG) );
1813:         if( j != i ){
1814:             q = &stab[j];
1815:             if( q->stype == UNDEF ||
1816:                 q->slevel <= p->slevel ){
1817: #ifndef FLEXNAMES
1818:                 cerror("check error: %.8s", q->sname );
1819: #else
1820:                 cerror("check error: %s", q->sname );
1821: #endif
1822:                 }
1823:             }
1824: #ifndef FLEXNAMES
1825:         else if( p->slevel > lev ) cerror("%.8s check at level %d", p->sname, lev );
1826: #else
1827:         else if( p->slevel > lev ) cerror("%s check at level %d", p->sname, lev );
1828: #endif
1829:         }
1830:     }
1831: #endif
1832: 
1833: struct symtab *
1834: relook(p) register struct symtab *p; {  /* look up p again, and see where it lies */
1835: 
1836:     register struct symtab *q;
1837: 
1838:     /* I'm not sure that this handles towers of several hidden definitions in all cases */
1839:     q = &stab[lookup( p->sname, p->sflags&(STAG|SMOS|SHIDDEN) )];
1840:     /* make relook always point to either p or an empty cell */
1841:     if( q->stype == UNDEF ){
1842:         q->stype = TNULL;
1843:         return(q);
1844:         }
1845:     while( q != p ){
1846:         if( q->stype == TNULL ) break;
1847:         if( ++q >= &stab[SYMTSZ] ) q=stab;
1848:         }
1849:     return(q);
1850:     }
1851: 
1852: clearst( lev ) register int lev; {
1853:     register struct symtab *p, *q;
1854:     register int temp;
1855:     struct symtab *clist = 0;
1856: 
1857:     temp = lineno;
1858:     aobeg();
1859: 
1860:     /* step 1: remove entries */
1861:     while( chaintop-1 > lev ){
1862:         register int type;
1863: 
1864:         p = schain[--chaintop];
1865:         schain[chaintop] = 0;
1866:         for( ; p; p = q ){
1867:             q = p->snext;
1868:             type = p->stype;
1869:             if( p->stype == TNULL || p->slevel <= lev )
1870:                 cerror("schain botch" );
1871:             lineno = p->suse < 0 ? -p->suse : p->suse;
1872:             if( p->stype==UNDEF || ( p->sclass==ULABEL && lev<2 ) ){
1873:                 lineno = temp;
1874: #ifndef FLEXNAMES
1875:                 uerror("%.8s undefined", p->sname );
1876: #else
1877:                 uerror("%s undefined", p->sname );
1878: #endif
1879:                 }
1880:             else aocode(p);
1881: # ifndef BUG1
1882:             if( ddebug ){
1883: #ifndef FLEXNAMES
1884:                 printf( "removing %.8s", p->sname );
1885: #else
1886:                 printf( "removing %s", p->sname );
1887: #endif
1888:                 printf( " from stab[%d], flags %o level %d\n",
1889:                     p-stab, p->sflags, p->slevel);
1890:                 }
1891: # endif
1892:             if( p->sflags & SHIDES )unhide( p );
1893:             p->stype = TNULL;
1894:             p->snext = clist;
1895:             clist = p;
1896:             }
1897:         }
1898: 
1899:     /* step 2: fix any mishashed entries */
1900:     p = clist;
1901:     while( p ){
1902:         register struct symtab *next, **t, *r;
1903: 
1904:         q = p;
1905:         next = p->snext;
1906:         for(;;){
1907:             if( ++q >= &stab[SYMTSZ] )q = stab;
1908:             if( q == p || q->stype == TNULL )break;
1909:             if( (r = relook(q)) != q ) {
1910:                 /* move q in schain list */
1911:                 t = &schain[q->slevel];
1912:                 while( *t && *t != q )
1913:                     t = &(*t)->snext;
1914:                 if( *t )
1915:                     *t = r;
1916:                 else
1917:                     cerror("schain botch 2");
1918:                 *r = *q;
1919:                 q->stype = TNULL;
1920:                 }
1921:             }
1922:         p = next;
1923:         }
1924: 
1925:     lineno = temp;
1926:     aoend();
1927:     }
1928: 
1929: hide( p ) register struct symtab *p; {
1930:     register struct symtab *q;
1931:     for( q=p+1; ; ++q ){
1932:         if( q >= &stab[SYMTSZ] ) q = stab;
1933:         if( q == p ) cerror("symbol table full" );
1934:         if( q->stype == TNULL ) break;
1935:         }
1936:     *q = *p;
1937:     p->sflags |= SHIDDEN;
1938:     q->sflags = (p->sflags&(SMOS|STAG)) | SHIDES;
1939: #ifndef FLEXNAMES
1940:     if( hflag ) werror("%.8s redefinition hides earlier one", p->sname );
1941: #else
1942:     if( hflag ) werror("%s redefinition hides earlier one", p->sname );
1943: #endif
1944: # ifndef BUG1
1945:     if( ddebug ) printf( "	%d hidden in %d\n", p-stab, q-stab );
1946: # endif
1947:     return( idname = q-stab );
1948:     }
1949: 
1950: unhide( p ) register struct symtab *p; {
1951:     register struct symtab *q;
1952:     register s, j;
1953: 
1954:     s = p->sflags & (SMOS|STAG);
1955:     q = p;
1956: 
1957:     for(;;){
1958: 
1959:         if( q == stab ) q = &stab[SYMTSZ-1];
1960:         else --q;
1961: 
1962:         if( q == p ) break;
1963: 
1964:         if( (q->sflags&(SMOS|STAG)) == s ){
1965: #ifndef FLEXNAMES
1966:             for( j =0; j<NCHNAM; ++j ) if( p->sname[j] != q->sname[j] ) break;
1967:             if( j == NCHNAM ){ /* found the name */
1968: #else
1969:             if (p->sname == q->sname) {
1970: #endif
1971:                 q->sflags &= ~SHIDDEN;
1972: # ifndef BUG1
1973:                 if( ddebug ) printf( "unhide uncovered %d from %d\n", q-stab,p-stab);
1974: # endif
1975:                 return;
1976:                 }
1977:             }
1978: 
1979:         }
1980:     cerror("unhide fails" );
1981:     }

Defined functions

beginit defined in line 840; used 2 times
bstruct defined in line 505; used 4 times
checkst defined in line 1806; never used
clearst defined in line 1852; used 2 times
dclargs defined in line 430; used 1 times
dclstruct defined in line 536; used 3 times
defid defined in line 36; used 20 times
doinit defined in line 1041; used 2 times
endinit defined in line 985; used 3 times
falloc defined in line 1281; used 3 times
fixclass defined in line 1603; used 1 times
  • in line 70
fixtype defined in line 1549; used 1 times
  • in line 67
ftnarg defined in line 665; used 2 times
ftnend defined in line 405; used 3 times
getstr defined in line 943; used 2 times
gotscal defined in line 1133; used 3 times
hide defined in line 1929; used 2 times
ilbrace defined in line 1173; used 2 times
inforce defined in line 781; used 6 times
instk defined in line 879; used 3 times
irbrace defined in line 1199; used 2 times
lookup defined in line 1741; used 6 times
mknonuniq defined in line 1703; used 2 times
moedef defined in line 497; used 2 times
nidcl defined in line 1370; used 1 times
oalloc defined in line 1244; used 4 times
psave defined in line 398; used 11 times
putbyte defined in line 977; used 2 times
relook defined in line 1833; used 2 times
rstruct defined in line 465; used 3 times
talign defined in line 694; used 8 times
tsize defined in line 744; used 15 times
tymerge defined in line 1481; used 11 times
types defined in line 1421; used 4 times
tyreduce defined in line 1516; used 2 times
uclass defined in line 1595; used 1 times
unhide defined in line 1950; used 1 times
upoff defined in line 1226; used 2 times
vfdalign defined in line 821; used 3 times
yyaccpt defined in line 661; used 1 times
yyerror defined in line 655; never used

Defined variables

chaintop defined in line 10; used 5 times
ddebug defined in line 32; used 15 times
ibseen defined in line 832; used 5 times
iclass defined in line 836; used 18 times
idebug defined in line 830; used 5 times
ifull defined in line 834; used 4 times
ilocctr defined in line 838; used 3 times
instack defined in line 23; used 8 times
pstk defined in line 24; used 66 times
sccsid defined in line 2; never used
schain defined in line 9; used 5 times

Defined struct's

instk defined in line 12; used 2 times
Last modified: 1995-01-18
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 7087
Valid CSS Valid XHTML 1.0 Strict