xref: /csrg-svn/old/pcc/mip/pftn.c (revision 16178)
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 = &paramstk[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