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