1*16178Sralph static char *sccsid ="@(#)pftn.c 1.4 (Berkeley) 03/14/84"; 213939Slinton # include "mfile1" 313939Slinton 413939Slinton unsigned int offsz; 513939Slinton 613939Slinton struct instk { 713939Slinton int in_sz; /* size of array element */ 813939Slinton int in_x; /* current index for structure member in structure initializations */ 913939Slinton int in_n; /* number of initializations seen */ 1013939Slinton int in_s; /* sizoff */ 1113939Slinton int in_d; /* dimoff */ 1213939Slinton TWORD in_t; /* type */ 1313939Slinton int in_id; /* stab index */ 1413939Slinton int in_fl; /* flag which says if this level is controlled by {} */ 1513939Slinton OFFSZ in_off; /* offset of the beginning of this level */ 1613939Slinton } 1713939Slinton instack[10], 1813939Slinton *pstk; 1913939Slinton 2013939Slinton /* defines used for getting things off of the initialization stack */ 2113939Slinton 2213939Slinton 2313939Slinton struct symtab *relook(); 2413939Slinton 2513939Slinton 2613939Slinton int ddebug = 0; 2713939Slinton 2813939Slinton struct symtab * mknonuniq(); 2913939Slinton 3013939Slinton defid( q, class ) NODE *q; { 3113939Slinton register struct symtab *p; 3213939Slinton int idp; 3313939Slinton TWORD type; 3413939Slinton TWORD stp; 3513939Slinton int scl; 3613939Slinton int dsym, ddef; 3713939Slinton int slev, temp; 3813940Slinton int changed; 3913939Slinton 4013939Slinton if( q == NIL ) return; /* an error was detected */ 4113939Slinton 4213939Slinton if( q < node || q >= &node[TREESZ] ) cerror( "defid call" ); 4313939Slinton 4413939Slinton idp = q->tn.rval; 4513939Slinton 4613939Slinton if( idp < 0 ) cerror( "tyreduce" ); 4713939Slinton p = &stab[idp]; 4813939Slinton 4913939Slinton # ifndef BUG1 5013939Slinton if( ddebug ){ 5113939Slinton #ifndef FLEXNAMES 5213939Slinton printf( "defid( %.8s (%d), ", p->sname, idp ); 5313939Slinton #else 5413939Slinton printf( "defid( %s (%d), ", p->sname, idp ); 5513939Slinton #endif 5613939Slinton tprint( q->in.type ); 5713939Slinton printf( ", %s, (%d,%d) ), level %d\n", scnames(class), q->fn.cdim, q->fn.csiz, blevel ); 5813939Slinton } 5913939Slinton # endif 6013939Slinton 6113939Slinton fixtype( q, class ); 6213939Slinton 6313939Slinton type = q->in.type; 6413939Slinton class = fixclass( class, type ); 6513939Slinton 6613939Slinton stp = p->stype; 6713939Slinton slev = p->slevel; 6813939Slinton 6913939Slinton # ifndef BUG1 7013939Slinton if( ddebug ){ 7113939Slinton printf( " modified to " ); 7213939Slinton tprint( type ); 7313939Slinton printf( ", %s\n", scnames(class) ); 7413939Slinton printf( " previous def'n: " ); 7513939Slinton tprint( stp ); 7613939Slinton printf( ", %s, (%d,%d) ), level %d\n", scnames(p->sclass), p->dimoff, p->sizoff, slev ); 7713939Slinton } 7813939Slinton # endif 7913939Slinton 8013939Slinton if( stp == FTN && p->sclass == SNULL )goto enter; 8113939Slinton /* name encountered as function, not yet defined */ 8213939Slinton if( stp == UNDEF|| stp == FARG ){ 8313939Slinton if( blevel==1 && stp!=FARG ) switch( class ){ 8413939Slinton 8513939Slinton default: 8613939Slinton #ifndef FLEXNAMES 8713939Slinton if(!(class&FIELD)) uerror( "declared argument %.8s is missing", p->sname ); 8813939Slinton #else 8913939Slinton if(!(class&FIELD)) uerror( "declared argument %s is missing", p->sname ); 9013939Slinton #endif 9113939Slinton case MOS: 9213939Slinton case STNAME: 9313939Slinton case MOU: 9413939Slinton case UNAME: 9513939Slinton case MOE: 9613939Slinton case ENAME: 9713939Slinton case TYPEDEF: 9813939Slinton ; 9913939Slinton } 10013939Slinton goto enter; 10113939Slinton } 10213939Slinton 10313939Slinton if( type != stp ) goto mismatch; 10413939Slinton /* test (and possibly adjust) dimensions */ 10513939Slinton dsym = p->dimoff; 10613939Slinton ddef = q->fn.cdim; 10713940Slinton changed = 0; 10813939Slinton for( temp=type; temp&TMASK; temp = DECREF(temp) ){ 10913939Slinton if( ISARY(temp) ){ 11013940Slinton if (dimtab[dsym] == 0) { 11113940Slinton dimtab[dsym] = dimtab[ddef]; 11213940Slinton changed = 1; 11313940Slinton } 11413940Slinton else if (dimtab[ddef]!=0&&dimtab[dsym]!=dimtab[ddef]) { 11513939Slinton goto mismatch; 11613939Slinton } 11713939Slinton ++dsym; 11813939Slinton ++ddef; 11913939Slinton } 12013939Slinton } 12113939Slinton 12213940Slinton if (changed) { 12313940Slinton FIXDEF(p); 12413940Slinton } 12513940Slinton 12613939Slinton /* check that redeclarations are to the same structure */ 12713939Slinton if( (temp==STRTY||temp==UNIONTY||temp==ENUMTY) && p->sizoff != q->fn.csiz 12813939Slinton && class!=STNAME && class!=UNAME && class!=ENAME ){ 12913939Slinton goto mismatch; 13013939Slinton } 13113939Slinton 13213939Slinton scl = ( p->sclass ); 13313939Slinton 13413939Slinton # ifndef BUG1 13513939Slinton if( ddebug ){ 13613939Slinton printf( " previous class: %s\n", scnames(scl) ); 13713939Slinton } 13813939Slinton # endif 13913939Slinton 14013939Slinton if( class&FIELD ){ 14113939Slinton /* redefinition */ 14213939Slinton if( !falloc( p, class&FLDSIZ, 1, NIL ) ) { 14313939Slinton /* successful allocation */ 14413939Slinton psave( idp ); 14513939Slinton return; 14613939Slinton } 14713939Slinton /* blew it: resume at end of switch... */ 14813939Slinton } 14913939Slinton 15013939Slinton else switch( class ){ 15113939Slinton 15213939Slinton case EXTERN: 15313939Slinton switch( scl ){ 15413939Slinton case STATIC: 15513939Slinton case USTATIC: 15613939Slinton if( slev==0 ) return; 15713939Slinton break; 15813939Slinton case EXTDEF: 15913939Slinton case EXTERN: 16013939Slinton case FORTRAN: 16113939Slinton case UFORTRAN: 16213939Slinton return; 16313939Slinton } 16413939Slinton break; 16513939Slinton 16613939Slinton case STATIC: 16713939Slinton if( scl==USTATIC || (scl==EXTERN && blevel==0) ){ 16813939Slinton p->sclass = STATIC; 16913939Slinton if( ISFTN(type) ) curftn = idp; 17013939Slinton return; 17113939Slinton } 17213939Slinton break; 17313939Slinton 17413939Slinton case USTATIC: 17513939Slinton if( scl==STATIC || scl==USTATIC ) return; 17613939Slinton break; 17713939Slinton 17813939Slinton case LABEL: 17913939Slinton if( scl == ULABEL ){ 18013939Slinton p->sclass = LABEL; 18113939Slinton deflab( p->offset ); 18213939Slinton return; 18313939Slinton } 18413939Slinton break; 18513939Slinton 18613939Slinton case TYPEDEF: 18713939Slinton if( scl == class ) return; 18813939Slinton break; 18913939Slinton 19013939Slinton case UFORTRAN: 19113939Slinton if( scl == UFORTRAN || scl == FORTRAN ) return; 19213939Slinton break; 19313939Slinton 19413939Slinton case FORTRAN: 19513939Slinton if( scl == UFORTRAN ){ 19613939Slinton p->sclass = FORTRAN; 19713939Slinton if( ISFTN(type) ) curftn = idp; 19813939Slinton return; 19913939Slinton } 20013939Slinton break; 20113939Slinton 20213939Slinton case MOU: 20313939Slinton case MOS: 20413939Slinton if( scl == class ) { 20513939Slinton if( oalloc( p, &strucoff ) ) break; 20613939Slinton if( class == MOU ) strucoff = 0; 20713939Slinton psave( idp ); 20813939Slinton return; 20913939Slinton } 21013939Slinton break; 21113939Slinton 21213939Slinton case MOE: 21313939Slinton if( scl == class ){ 21413939Slinton if( p->offset!= strucoff++ ) break; 21513939Slinton psave( idp ); 21613939Slinton } 21713939Slinton break; 21813939Slinton 21913939Slinton case EXTDEF: 22013939Slinton if( scl == EXTERN ) { 22113939Slinton p->sclass = EXTDEF; 22213939Slinton if( ISFTN(type) ) curftn = idp; 22313939Slinton return; 22413939Slinton } 22513939Slinton break; 22613939Slinton 22713939Slinton case STNAME: 22813939Slinton case UNAME: 22913939Slinton case ENAME: 23013939Slinton if( scl != class ) break; 23113939Slinton if( dimtab[p->sizoff] == 0 ) return; /* previous entry just a mention */ 23213939Slinton break; 23313939Slinton 23413939Slinton case ULABEL: 23513939Slinton if( scl == LABEL || scl == ULABEL ) return; 23613939Slinton case PARAM: 23713939Slinton case AUTO: 23813939Slinton case REGISTER: 23913939Slinton ; /* mismatch.. */ 24013939Slinton 24113939Slinton } 24213939Slinton 24313939Slinton mismatch: 24413939Slinton /* allow nonunique structure/union member names */ 24513939Slinton 24613939Slinton if( class==MOU || class==MOS || class & FIELD ){/* make a new entry */ 24713939Slinton int * memp; 24813939Slinton p->sflags |= SNONUNIQ; /* old entry is nonunique */ 24913939Slinton /* determine if name has occurred in this structure/union */ 25013939Slinton for( memp = ¶mstk[paramno-1]; 25113939Slinton /* while */ *memp>=0 && stab[*memp].sclass != STNAME 25213939Slinton && stab[*memp].sclass != UNAME; 25313939Slinton /* iterate */ --memp){ char * cname, * oname; 25413939Slinton if( stab[*memp].sflags & SNONUNIQ ){int k; 25513939Slinton cname=p->sname; 25613939Slinton oname=stab[*memp].sname; 25713939Slinton #ifndef FLEXNAMES 25813939Slinton for(k=1; k<=NCHNAM; ++k){ 25913939Slinton if(*cname++ != *oname)goto diff; 26013939Slinton if(!*oname++)break; 26113939Slinton } 26213939Slinton #else 26313939Slinton if (cname != oname) goto diff; 26413939Slinton #endif 26513939Slinton uerror("redeclaration of: %s",p->sname); 26613939Slinton break; 26713939Slinton diff: continue; 26813939Slinton } 26913939Slinton } 27013939Slinton p = mknonuniq( &idp ); /* update p and idp to new entry */ 27113939Slinton goto enter; 27213939Slinton } 27313939Slinton if( blevel > slev && class != EXTERN && class != FORTRAN && 27413939Slinton class != UFORTRAN && !( class == LABEL && slev >= 2 ) ){ 27513939Slinton q->tn.rval = idp = hide( p ); 27613939Slinton p = &stab[idp]; 27713939Slinton goto enter; 27813939Slinton } 27913939Slinton #ifndef FLEXNAMES 28013939Slinton uerror( "redeclaration of %.8s", p->sname ); 28113939Slinton #else 28213939Slinton uerror( "redeclaration of %s", p->sname ); 28313939Slinton #endif 28413939Slinton if( class==EXTDEF && ISFTN(type) ) curftn = idp; 28513939Slinton return; 28613939Slinton 28713939Slinton enter: /* make a new entry */ 28813939Slinton 28913939Slinton # ifndef BUG1 29013939Slinton if( ddebug ) printf( " new entry made\n" ); 29113939Slinton # endif 29213939Slinton if( type == UNDEF ) uerror("void type for %s",p->sname); 29313939Slinton p->stype = type; 29413939Slinton p->sclass = class; 29513939Slinton p->slevel = blevel; 29613939Slinton p->offset = NOOFFSET; 29713939Slinton p->suse = lineno; 29813939Slinton if( class == STNAME || class == UNAME || class == ENAME ) { 29913939Slinton p->sizoff = curdim; 30013939Slinton dstash( 0 ); /* size */ 30113939Slinton dstash( -1 ); /* index to members of str or union */ 30213939Slinton dstash( ALSTRUCT ); /* alignment */ 30313939Slinton dstash( idp ); 30413939Slinton } 30513939Slinton else { 30613939Slinton switch( BTYPE(type) ){ 30713939Slinton case STRTY: 30813939Slinton case UNIONTY: 30913939Slinton case ENUMTY: 31013939Slinton p->sizoff = q->fn.csiz; 31113939Slinton break; 31213939Slinton default: 31313939Slinton p->sizoff = BTYPE(type); 31413939Slinton } 31513939Slinton } 31613939Slinton 31713939Slinton /* copy dimensions */ 31813939Slinton 31913939Slinton p->dimoff = q->fn.cdim; 32013939Slinton 32113939Slinton /* allocate offsets */ 32213939Slinton if( class&FIELD ){ 32313939Slinton falloc( p, class&FLDSIZ, 0, NIL ); /* new entry */ 32413939Slinton psave( idp ); 32513939Slinton } 32613939Slinton else switch( class ){ 32713939Slinton 32813939Slinton case AUTO: 32913939Slinton oalloc( p, &autooff ); 33013939Slinton break; 33113939Slinton case STATIC: 33213939Slinton case EXTDEF: 33313939Slinton p->offset = getlab(); 33413939Slinton if( ISFTN(type) ) curftn = idp; 33513939Slinton break; 33613939Slinton case ULABEL: 33713939Slinton case LABEL: 33813939Slinton p->offset = getlab(); 33913939Slinton p->slevel = 2; 34013939Slinton if( class == LABEL ){ 34113939Slinton locctr( PROG ); 34213939Slinton deflab( p->offset ); 34313939Slinton } 34413939Slinton break; 34513939Slinton 34613939Slinton case EXTERN: 34713939Slinton case UFORTRAN: 34813939Slinton case FORTRAN: 34913939Slinton p->offset = getlab(); 35013939Slinton p->slevel = 0; 35113939Slinton break; 35213939Slinton case MOU: 35313939Slinton case MOS: 35413939Slinton oalloc( p, &strucoff ); 35513939Slinton if( class == MOU ) strucoff = 0; 35613939Slinton psave( idp ); 35713939Slinton break; 35813939Slinton 35913939Slinton case MOE: 36013939Slinton p->offset = strucoff++; 36113939Slinton psave( idp ); 36213939Slinton break; 36313939Slinton case REGISTER: 36413939Slinton p->offset = regvar--; 36513939Slinton if( blevel == 1 ) p->sflags |= SSET; 36613939Slinton if( regvar < minrvar ) minrvar = regvar; 36713939Slinton break; 36813939Slinton } 36913939Slinton 37013939Slinton /* user-supplied routine to fix up new definitions */ 37113939Slinton 37213939Slinton FIXDEF(p); 37313939Slinton 37413939Slinton # ifndef BUG1 37513939Slinton if( ddebug ) printf( " dimoff, sizoff, offset: %d, %d, %d\n", p->dimoff, p->sizoff, p->offset ); 37613939Slinton # endif 37713939Slinton 37813939Slinton } 37913939Slinton 38013939Slinton psave( i ){ 38113939Slinton if( paramno >= PARAMSZ ){ 38213939Slinton cerror( "parameter stack overflow"); 38313939Slinton } 38413939Slinton paramstk[ paramno++ ] = i; 38513939Slinton } 38613939Slinton 38713939Slinton ftnend(){ /* end of function */ 38813939Slinton if( retlab != NOLAB ){ /* inside a real function */ 38913939Slinton efcode(); 39013939Slinton } 39113939Slinton checkst(0); 39213939Slinton retstat = 0; 39313939Slinton tcheck(); 39413939Slinton curclass = SNULL; 39513939Slinton brklab = contlab = retlab = NOLAB; 39613939Slinton flostat = 0; 39713939Slinton if( nerrors == 0 ){ 39813939Slinton if( psavbc != & asavbc[0] ) cerror("bcsave error"); 39913939Slinton if( paramno != 0 ) cerror("parameter reset error"); 40013939Slinton if( swx != 0 ) cerror( "switch error"); 40113939Slinton } 40213939Slinton psavbc = &asavbc[0]; 40313939Slinton paramno = 0; 40413939Slinton autooff = AUTOINIT; 40513939Slinton minrvar = regvar = MAXRVAR; 40613939Slinton reached = 1; 40713939Slinton swx = 0; 40813939Slinton swp = swtab; 40913939Slinton locctr(DATA); 41013939Slinton } 41113939Slinton 41213939Slinton dclargs(){ 41313939Slinton register i, j; 41413939Slinton register struct symtab *p; 41513939Slinton register NODE *q; 41613939Slinton argoff = ARGINIT; 41713939Slinton # ifndef BUG1 41813939Slinton if( ddebug > 2) printf("dclargs()\n"); 41913939Slinton # endif 42013939Slinton for( i=0; i<paramno; ++i ){ 42113939Slinton if( (j = paramstk[i]) < 0 ) continue; 42213939Slinton p = &stab[j]; 42313939Slinton # ifndef BUG1 42413939Slinton if( ddebug > 2 ){ 42513939Slinton printf("\t%s (%d) ",p->sname, j); 42613939Slinton tprint(p->stype); 42713939Slinton printf("\n"); 42813939Slinton } 42913939Slinton # endif 43013939Slinton if( p->stype == FARG ) { 43113939Slinton q = block(FREE,NIL,NIL,INT,0,INT); 43213939Slinton q->tn.rval = j; 43313939Slinton defid( q, PARAM ); 43413939Slinton } 43513939Slinton FIXARG(p); /* local arg hook, eg. for sym. debugger */ 43613939Slinton oalloc( p, &argoff ); /* always set aside space, even for register arguments */ 43713939Slinton } 43813939Slinton cendarg(); 43913939Slinton locctr(PROG); 44013939Slinton defalign(ALINT); 44113939Slinton ftnno = getlab(); 44213939Slinton bfcode( paramstk, paramno ); 44313939Slinton paramno = 0; 44413939Slinton } 44513939Slinton 44613939Slinton NODE * 44713939Slinton rstruct( idn, soru ){ /* reference to a structure or union, with no definition */ 44813939Slinton register struct symtab *p; 44913939Slinton register NODE *q; 45013939Slinton p = &stab[idn]; 45113939Slinton switch( p->stype ){ 45213939Slinton 45313939Slinton case UNDEF: 45413939Slinton def: 45513939Slinton q = block( FREE, NIL, NIL, 0, 0, 0 ); 45613939Slinton q->tn.rval = idn; 45713939Slinton q->in.type = (soru&INSTRUCT) ? STRTY : ( (soru&INUNION) ? UNIONTY : ENUMTY ); 45813939Slinton defid( q, (soru&INSTRUCT) ? STNAME : ( (soru&INUNION) ? UNAME : ENAME ) ); 45913939Slinton break; 46013939Slinton 46113939Slinton case STRTY: 46213939Slinton if( soru & INSTRUCT ) break; 46313939Slinton goto def; 46413939Slinton 46513939Slinton case UNIONTY: 46613939Slinton if( soru & INUNION ) break; 46713939Slinton goto def; 46813939Slinton 46913939Slinton case ENUMTY: 47013939Slinton if( !(soru&(INUNION|INSTRUCT)) ) break; 47113939Slinton goto def; 47213939Slinton 47313939Slinton } 47413939Slinton stwart = instruct; 47513939Slinton return( mkty( p->stype, 0, p->sizoff ) ); 47613939Slinton } 47713939Slinton 47813939Slinton moedef( idn ){ 47913939Slinton register NODE *q; 48013939Slinton 48113939Slinton q = block( FREE, NIL, NIL, MOETY, 0, 0 ); 48213939Slinton q->tn.rval = idn; 48313939Slinton if( idn>=0 ) defid( q, MOE ); 48413939Slinton } 48513939Slinton 48613939Slinton bstruct( idn, soru ){ /* begining of structure or union declaration */ 48713939Slinton register NODE *q; 48813939Slinton 48913939Slinton psave( instruct ); 49013939Slinton psave( curclass ); 49113939Slinton psave( strucoff ); 49213939Slinton strucoff = 0; 49313939Slinton instruct = soru; 49413939Slinton q = block( FREE, NIL, NIL, 0, 0, 0 ); 49513939Slinton q->tn.rval = idn; 49613939Slinton if( instruct==INSTRUCT ){ 49713939Slinton curclass = MOS; 49813939Slinton q->in.type = STRTY; 49913939Slinton if( idn >= 0 ) defid( q, STNAME ); 50013939Slinton } 50113939Slinton else if( instruct == INUNION ) { 50213939Slinton curclass = MOU; 50313939Slinton q->in.type = UNIONTY; 50413939Slinton if( idn >= 0 ) defid( q, UNAME ); 50513939Slinton } 50613939Slinton else { /* enum */ 50713939Slinton curclass = MOE; 50813939Slinton q->in.type = ENUMTY; 50913939Slinton if( idn >= 0 ) defid( q, ENAME ); 51013939Slinton } 51113939Slinton psave( idn = q->tn.rval ); 51213939Slinton /* the "real" definition is where the members are seen */ 51313939Slinton if ( idn >= 0 ) stab[idn].suse = lineno; 51413939Slinton return( paramno-4 ); 51513939Slinton } 51613939Slinton 51713939Slinton NODE * 51813939Slinton dclstruct( oparam ){ 51913939Slinton register struct symtab *p; 52013939Slinton register i, al, sa, j, sz, szindex; 52113939Slinton register TWORD temp; 52213939Slinton register high, low; 52313939Slinton 52413939Slinton /* paramstack contains: 52513939Slinton paramstack[ oparam ] = previous instruct 52613939Slinton paramstack[ oparam+1 ] = previous class 52713939Slinton paramstk[ oparam+2 ] = previous strucoff 52813939Slinton paramstk[ oparam+3 ] = structure name 52913939Slinton 53013939Slinton paramstk[ oparam+4, ... ] = member stab indices 53113939Slinton 53213939Slinton */ 53313939Slinton 53413939Slinton 53513939Slinton if( (i=paramstk[oparam+3]) < 0 ){ 53613939Slinton szindex = curdim; 53713939Slinton dstash( 0 ); /* size */ 53813939Slinton dstash( -1 ); /* index to member names */ 53913939Slinton dstash( ALSTRUCT ); /* alignment */ 54013939Slinton dstash( -lineno ); /* name of structure */ 54113939Slinton } 54213939Slinton else { 54313939Slinton szindex = stab[i].sizoff; 54413939Slinton } 54513939Slinton 54613939Slinton # ifndef BUG1 54713939Slinton if( ddebug ){ 54813939Slinton #ifndef FLEXNAMES 54913939Slinton printf( "dclstruct( %.8s ), szindex = %d\n", (i>=0)? stab[i].sname : "??", szindex ); 55013939Slinton #else 55113939Slinton printf( "dclstruct( %s ), szindex = %d\n", (i>=0)? stab[i].sname : "??", szindex ); 55213939Slinton #endif 55313939Slinton } 55413939Slinton # endif 55513939Slinton temp = (instruct&INSTRUCT)?STRTY:((instruct&INUNION)?UNIONTY:ENUMTY); 55613939Slinton stwart = instruct = paramstk[ oparam ]; 55713939Slinton curclass = paramstk[ oparam+1 ]; 55813939Slinton dimtab[ szindex+1 ] = curdim; 55913939Slinton al = ALSTRUCT; 56013939Slinton 56113939Slinton high = low = 0; 56213939Slinton 56313939Slinton for( i = oparam+4; i< paramno; ++i ){ 56413939Slinton dstash( j=paramstk[i] ); 56513939Slinton if( j<0 || j>= SYMTSZ ) cerror( "gummy structure member" ); 56613939Slinton p = &stab[j]; 56713939Slinton if( temp == ENUMTY ){ 56813939Slinton if( p->offset < low ) low = p->offset; 56913939Slinton if( p->offset > high ) high = p->offset; 57013939Slinton p->sizoff = szindex; 57113939Slinton continue; 57213939Slinton } 57313939Slinton sa = talign( p->stype, p->sizoff ); 57413939Slinton if( p->sclass & FIELD ){ 57513939Slinton sz = p->sclass&FLDSIZ; 57613939Slinton } 57713939Slinton else { 57813939Slinton sz = tsize( p->stype, p->dimoff, p->sizoff ); 57913939Slinton } 58013939Slinton if( sz == 0 ){ 58113939Slinton #ifndef FLEXNAMES 58213939Slinton werror( "illegal zero sized structure member: %.8s", p->sname ); 58313939Slinton #else 58413939Slinton werror( "illegal zero sized structure member: %s", p->sname ); 58513939Slinton #endif 58613939Slinton } 58713939Slinton if( sz > strucoff ) strucoff = sz; /* for use with unions */ 58813939Slinton SETOFF( al, sa ); 58913939Slinton /* set al, the alignment, to the lcm of the alignments of the members */ 59013939Slinton } 59113939Slinton dstash( -1 ); /* endmarker */ 59213939Slinton SETOFF( strucoff, al ); 59313939Slinton 59413939Slinton if( temp == ENUMTY ){ 59513939Slinton register TWORD ty; 59613939Slinton 59713939Slinton # ifdef ENUMSIZE 59813939Slinton ty = ENUMSIZE(high,low); 59913939Slinton # else 60013939Slinton if( (char)high == high && (char)low == low ) ty = ctype( CHAR ); 60113939Slinton else if( (short)high == high && (short)low == low ) ty = ctype( SHORT ); 60213939Slinton else ty = ctype(INT); 60313939Slinton #endif 60413939Slinton strucoff = tsize( ty, 0, (int)ty ); 60513939Slinton dimtab[ szindex+2 ] = al = talign( ty, (int)ty ); 60613939Slinton } 60713939Slinton 60813939Slinton if( strucoff == 0 ) uerror( "zero sized structure" ); 60913939Slinton dimtab[ szindex ] = strucoff; 61013939Slinton dimtab[ szindex+2 ] = al; 61113939Slinton dimtab[ szindex+3 ] = paramstk[ oparam+3 ]; /* name index */ 61213939Slinton 61313939Slinton FIXSTRUCT( szindex, oparam ); /* local hook, eg. for sym debugger */ 61413939Slinton # ifndef BUG1 61513939Slinton if( ddebug>1 ){ 61613939Slinton printf( "\tdimtab[%d,%d,%d] = %d,%d,%d\n", szindex,szindex+1,szindex+2, 61713939Slinton dimtab[szindex],dimtab[szindex+1],dimtab[szindex+2] ); 61813939Slinton for( i = dimtab[szindex+1]; dimtab[i] >= 0; ++i ){ 61913939Slinton #ifndef FLEXNAMES 62013939Slinton printf( "\tmember %.8s(%d)\n", stab[dimtab[i]].sname, dimtab[i] ); 62113939Slinton #else 62213939Slinton printf( "\tmember %s(%d)\n", stab[dimtab[i]].sname, dimtab[i] ); 62313939Slinton #endif 62413939Slinton } 62513939Slinton } 62613939Slinton # endif 62713939Slinton 62813939Slinton strucoff = paramstk[ oparam+2 ]; 62913939Slinton paramno = oparam; 63013939Slinton 63113939Slinton return( mkty( temp, 0, szindex ) ); 63213939Slinton } 63313939Slinton 63413939Slinton /* VARARGS */ 63513939Slinton yyerror( s ) char *s; { /* error printing routine in parser */ 63613939Slinton 63713939Slinton uerror( s ); 63813939Slinton 63913939Slinton } 64013939Slinton 64113939Slinton yyaccpt(){ 64213939Slinton ftnend(); 64313939Slinton } 64413939Slinton 64513939Slinton ftnarg( idn ) { 64613939Slinton switch( stab[idn].stype ){ 64713939Slinton 64813939Slinton case UNDEF: 64913939Slinton /* this parameter, entered at scan */ 65013939Slinton break; 65113939Slinton case FARG: 65213939Slinton #ifndef FLEXNAMES 65313939Slinton uerror("redeclaration of formal parameter, %.8s", 65413939Slinton #else 65513939Slinton uerror("redeclaration of formal parameter, %s", 65613939Slinton #endif 65713939Slinton stab[idn].sname); 65813939Slinton /* fall thru */ 65913939Slinton case FTN: 66013939Slinton /* the name of this function matches parm */ 66113939Slinton /* fall thru */ 66213939Slinton default: 66313939Slinton idn = hide( &stab[idn]); 66413939Slinton break; 66513939Slinton case TNULL: 66613939Slinton /* unused entry, fill it */ 66713939Slinton ; 66813939Slinton } 66913939Slinton stab[idn].stype = FARG; 67013939Slinton stab[idn].sclass = PARAM; 67113939Slinton psave( idn ); 67213939Slinton } 67313939Slinton 67413939Slinton talign( ty, s) register unsigned ty; register s; { 67513939Slinton /* compute the alignment of an object with type ty, sizeoff index s */ 67613939Slinton 67713939Slinton register i; 67813939Slinton if( s<0 && ty!=INT && ty!=CHAR && ty!=SHORT && ty!=UNSIGNED && ty!=UCHAR && ty!=USHORT 67913939Slinton #ifdef LONGFIELDS 68013939Slinton && ty!=LONG && ty!=ULONG 68113939Slinton #endif 68213939Slinton ){ 68313939Slinton return( fldal( ty ) ); 68413939Slinton } 68513939Slinton 68613939Slinton for( i=0; i<=(SZINT-BTSHIFT-1); i+=TSHIFT ){ 68713939Slinton switch( (ty>>i)&TMASK ){ 68813939Slinton 68913939Slinton case FTN: 69013939Slinton cerror( "compiler takes alignment of function"); 69113939Slinton case PTR: 69213939Slinton return( ALPOINT ); 69313939Slinton case ARY: 69413939Slinton continue; 69513939Slinton case 0: 69613939Slinton break; 69713939Slinton } 69813939Slinton } 69913939Slinton 70013939Slinton switch( BTYPE(ty) ){ 70113939Slinton 70213939Slinton case UNIONTY: 70313939Slinton case ENUMTY: 70413939Slinton case STRTY: 70513939Slinton return( (unsigned int) dimtab[ s+2 ] ); 70613939Slinton case CHAR: 70713939Slinton case UCHAR: 70813939Slinton return( ALCHAR ); 70913939Slinton case FLOAT: 71013939Slinton return( ALFLOAT ); 71113939Slinton case DOUBLE: 71213939Slinton return( ALDOUBLE ); 71313939Slinton case LONG: 71413939Slinton case ULONG: 71513939Slinton return( ALLONG ); 71613939Slinton case SHORT: 71713939Slinton case USHORT: 71813939Slinton return( ALSHORT ); 71913939Slinton default: 72013939Slinton return( ALINT ); 72113939Slinton } 72213939Slinton } 72313939Slinton 72413939Slinton OFFSZ 72513939Slinton tsize( ty, d, s ) TWORD ty; { 72613939Slinton /* compute the size associated with type ty, 72713939Slinton dimoff d, and sizoff s */ 72813939Slinton /* BETTER NOT BE CALLED WHEN t, d, and s REFER TO A BIT FIELD... */ 72913939Slinton 73013939Slinton int i; 73113939Slinton OFFSZ mult; 73213939Slinton 73313939Slinton mult = 1; 73413939Slinton 73513939Slinton for( i=0; i<=(SZINT-BTSHIFT-1); i+=TSHIFT ){ 73613939Slinton switch( (ty>>i)&TMASK ){ 73713939Slinton 73813939Slinton case FTN: 73913939Slinton cerror( "compiler takes size of function"); 74013939Slinton case PTR: 74113939Slinton return( SZPOINT * mult ); 74213939Slinton case ARY: 74313939Slinton mult *= (unsigned int) dimtab[ d++ ]; 74413939Slinton continue; 74513939Slinton case 0: 74613939Slinton break; 74713939Slinton 74813939Slinton } 74913939Slinton } 75013939Slinton 75113939Slinton if( dimtab[s]==0 ) { 75213939Slinton uerror( "unknown size"); 75313939Slinton return( SZINT ); 75413939Slinton } 75513939Slinton return( (unsigned int) dimtab[ s ] * mult ); 75613939Slinton } 75713939Slinton 75813939Slinton inforce( n ) OFFSZ n; { /* force inoff to have the value n */ 75913939Slinton /* inoff is updated to have the value n */ 76013939Slinton OFFSZ wb; 76113939Slinton register rest; 76213939Slinton /* rest is used to do a lot of conversion to ints... */ 76313939Slinton 76413939Slinton if( inoff == n ) return; 76513939Slinton if( inoff > n ) { 76613939Slinton cerror( "initialization alignment error"); 76713939Slinton } 76813939Slinton 76913939Slinton wb = inoff; 77013939Slinton SETOFF( wb, SZINT ); 77113939Slinton 77213939Slinton /* wb now has the next higher word boundary */ 77313939Slinton 77413939Slinton if( wb >= n ){ /* in the same word */ 77513939Slinton rest = n - inoff; 77613939Slinton vfdzero( rest ); 77713939Slinton return; 77813939Slinton } 77913939Slinton 78013939Slinton /* otherwise, extend inoff to be word aligned */ 78113939Slinton 78213939Slinton rest = wb - inoff; 78313939Slinton vfdzero( rest ); 78413939Slinton 78513939Slinton /* now, skip full words until near to n */ 78613939Slinton 78713939Slinton rest = (n-inoff)/SZINT; 78813939Slinton zecode( rest ); 78913939Slinton 79013939Slinton /* now, the remainder of the last word */ 79113939Slinton 79213939Slinton rest = n-inoff; 79313939Slinton vfdzero( rest ); 79413939Slinton if( inoff != n ) cerror( "inoff error"); 79513939Slinton 79613939Slinton } 79713939Slinton 79813939Slinton vfdalign( n ){ /* make inoff have the offset the next alignment of n */ 79913939Slinton OFFSZ m; 80013939Slinton 80113939Slinton m = inoff; 80213939Slinton SETOFF( m, n ); 80313939Slinton inforce( m ); 80413939Slinton } 80513939Slinton 80613939Slinton 80713939Slinton int idebug = 0; 80813939Slinton 80913939Slinton int ibseen = 0; /* the number of } constructions which have been filled */ 81013939Slinton 81113939Slinton int iclass; /* storage class of thing being initialized */ 81213939Slinton 81313939Slinton int ilocctr = 0; /* location counter for current initialization */ 81413939Slinton 81513939Slinton beginit(curid){ 81613939Slinton /* beginning of initilization; set location ctr and set type */ 81713939Slinton register struct symtab *p; 81813939Slinton 81913939Slinton # ifndef BUG1 82013939Slinton if( idebug >= 3 ) printf( "beginit(), curid = %d\n", curid ); 82113939Slinton # endif 82213939Slinton 82313939Slinton p = &stab[curid]; 82413939Slinton 82513939Slinton iclass = p->sclass; 82613939Slinton if( curclass == EXTERN || curclass == FORTRAN ) iclass = EXTERN; 82713939Slinton switch( iclass ){ 82813939Slinton 82913939Slinton case UNAME: 83013939Slinton case EXTERN: 83113939Slinton return; 83213939Slinton case AUTO: 83313939Slinton case REGISTER: 83413939Slinton break; 83513939Slinton case EXTDEF: 83613939Slinton case STATIC: 83713939Slinton ilocctr = ISARY(p->stype)?ADATA:DATA; 83813939Slinton locctr( ilocctr ); 83913939Slinton defalign( talign( p->stype, p->sizoff ) ); 84013939Slinton defnam( p ); 84113939Slinton 84213939Slinton } 84313939Slinton 84413939Slinton inoff = 0; 84513939Slinton ibseen = 0; 84613939Slinton 84713939Slinton pstk = 0; 84813939Slinton 84913939Slinton instk( curid, p->stype, p->dimoff, p->sizoff, inoff ); 85013939Slinton 85113939Slinton } 85213939Slinton 85313939Slinton instk( id, t, d, s, off ) OFFSZ off; TWORD t; { 85413939Slinton /* make a new entry on the parameter stack to initialize id */ 85513939Slinton 85613939Slinton register struct symtab *p; 85713939Slinton 85813939Slinton for(;;){ 85913939Slinton # ifndef BUG1 86013939Slinton if( idebug ) printf( "instk((%d, %o,%d,%d, %d)\n", id, t, d, s, off ); 86113939Slinton # endif 86213939Slinton 86313939Slinton /* save information on the stack */ 86413939Slinton 86513939Slinton if( !pstk ) pstk = instack; 86613939Slinton else ++pstk; 86713939Slinton 86813939Slinton pstk->in_fl = 0; /* { flag */ 86913939Slinton pstk->in_id = id ; 87013939Slinton pstk->in_t = t ; 87113939Slinton pstk->in_d = d ; 87213939Slinton pstk->in_s = s ; 87313939Slinton pstk->in_n = 0; /* number seen */ 87413939Slinton pstk->in_x = t==STRTY ?dimtab[s+1] : 0 ; 87513939Slinton pstk->in_off = off; /* offset at the beginning of this element */ 87613939Slinton /* if t is an array, DECREF(t) can't be a field */ 87713939Slinton /* INS_sz has size of array elements, and -size for fields */ 87813939Slinton if( ISARY(t) ){ 87913939Slinton pstk->in_sz = tsize( DECREF(t), d+1, s ); 88013939Slinton } 88113939Slinton else if( stab[id].sclass & FIELD ){ 88213939Slinton pstk->in_sz = - ( stab[id].sclass & FLDSIZ ); 88313939Slinton } 88413939Slinton else { 88513939Slinton pstk->in_sz = 0; 88613939Slinton } 88713939Slinton 88813939Slinton if( (iclass==AUTO || iclass == REGISTER ) && 88913939Slinton (ISARY(t) || t==STRTY) ) uerror( "no automatic aggregate initialization" ); 89013939Slinton 89113939Slinton /* now, if this is not a scalar, put on another element */ 89213939Slinton 89313939Slinton if( ISARY(t) ){ 89413939Slinton t = DECREF(t); 89513939Slinton ++d; 89613939Slinton continue; 89713939Slinton } 89813939Slinton else if( t == STRTY ){ 89913939Slinton id = dimtab[pstk->in_x]; 90013939Slinton p = &stab[id]; 90113939Slinton if( p->sclass != MOS && !(p->sclass&FIELD) ) cerror( "insane structure member list" ); 90213939Slinton t = p->stype; 90313939Slinton d = p->dimoff; 90413939Slinton s = p->sizoff; 90513939Slinton off += p->offset; 90613939Slinton continue; 90713939Slinton } 90813939Slinton else return; 90913939Slinton } 91013939Slinton } 91113939Slinton 91213939Slinton NODE * 91313939Slinton getstr(){ /* decide if the string is external or an initializer, and get the contents accordingly */ 91413939Slinton 91513939Slinton register l, temp; 91613939Slinton register NODE *p; 91713939Slinton 91813939Slinton if( (iclass==EXTDEF||iclass==STATIC) && (pstk->in_t == CHAR || pstk->in_t == UCHAR) && 91913939Slinton pstk!=instack && ISARY( pstk[-1].in_t ) ){ 92013939Slinton /* treat "abc" as { 'a', 'b', 'c', 0 } */ 92113939Slinton strflg = 1; 92213939Slinton ilbrace(); /* simulate { */ 92313939Slinton inforce( pstk->in_off ); 92413939Slinton /* if the array is inflexible (not top level), pass in the size and 92513939Slinton be prepared to throw away unwanted initializers */ 92613939Slinton lxstr((pstk-1)!=instack?dimtab[(pstk-1)->in_d]:0); /* get the contents */ 92713939Slinton irbrace(); /* simulate } */ 92813939Slinton return( NIL ); 92913939Slinton } 93013939Slinton else { /* make a label, and get the contents and stash them away */ 93113939Slinton if( iclass != SNULL ){ /* initializing */ 93213939Slinton /* fill out previous word, to permit pointer */ 93313939Slinton vfdalign( ALPOINT ); 93413939Slinton } 93513939Slinton temp = locctr( blevel==0?ISTRNG:STRNG ); /* set up location counter */ 93613939Slinton deflab( l = getlab() ); 93713939Slinton strflg = 0; 93813939Slinton lxstr(0); /* get the contents */ 93913939Slinton locctr( blevel==0?ilocctr:temp ); 94013939Slinton p = buildtree( STRING, NIL, NIL ); 94113939Slinton p->tn.rval = -l; 94213939Slinton return(p); 94313939Slinton } 94413939Slinton } 94513939Slinton 94613939Slinton putbyte( v ){ /* simulate byte v appearing in a list of integer values */ 94713939Slinton register NODE *p; 94813939Slinton p = bcon(v); 94913939Slinton incode( p, SZCHAR ); 95013939Slinton tfree( p ); 95113939Slinton gotscal(); 95213939Slinton } 95313939Slinton 95413939Slinton endinit(){ 95513939Slinton register TWORD t; 95613939Slinton register d, s, n, d1; 95713939Slinton 95813939Slinton # ifndef BUG1 95913939Slinton if( idebug ) printf( "endinit(), inoff = %d\n", inoff ); 96013939Slinton # endif 96113939Slinton 96213939Slinton switch( iclass ){ 96313939Slinton 96413939Slinton case EXTERN: 96513939Slinton case AUTO: 96613939Slinton case REGISTER: 96713939Slinton return; 96813939Slinton } 96913939Slinton 97013939Slinton pstk = instack; 97113939Slinton 97213939Slinton t = pstk->in_t; 97313939Slinton d = pstk->in_d; 97413939Slinton s = pstk->in_s; 97513939Slinton n = pstk->in_n; 97613939Slinton 97713939Slinton if( ISARY(t) ){ 97813939Slinton d1 = dimtab[d]; 97913939Slinton 98013939Slinton vfdalign( pstk->in_sz ); /* fill out part of the last element, if needed */ 98113939Slinton n = inoff/pstk->in_sz; /* real number of initializers */ 98213939Slinton if( d1 >= n ){ 98313939Slinton /* once again, t is an array, so no fields */ 98413939Slinton inforce( tsize( t, d, s ) ); 98513939Slinton n = d1; 98613939Slinton } 98713939Slinton if( d1!=0 && d1!=n ) uerror( "too many initializers"); 98813939Slinton if( n==0 ) werror( "empty array declaration"); 98913939Slinton dimtab[d] = n; 99013942Slinton if( d1==0 ) FIXDEF(&stab[pstk->in_id]); 99113939Slinton } 99213939Slinton 99313939Slinton else if( t == STRTY || t == UNIONTY ){ 99413939Slinton /* clearly not fields either */ 99513939Slinton inforce( tsize( t, d, s ) ); 99613939Slinton } 99713939Slinton else if( n > 1 ) uerror( "bad scalar initialization"); 99813939Slinton /* this will never be called with a field element... */ 99913939Slinton else inforce( tsize(t,d,s) ); 100013939Slinton 100113939Slinton paramno = 0; 100213939Slinton vfdalign( AL_INIT ); 100313939Slinton inoff = 0; 100413939Slinton iclass = SNULL; 100513939Slinton 100613939Slinton } 100713939Slinton 100813939Slinton doinit( p ) register NODE *p; { 100913939Slinton 101013939Slinton /* take care of generating a value for the initializer p */ 101113939Slinton /* inoff has the current offset (last bit written) 101213939Slinton in the current word being generated */ 101313939Slinton 101413939Slinton register sz, d, s; 101513939Slinton register TWORD t; 101613939Slinton 101713939Slinton /* note: size of an individual initializer is assumed to fit into an int */ 101813939Slinton 101913939Slinton if( iclass < 0 ) goto leave; 102013939Slinton if( iclass == EXTERN || iclass == UNAME ){ 102113939Slinton uerror( "cannot initialize extern or union" ); 102213939Slinton iclass = -1; 102313939Slinton goto leave; 102413939Slinton } 102513939Slinton 102613939Slinton if( iclass == AUTO || iclass == REGISTER ){ 102713939Slinton /* do the initialization and get out, without regard 102813939Slinton for filing out the variable with zeros, etc. */ 102913939Slinton bccode(); 103013939Slinton idname = pstk->in_id; 103113939Slinton p = buildtree( ASSIGN, buildtree( NAME, NIL, NIL ), p ); 103213939Slinton ecomp(p); 103313939Slinton return; 103413939Slinton } 103513939Slinton 103613939Slinton if( p == NIL ) return; /* for throwing away strings that have been turned into lists */ 103713939Slinton 103813939Slinton if( ibseen ){ 103913939Slinton uerror( "} expected"); 104013939Slinton goto leave; 104113939Slinton } 104213939Slinton 104313939Slinton # ifndef BUG1 104413939Slinton if( idebug > 1 ) printf( "doinit(%o)\n", p ); 104513939Slinton # endif 104613939Slinton 104713939Slinton t = pstk->in_t; /* type required */ 104813939Slinton d = pstk->in_d; 104913939Slinton s = pstk->in_s; 105013939Slinton if( pstk->in_sz < 0 ){ /* bit field */ 105113939Slinton sz = -pstk->in_sz; 105213939Slinton } 105313939Slinton else { 105413939Slinton sz = tsize( t, d, s ); 105513939Slinton } 105613939Slinton 105713939Slinton inforce( pstk->in_off ); 105813939Slinton 105913939Slinton p = buildtree( ASSIGN, block( NAME, NIL,NIL, t, d, s ), p ); 106013939Slinton p->in.left->in.op = FREE; 106113939Slinton p->in.left = p->in.right; 106213939Slinton p->in.right = NIL; 106313939Slinton p->in.left = optim( p->in.left ); 106413939Slinton if( p->in.left->in.op == UNARY AND ){ 106513939Slinton p->in.left->in.op = FREE; 106613939Slinton p->in.left = p->in.left->in.left; 106713939Slinton } 106813939Slinton p->in.op = INIT; 106913939Slinton 107013939Slinton if( sz < SZINT ){ /* special case: bit fields, etc. */ 107113939Slinton if( p->in.left->in.op != ICON ) uerror( "illegal initialization" ); 107213939Slinton else incode( p->in.left, sz ); 107313939Slinton } 107413939Slinton else if( p->in.left->in.op == FCON ){ 107513939Slinton fincode( p->in.left->fpn.dval, sz ); 107613939Slinton } 107713939Slinton else { 1078*16178Sralph p = optim(p); 1079*16178Sralph if( p->in.left->in.op != ICON ) uerror( "illegal initialization" ); 1080*16178Sralph else cinit( p, sz ); 108113939Slinton } 108213939Slinton 108313939Slinton gotscal(); 108413939Slinton 108513939Slinton leave: 108613939Slinton tfree(p); 108713939Slinton } 108813939Slinton 108913939Slinton gotscal(){ 109013939Slinton register t, ix; 109113939Slinton register n, id; 109213939Slinton struct symtab *p; 109313939Slinton OFFSZ temp; 109413939Slinton 109513939Slinton for( ; pstk > instack; ) { 109613939Slinton 109713939Slinton if( pstk->in_fl ) ++ibseen; 109813939Slinton 109913939Slinton --pstk; 110013939Slinton 110113939Slinton t = pstk->in_t; 110213939Slinton 110313939Slinton if( t == STRTY ){ 110413939Slinton ix = ++pstk->in_x; 110513939Slinton if( (id=dimtab[ix]) < 0 ) continue; 110613939Slinton 110713939Slinton /* otherwise, put next element on the stack */ 110813939Slinton 110913939Slinton p = &stab[id]; 111013939Slinton instk( id, p->stype, p->dimoff, p->sizoff, p->offset+pstk->in_off ); 111113939Slinton return; 111213939Slinton } 111313939Slinton else if( ISARY(t) ){ 111413939Slinton n = ++pstk->in_n; 111513939Slinton if( n >= dimtab[pstk->in_d] && pstk > instack ) continue; 111613939Slinton 111713939Slinton /* put the new element onto the stack */ 111813939Slinton 111913939Slinton temp = pstk->in_sz; 112013939Slinton instk( pstk->in_id, (TWORD)DECREF(pstk->in_t), pstk->in_d+1, pstk->in_s, 112113939Slinton pstk->in_off+n*temp ); 112213939Slinton return; 112313939Slinton } 112413939Slinton 112513939Slinton } 112613939Slinton 112713939Slinton } 112813939Slinton 112913939Slinton ilbrace(){ /* process an initializer's left brace */ 113013939Slinton register t; 113113939Slinton struct instk *temp; 113213939Slinton 113313939Slinton temp = pstk; 113413939Slinton 113513939Slinton for( ; pstk > instack; --pstk ){ 113613939Slinton 113713939Slinton t = pstk->in_t; 113813939Slinton if( t != STRTY && !ISARY(t) ) continue; /* not an aggregate */ 113913939Slinton if( pstk->in_fl ){ /* already associated with a { */ 114013939Slinton if( pstk->in_n ) uerror( "illegal {"); 114113939Slinton continue; 114213939Slinton } 114313939Slinton 114413939Slinton /* we have one ... */ 114513939Slinton pstk->in_fl = 1; 114613939Slinton break; 114713939Slinton } 114813939Slinton 114913939Slinton /* cannot find one */ 115013939Slinton /* ignore such right braces */ 115113939Slinton 115213939Slinton pstk = temp; 115313939Slinton } 115413939Slinton 115513939Slinton irbrace(){ 115613939Slinton /* called when a '}' is seen */ 115713939Slinton 115813939Slinton # ifndef BUG1 115913939Slinton if( idebug ) printf( "irbrace(): paramno = %d on entry\n", paramno ); 116013939Slinton # endif 116113939Slinton 116213939Slinton if( ibseen ) { 116313939Slinton --ibseen; 116413939Slinton return; 116513939Slinton } 116613939Slinton 116713939Slinton for( ; pstk > instack; --pstk ){ 116813939Slinton if( !pstk->in_fl ) continue; 116913939Slinton 117013939Slinton /* we have one now */ 117113939Slinton 117213939Slinton pstk->in_fl = 0; /* cancel { */ 117313939Slinton gotscal(); /* take it away... */ 117413939Slinton return; 117513939Slinton } 117613939Slinton 117713939Slinton /* these right braces match ignored left braces: throw out */ 117813939Slinton 117913939Slinton } 118013939Slinton 118113939Slinton upoff( size, alignment, poff ) register alignment, *poff; { 118213939Slinton /* update the offset pointed to by poff; return the 118313939Slinton /* offset of a value of size `size', alignment `alignment', 118413939Slinton /* given that off is increasing */ 118513939Slinton 118613939Slinton register off; 118713939Slinton 118813939Slinton off = *poff; 118913939Slinton SETOFF( off, alignment ); 119013939Slinton if( (offsz-off) < size ){ 119113939Slinton if( instruct!=INSTRUCT )cerror("too many local variables"); 119213939Slinton else cerror("Structure too large"); 119313939Slinton } 119413939Slinton *poff = off+size; 119513939Slinton return( off ); 119613939Slinton } 119713939Slinton 119813939Slinton oalloc( p, poff ) register struct symtab *p; register *poff; { 119913939Slinton /* allocate p with offset *poff, and update *poff */ 120013939Slinton register al, off, tsz; 120113939Slinton int noff; 120213939Slinton 120313939Slinton al = talign( p->stype, p->sizoff ); 120413939Slinton noff = off = *poff; 120513939Slinton tsz = tsize( p->stype, p->dimoff, p->sizoff ); 120613939Slinton #ifdef BACKAUTO 120713939Slinton if( p->sclass == AUTO ){ 120813939Slinton if( (offsz-off) < tsz ) cerror("too many local variables"); 120913939Slinton noff = off + tsz; 121013939Slinton SETOFF( noff, al ); 121113939Slinton off = -noff; 121213939Slinton } 121313939Slinton else 121413939Slinton #endif 121513939Slinton if( p->sclass == PARAM && ( tsz < SZINT ) ){ 121613939Slinton off = upoff( SZINT, ALINT, &noff ); 121713939Slinton # ifndef RTOLBYTES 121813939Slinton off = noff - tsz; 121913939Slinton #endif 122013939Slinton } 122113939Slinton else 122213939Slinton { 122313939Slinton off = upoff( tsz, al, &noff ); 122413939Slinton } 122513939Slinton 122613939Slinton if( p->sclass != REGISTER ){ /* in case we are allocating stack space for register arguments */ 122713939Slinton if( p->offset == NOOFFSET ) p->offset = off; 122813939Slinton else if( off != p->offset ) return(1); 122913939Slinton } 123013939Slinton 123113939Slinton *poff = noff; 123213939Slinton return(0); 123313939Slinton } 123413939Slinton 123513939Slinton falloc( p, w, new, pty ) register struct symtab *p; NODE *pty; { 123613939Slinton /* allocate a field of width w */ 123713939Slinton /* new is 0 if new entry, 1 if redefinition, -1 if alignment */ 123813939Slinton 123913939Slinton register al,sz,type; 124013939Slinton 124113939Slinton type = (new<0)? pty->in.type : p->stype; 124213939Slinton 124313939Slinton /* this must be fixed to use the current type in alignments */ 124413939Slinton switch( new<0?pty->in.type:p->stype ){ 124513939Slinton 124613939Slinton case ENUMTY: 124713939Slinton { 124813939Slinton int s; 124913939Slinton s = new<0 ? pty->fn.csiz : p->sizoff; 125013939Slinton al = dimtab[s+2]; 125113939Slinton sz = dimtab[s]; 125213939Slinton break; 125313939Slinton } 125413939Slinton 125513939Slinton case CHAR: 125613939Slinton case UCHAR: 125713939Slinton al = ALCHAR; 125813939Slinton sz = SZCHAR; 125913939Slinton break; 126013939Slinton 126113939Slinton case SHORT: 126213939Slinton case USHORT: 126313939Slinton al = ALSHORT; 126413939Slinton sz = SZSHORT; 126513939Slinton break; 126613939Slinton 126713939Slinton case INT: 126813939Slinton case UNSIGNED: 126913939Slinton al = ALINT; 127013939Slinton sz = SZINT; 127113939Slinton break; 127213939Slinton #ifdef LONGFIELDS 127313939Slinton 127413939Slinton case LONG: 127513939Slinton case ULONG: 127613939Slinton al = ALLONG; 127713939Slinton sz = SZLONG; 127813939Slinton break; 127913939Slinton #endif 128013939Slinton 128113939Slinton default: 128213939Slinton if( new < 0 ) { 128313939Slinton uerror( "illegal field type" ); 128413939Slinton al = ALINT; 128513939Slinton } 128613939Slinton else { 128713939Slinton al = fldal( p->stype ); 128813939Slinton sz =SZINT; 128913939Slinton } 129013939Slinton } 129113939Slinton 129213939Slinton if( w > sz ) { 129313939Slinton uerror( "field too big"); 129413939Slinton w = sz; 129513939Slinton } 129613939Slinton 129713939Slinton if( w == 0 ){ /* align only */ 129813939Slinton SETOFF( strucoff, al ); 129913939Slinton if( new >= 0 ) uerror( "zero size field"); 130013939Slinton return(0); 130113939Slinton } 130213939Slinton 130313939Slinton if( strucoff%al + w > sz ) SETOFF( strucoff, al ); 130413939Slinton if( new < 0 ) { 130513939Slinton if( (offsz-strucoff) < w ) 130613939Slinton cerror("structure too large"); 130713939Slinton strucoff += w; /* we know it will fit */ 130813939Slinton return(0); 130913939Slinton } 131013939Slinton 131113939Slinton /* establish the field */ 131213939Slinton 131313939Slinton if( new == 1 ) { /* previous definition */ 131413939Slinton if( p->offset != strucoff || p->sclass != (FIELD|w) ) return(1); 131513939Slinton } 131613939Slinton p->offset = strucoff; 131713939Slinton if( (offsz-strucoff) < w ) cerror("structure too large"); 131813939Slinton strucoff += w; 131913939Slinton p->stype = type; 132013939Slinton fldty( p ); 132113939Slinton return(0); 132213939Slinton } 132313939Slinton 132413939Slinton nidcl( p ) NODE *p; { /* handle unitialized declarations */ 132513939Slinton /* assumed to be not functions */ 132613939Slinton register class; 132713939Slinton register commflag; /* flag for labelled common declarations */ 132813939Slinton 132913939Slinton commflag = 0; 133013939Slinton 133113939Slinton /* compute class */ 133213939Slinton if( (class=curclass) == SNULL ){ 133313939Slinton if( blevel > 1 ) class = AUTO; 133413939Slinton else if( blevel != 0 || instruct ) cerror( "nidcl error" ); 133513939Slinton else { /* blevel = 0 */ 133613939Slinton class = noinit(); 133713939Slinton if( class == EXTERN ) commflag = 1; 133813939Slinton } 133913939Slinton } 134013939Slinton #ifdef LCOMM 134113939Slinton /* hack so stab will come at as LCSYM rather than STSYM */ 134213939Slinton if (class == STATIC) { 134313939Slinton extern int stabLCSYM; 134413939Slinton stabLCSYM = 1; 134513939Slinton } 134613939Slinton #endif 134713939Slinton 134813939Slinton defid( p, class ); 134913939Slinton 135013939Slinton #ifndef LCOMM 135113939Slinton if( class==EXTDEF || class==STATIC ){ 135213939Slinton #else 135313939Slinton if (class==STATIC) { 135413939Slinton register struct symtab *s = &stab[p->tn.rval]; 135513939Slinton extern int stabLCSYM; 135613939Slinton int sz = tsize(s->stype, s->dimoff, s->sizoff)/SZCHAR; 135713939Slinton 135813939Slinton stabLCSYM = 0; 135913939Slinton if (sz % sizeof (int)) 136013939Slinton sz += sizeof (int) - (sz % sizeof (int)); 136113939Slinton if (s->slevel > 1) 136213939Slinton printf(" .lcomm L%d,%d\n", s->offset, sz); 136313939Slinton else 136413939Slinton printf(" .lcomm %s,%d\n", exname(s->sname), sz); 136513939Slinton }else if (class == EXTDEF) { 136613939Slinton #endif 136713939Slinton /* simulate initialization by 0 */ 136813939Slinton beginit(p->tn.rval); 136913939Slinton endinit(); 137013939Slinton } 137113939Slinton if( commflag ) commdec( p->tn.rval ); 137213939Slinton } 137313939Slinton 137413939Slinton TWORD 137513939Slinton types( t1, t2, t3 ) TWORD t1, t2, t3; { 137613939Slinton /* return a basic type from basic types t1, t2, and t3 */ 137713939Slinton 137813939Slinton TWORD t[3], noun, adj, unsg; 137913939Slinton register i; 138013939Slinton 138113939Slinton t[0] = t1; 138213939Slinton t[1] = t2; 138313939Slinton t[2] = t3; 138413939Slinton 138513939Slinton unsg = INT; /* INT or UNSIGNED */ 138613939Slinton noun = UNDEF; /* INT, CHAR, or FLOAT */ 138713939Slinton adj = INT; /* INT, LONG, or SHORT */ 138813939Slinton 138913939Slinton for( i=0; i<3; ++i ){ 139013939Slinton switch( t[i] ){ 139113939Slinton 139213939Slinton default: 139313939Slinton bad: 139413939Slinton uerror( "illegal type combination" ); 139513939Slinton return( INT ); 139613939Slinton 139713939Slinton case UNDEF: 139813939Slinton continue; 139913939Slinton 140013939Slinton case UNSIGNED: 140113939Slinton if( unsg != INT ) goto bad; 140213939Slinton unsg = UNSIGNED; 140313939Slinton continue; 140413939Slinton 140513939Slinton case LONG: 140613939Slinton case SHORT: 140713939Slinton if( adj != INT ) goto bad; 140813939Slinton adj = t[i]; 140913939Slinton continue; 141013939Slinton 141113939Slinton case INT: 141213939Slinton case CHAR: 141313939Slinton case FLOAT: 141413939Slinton if( noun != UNDEF ) goto bad; 141513939Slinton noun = t[i]; 141613939Slinton continue; 141713939Slinton } 141813939Slinton } 141913939Slinton 142013939Slinton /* now, construct final type */ 142113939Slinton if( noun == UNDEF ) noun = INT; 142213939Slinton else if( noun == FLOAT ){ 142313939Slinton if( unsg != INT || adj == SHORT ) goto bad; 142413939Slinton return( adj==LONG ? DOUBLE : FLOAT ); 142513939Slinton } 142613939Slinton else if( noun == CHAR && adj != INT ) goto bad; 142713939Slinton 142813939Slinton /* now, noun is INT or CHAR */ 142913939Slinton if( adj != INT ) noun = adj; 143013939Slinton if( unsg == UNSIGNED ) return( noun + (UNSIGNED-INT) ); 143113939Slinton else return( noun ); 143213939Slinton } 143313939Slinton 143413939Slinton NODE * 143513939Slinton tymerge( typ, idp ) NODE *typ, *idp; { 143613939Slinton /* merge type typ with identifier idp */ 143713939Slinton 143813939Slinton register unsigned t; 143913939Slinton register i; 144013939Slinton extern int eprint(); 144113939Slinton 144213939Slinton if( typ->in.op != TYPE ) cerror( "tymerge: arg 1" ); 144313939Slinton if(idp == NIL ) return( NIL ); 144413939Slinton 144513939Slinton # ifndef BUG1 144613939Slinton if( ddebug > 2 ) fwalk( idp, eprint, 0 ); 144713939Slinton # endif 144813939Slinton 144913939Slinton idp->in.type = typ->in.type; 145013939Slinton idp->fn.cdim = curdim; 145113939Slinton tyreduce( idp ); 145213939Slinton idp->fn.csiz = typ->fn.csiz; 145313939Slinton 145413939Slinton for( t=typ->in.type, i=typ->fn.cdim; t&TMASK; t = DECREF(t) ){ 145513939Slinton if( ISARY(t) ) dstash( dimtab[i++] ); 145613939Slinton } 145713939Slinton 145813939Slinton /* now idp is a single node: fix up type */ 145913939Slinton 146013939Slinton idp->in.type = ctype( idp->in.type ); 146113939Slinton 146213939Slinton if( (t = BTYPE(idp->in.type)) != STRTY && t != UNIONTY && t != ENUMTY ){ 146313939Slinton idp->fn.csiz = t; /* in case ctype has rewritten things */ 146413939Slinton } 146513939Slinton 146613939Slinton return( idp ); 146713939Slinton } 146813939Slinton 146913939Slinton tyreduce( p ) register NODE *p; { 147013939Slinton 147113939Slinton /* build a type, and stash away dimensions, from a parse tree of the declaration */ 147213939Slinton /* the type is build top down, the dimensions bottom up */ 147313939Slinton register o, temp; 147413939Slinton register unsigned t; 147513939Slinton 147613939Slinton o = p->in.op; 147713939Slinton p->in.op = FREE; 147813939Slinton 147913939Slinton if( o == NAME ) return; 148013939Slinton 148113939Slinton t = INCREF( p->in.type ); 148213939Slinton if( o == UNARY CALL ) t += (FTN-PTR); 148313939Slinton else if( o == LB ){ 148413939Slinton t += (ARY-PTR); 148513939Slinton temp = p->in.right->tn.lval; 148613939Slinton p->in.right->in.op = FREE; 148713939Slinton if( ( temp == 0 ) & ( p->in.left->tn.op == LB ) ) 148813939Slinton uerror( "Null dimension" ); 148913939Slinton } 149013939Slinton 149113939Slinton p->in.left->in.type = t; 149213939Slinton tyreduce( p->in.left ); 149313939Slinton 149413939Slinton if( o == LB ) dstash( temp ); 149513939Slinton 149613939Slinton p->tn.rval = p->in.left->tn.rval; 149713939Slinton p->in.type = p->in.left->in.type; 149813939Slinton 149913939Slinton } 150013939Slinton 150113939Slinton fixtype( p, class ) register NODE *p; { 150213939Slinton register unsigned t, type; 150313939Slinton register mod1, mod2; 150413939Slinton /* fix up the types, and check for legality */ 150513939Slinton 150613939Slinton if( (type = p->in.type) == UNDEF ) return; 150713939Slinton if( mod2 = (type&TMASK) ){ 150813939Slinton t = DECREF(type); 150913939Slinton while( mod1=mod2, mod2 = (t&TMASK) ){ 151013939Slinton if( mod1 == ARY && mod2 == FTN ){ 151113939Slinton uerror( "array of functions is illegal" ); 151213939Slinton type = 0; 151313939Slinton } 151413939Slinton else if( mod1 == FTN && ( mod2 == ARY || mod2 == FTN ) ){ 151513939Slinton uerror( "function returns illegal type" ); 151613939Slinton type = 0; 151713939Slinton } 151813939Slinton t = DECREF(t); 151913939Slinton } 152013939Slinton } 152113939Slinton 152213939Slinton /* detect function arguments, watching out for structure declarations */ 152313939Slinton /* for example, beware of f(x) struct [ int a[10]; } *x; { ... } */ 152413939Slinton /* the danger is that "a" will be converted to a pointer */ 152513939Slinton 152613939Slinton if( class==SNULL && blevel==1 && !(instruct&(INSTRUCT|INUNION)) ) class = PARAM; 152713939Slinton if( class == PARAM || ( class==REGISTER && blevel==1 ) ){ 152813939Slinton if( type == FLOAT ) type = DOUBLE; 152913939Slinton else if( ISARY(type) ){ 153013939Slinton ++p->fn.cdim; 153113939Slinton type += (PTR-ARY); 153213939Slinton } 153313939Slinton else if( ISFTN(type) ){ 153413939Slinton werror( "a function is declared as an argument" ); 153513939Slinton type = INCREF(type); 153613939Slinton } 153713939Slinton 153813939Slinton } 153913939Slinton 154013939Slinton if( instruct && ISFTN(type) ){ 154113939Slinton uerror( "function illegal in structure or union" ); 154213939Slinton type = INCREF(type); 154313939Slinton } 154413939Slinton p->in.type = type; 154513939Slinton } 154613939Slinton 154713939Slinton uclass( class ) register class; { 154813939Slinton /* give undefined version of class */ 154913939Slinton if( class == SNULL ) return( EXTERN ); 155013939Slinton else if( class == STATIC ) return( USTATIC ); 155113939Slinton else if( class == FORTRAN ) return( UFORTRAN ); 155213939Slinton else return( class ); 155313939Slinton } 155413939Slinton 155513939Slinton fixclass( class, type ) TWORD type; { 155613939Slinton 155713939Slinton /* first, fix null class */ 155813939Slinton 155913939Slinton if( class == SNULL ){ 156013939Slinton if( instruct&INSTRUCT ) class = MOS; 156113939Slinton else if( instruct&INUNION ) class = MOU; 156213939Slinton else if( blevel == 0 ) class = EXTDEF; 156313939Slinton else if( blevel == 1 ) class = PARAM; 156413939Slinton else class = AUTO; 156513939Slinton 156613939Slinton } 156713939Slinton 156813939Slinton /* now, do general checking */ 156913939Slinton 157013939Slinton if( ISFTN( type ) ){ 157113939Slinton switch( class ) { 157213939Slinton default: 157313939Slinton uerror( "function has illegal storage class" ); 157413939Slinton case AUTO: 157513939Slinton class = EXTERN; 157613939Slinton case EXTERN: 157713939Slinton case EXTDEF: 157813939Slinton case FORTRAN: 157913939Slinton case TYPEDEF: 158013939Slinton case STATIC: 158113939Slinton case UFORTRAN: 158213939Slinton case USTATIC: 158313939Slinton ; 158413939Slinton } 158513939Slinton } 158613939Slinton 158713939Slinton if( class&FIELD ){ 158813939Slinton if( !(instruct&INSTRUCT) ) uerror( "illegal use of field" ); 158913939Slinton return( class ); 159013939Slinton } 159113939Slinton 159213939Slinton switch( class ){ 159313939Slinton 159413939Slinton case MOU: 159513939Slinton if( !(instruct&INUNION) ) uerror( "illegal class" ); 159613939Slinton return( class ); 159713939Slinton 159813939Slinton case MOS: 159913939Slinton if( !(instruct&INSTRUCT) ) uerror( "illegal class" ); 160013939Slinton return( class ); 160113939Slinton 160213939Slinton case MOE: 160313939Slinton if( instruct & (INSTRUCT|INUNION) ) uerror( "illegal class" ); 160413939Slinton return( class ); 160513939Slinton 160613939Slinton case REGISTER: 160713939Slinton if( blevel == 0 ) uerror( "illegal register declaration" ); 160813939Slinton else if( regvar >= MINRVAR && cisreg( type ) ) return( class ); 160913939Slinton if( blevel == 1 ) return( PARAM ); 161013939Slinton else return( AUTO ); 161113939Slinton 161213939Slinton case AUTO: 161313939Slinton case LABEL: 161413939Slinton case ULABEL: 161513939Slinton if( blevel < 2 ) uerror( "illegal class" ); 161613939Slinton return( class ); 161713939Slinton 161813939Slinton case PARAM: 161913939Slinton if( blevel != 1 ) uerror( "illegal class" ); 162013939Slinton return( class ); 162113939Slinton 162213939Slinton case UFORTRAN: 162313939Slinton case FORTRAN: 162413939Slinton # ifdef NOFORTRAN 162513939Slinton NOFORTRAN; /* a condition which can regulate the FORTRAN usage */ 162613939Slinton # endif 162713939Slinton if( !ISFTN(type) ) uerror( "fortran declaration must apply to function" ); 162813939Slinton else { 162913939Slinton type = DECREF(type); 163013939Slinton if( ISFTN(type) || ISARY(type) || ISPTR(type) ) { 163113939Slinton uerror( "fortran function has wrong type" ); 163213939Slinton } 163313939Slinton } 163413939Slinton case STNAME: 163513939Slinton case UNAME: 163613939Slinton case ENAME: 163713939Slinton case EXTERN: 163813939Slinton case STATIC: 163913939Slinton case EXTDEF: 164013939Slinton case TYPEDEF: 164113939Slinton case USTATIC: 164213939Slinton return( class ); 164313939Slinton 164413939Slinton default: 164513939Slinton cerror( "illegal class: %d", class ); 164613939Slinton /* NOTREACHED */ 164713939Slinton 164813939Slinton } 164913939Slinton } 165013939Slinton 165113939Slinton struct symtab * 165213939Slinton mknonuniq(idindex) int *idindex; {/* locate a symbol table entry for */ 165313939Slinton /* an occurrence of a nonunique structure member name */ 165413939Slinton /* or field */ 165513939Slinton register i; 165613939Slinton register struct symtab * sp; 165713939Slinton char *p,*q; 165813939Slinton 165913939Slinton sp = & stab[ i= *idindex ]; /* position search at old entry */ 166013939Slinton while( sp->stype != TNULL ){ /* locate unused entry */ 166113939Slinton if( ++i >= SYMTSZ ){/* wrap around symbol table */ 166213939Slinton i = 0; 166313939Slinton sp = stab; 166413939Slinton } 166513939Slinton else ++sp; 166613939Slinton if( i == *idindex ) cerror("Symbol table full"); 166713939Slinton } 166813939Slinton sp->sflags = SNONUNIQ | SMOS; 166913939Slinton p = sp->sname; 167013939Slinton q = stab[*idindex].sname; /* old entry name */ 167113939Slinton #ifdef FLEXNAMES 167213939Slinton sp->sname = stab[*idindex].sname; 167313939Slinton #endif 167413939Slinton # ifndef BUG1 167513939Slinton if( ddebug ){ 167613939Slinton printf("\tnonunique entry for %s from %d to %d\n", 167713939Slinton q, *idindex, i ); 167813939Slinton } 167913939Slinton # endif 168013939Slinton *idindex = i; 168113939Slinton #ifndef FLEXNAMES 168213939Slinton for( i=1; i<=NCHNAM; ++i ){ /* copy name */ 168313939Slinton if( *p++ = *q /* assign */ ) ++q; 168413939Slinton } 168513939Slinton #endif 168613939Slinton return ( sp ); 168713939Slinton } 168813939Slinton 168913939Slinton lookup( name, s) char *name; { 169013939Slinton /* look up name: must agree with s w.r.t. STAG, SMOS and SHIDDEN */ 169113939Slinton 169213939Slinton register char *p, *q; 169313939Slinton int i, j, ii; 169413939Slinton register struct symtab *sp; 169513939Slinton 169613939Slinton /* compute initial hash index */ 169713939Slinton # ifndef BUG1 169813939Slinton if( ddebug > 2 ){ 169913939Slinton printf( "lookup( %s, %d ), stwart=%d, instruct=%d\n", name, s, stwart, instruct ); 170013939Slinton } 170113939Slinton # endif 170213939Slinton 170313939Slinton i = 0; 170413939Slinton #ifndef FLEXNAMES 170513939Slinton for( p=name, j=0; *p != '\0'; ++p ){ 170613939Slinton i += *p; 170713939Slinton if( ++j >= NCHNAM ) break; 170813939Slinton } 170913939Slinton #else 171013939Slinton i = (int)name; 171113939Slinton #endif 171213939Slinton i = i%SYMTSZ; 171313939Slinton sp = &stab[ii=i]; 171413939Slinton 171513939Slinton for(;;){ /* look for name */ 171613939Slinton 171713939Slinton if( sp->stype == TNULL ){ /* empty slot */ 171813939Slinton sp->sflags = s; /* set STAG, SMOS if needed, turn off all others */ 171913939Slinton #ifndef FLEXNAMES 172013939Slinton p = sp->sname; 172113939Slinton for( j=0; j<NCHNAM; ++j ) if( *p++ = *name ) ++name; 172213939Slinton #else 172313939Slinton sp->sname = name; 172413939Slinton #endif 172513939Slinton sp->stype = UNDEF; 172613939Slinton sp->sclass = SNULL; 172713939Slinton return( i ); 172813939Slinton } 172913939Slinton if( (sp->sflags & (STAG|SMOS|SHIDDEN)) != s ) goto next; 173013939Slinton p = sp->sname; 173113939Slinton q = name; 173213939Slinton #ifndef FLEXNAMES 173313939Slinton for( j=0; j<NCHNAM;++j ){ 173413939Slinton if( *p++ != *q ) goto next; 173513939Slinton if( !*q++ ) break; 173613939Slinton } 173713939Slinton return( i ); 173813939Slinton #else 173913939Slinton if (p == q) 174013939Slinton return ( i ); 174113939Slinton #endif 174213939Slinton next: 174313939Slinton if( ++i >= SYMTSZ ){ 174413939Slinton i = 0; 174513939Slinton sp = stab; 174613939Slinton } 174713939Slinton else ++sp; 174813939Slinton if( i == ii ) cerror( "symbol table full" ); 174913939Slinton } 175013939Slinton } 175113939Slinton 175213939Slinton #ifndef checkst 175313939Slinton /* if not debugging, make checkst a macro */ 175413939Slinton checkst(lev){ 175513939Slinton register int s, i, j; 175613939Slinton register struct symtab *p, *q; 175713939Slinton 175813939Slinton for( i=0, p=stab; i<SYMTSZ; ++i, ++p ){ 175913939Slinton if( p->stype == TNULL ) continue; 176013939Slinton j = lookup( p->sname, p->sflags&(SMOS|STAG) ); 176113939Slinton if( j != i ){ 176213939Slinton q = &stab[j]; 176313939Slinton if( q->stype == UNDEF || 176413939Slinton q->slevel <= p->slevel ){ 176513939Slinton #ifndef FLEXNAMES 176613939Slinton cerror( "check error: %.8s", q->sname ); 176713939Slinton #else 176813939Slinton cerror( "check error: %s", q->sname ); 176913939Slinton #endif 177013939Slinton } 177113939Slinton } 177213939Slinton #ifndef FLEXNAMES 177313939Slinton else if( p->slevel > lev ) cerror( "%.8s check at level %d", p->sname, lev ); 177413939Slinton #else 177513939Slinton else if( p->slevel > lev ) cerror( "%s check at level %d", p->sname, lev ); 177613939Slinton #endif 177713939Slinton } 177813939Slinton } 177913939Slinton #endif 178013939Slinton 178113939Slinton struct symtab * 178213939Slinton relook(p) register struct symtab *p; { /* look up p again, and see where it lies */ 178313939Slinton 178413939Slinton register struct symtab *q; 178513939Slinton 178613939Slinton /* I'm not sure that this handles towers of several hidden definitions in all cases */ 178713939Slinton q = &stab[lookup( p->sname, p->sflags&(STAG|SMOS|SHIDDEN) )]; 178813939Slinton /* make relook always point to either p or an empty cell */ 178913939Slinton if( q->stype == UNDEF ){ 179013939Slinton q->stype = TNULL; 179113939Slinton return(q); 179213939Slinton } 179313939Slinton while( q != p ){ 179413939Slinton if( q->stype == TNULL ) break; 179513939Slinton if( ++q >= &stab[SYMTSZ] ) q=stab; 179613939Slinton } 179713939Slinton return(q); 179813939Slinton } 179913939Slinton 180013939Slinton clearst( lev ){ /* clear entries of internal scope from the symbol table */ 180113939Slinton register struct symtab *p, *q, *r; 180213939Slinton register int temp, rehash; 180313939Slinton 180413939Slinton temp = lineno; 180513939Slinton aobeg(); 180613939Slinton 180713939Slinton /* first, find an empty slot to prevent newly hashed entries from 180813939Slinton being slopped into... */ 180913939Slinton 181013939Slinton for( q=stab; q< &stab[SYMTSZ]; ++q ){ 181113939Slinton if( q->stype == TNULL )goto search; 181213939Slinton } 181313939Slinton 181413939Slinton cerror( "symbol table full"); 181513939Slinton 181613939Slinton search: 181713939Slinton p = q; 181813939Slinton 181913939Slinton for(;;){ 182013939Slinton if( p->stype == TNULL ) { 182113939Slinton rehash = 0; 182213939Slinton goto next; 182313939Slinton } 182413939Slinton lineno = p->suse; 182513939Slinton if( lineno < 0 ) lineno = - lineno; 182613939Slinton if( p->slevel>lev ){ /* must clobber */ 182713939Slinton if( p->stype == UNDEF || ( p->sclass == ULABEL && lev < 2 ) ){ 182813939Slinton lineno = temp; 182913939Slinton #ifndef FLEXNAMES 183013939Slinton uerror( "%.8s undefined", p->sname ); 183113939Slinton #else 183213939Slinton uerror( "%s undefined", p->sname ); 183313939Slinton #endif 183413939Slinton } 183513939Slinton else aocode(p); 183613939Slinton # ifndef BUG1 183713939Slinton #ifndef FLEXNAMES 183813939Slinton if (ddebug) printf("removing %8s from stab[ %d], flags %o level %d\n", 183913939Slinton #else 184013939Slinton if (ddebug) printf("removing %s from stab[ %d], flags %o level %d\n", 184113939Slinton #endif 184213939Slinton p->sname,p-stab,p->sflags,p->slevel); 184313939Slinton # endif 184413939Slinton if( p->sflags & SHIDES ) unhide(p); 184513939Slinton p->stype = TNULL; 184613939Slinton rehash = 1; 184713939Slinton goto next; 184813939Slinton } 184913939Slinton if( rehash ){ 185013939Slinton if( (r=relook(p)) != p ){ 185113939Slinton movestab( r, p ); 185213939Slinton p->stype = TNULL; 185313939Slinton } 185413939Slinton } 185513939Slinton next: 185613939Slinton if( ++p >= &stab[SYMTSZ] ) p = stab; 185713939Slinton if( p == q ) break; 185813939Slinton } 185913939Slinton lineno = temp; 186013939Slinton aoend(); 186113939Slinton } 186213939Slinton 186313939Slinton movestab( p, q ) register struct symtab *p, *q; { 186413939Slinton int k; 186513939Slinton /* structure assignment: *p = *q; */ 186613939Slinton p->stype = q->stype; 186713939Slinton p->sclass = q->sclass; 186813939Slinton p->slevel = q->slevel; 186913939Slinton p->offset = q->offset; 187013939Slinton p->sflags = q->sflags; 187113939Slinton p->dimoff = q->dimoff; 187213939Slinton p->sizoff = q->sizoff; 187313939Slinton p->suse = q->suse; 187413939Slinton #ifndef FLEXNAMES 187513939Slinton for( k=0; k<NCHNAM; ++k ){ 187613939Slinton p->sname[k] = q->sname[k]; 187713939Slinton } 187813939Slinton #else 187913939Slinton p->sname = q->sname; 188013939Slinton #endif 188113939Slinton } 188213939Slinton 188313939Slinton 188413939Slinton hide( p ) register struct symtab *p; { 188513939Slinton register struct symtab *q; 188613939Slinton for( q=p+1; ; ++q ){ 188713939Slinton if( q >= &stab[SYMTSZ] ) q = stab; 188813939Slinton if( q == p ) cerror( "symbol table full" ); 188913939Slinton if( q->stype == TNULL ) break; 189013939Slinton } 189113939Slinton movestab( q, p ); 189213939Slinton p->sflags |= SHIDDEN; 189313939Slinton q->sflags = (p->sflags&(SMOS|STAG)) | SHIDES; 189413939Slinton #ifndef FLEXNAMES 189513939Slinton if( hflag ) werror( "%.8s redefinition hides earlier one", p->sname ); 189613939Slinton #else 189713939Slinton if( hflag ) werror( "%s redefinition hides earlier one", p->sname ); 189813939Slinton #endif 189913939Slinton # ifndef BUG1 190013939Slinton if( ddebug ) printf( " %d hidden in %d\n", p-stab, q-stab ); 190113939Slinton # endif 190213939Slinton return( idname = q-stab ); 190313939Slinton } 190413939Slinton 190513939Slinton unhide( p ) register struct symtab *p; { 190613939Slinton register struct symtab *q; 190713939Slinton register s, j; 190813939Slinton 190913939Slinton s = p->sflags & (SMOS|STAG); 191013939Slinton q = p; 191113939Slinton 191213939Slinton for(;;){ 191313939Slinton 191413939Slinton if( q == stab ) q = &stab[SYMTSZ-1]; 191513939Slinton else --q; 191613939Slinton 191713939Slinton if( q == p ) break; 191813939Slinton 191913939Slinton if( (q->sflags&(SMOS|STAG)) == s ){ 192013939Slinton #ifndef FLEXNAMES 192113939Slinton for( j =0; j<NCHNAM; ++j ) if( p->sname[j] != q->sname[j] ) break; 192213939Slinton if( j == NCHNAM ){ /* found the name */ 192313939Slinton #else 192413939Slinton if (p->sname == q->sname) { 192513939Slinton #endif 192613939Slinton q->sflags &= ~SHIDDEN; 192713939Slinton # ifndef BUG1 192813939Slinton if( ddebug ) printf( "unhide uncovered %d from %d\n", q-stab,p-stab); 192913939Slinton # endif 193013939Slinton return; 193113939Slinton } 193213939Slinton } 193313939Slinton 193413939Slinton } 193513939Slinton cerror( "unhide fails" ); 193613939Slinton } 1937