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