2.9BSD - /usr/src/cmd/mip/pftn.c

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

Defined functions

Defined variables

Defined struct's