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