xref: /original-bsd/old/pcc/mip/pftn.c (revision 74bf68f5) 
1 #ifndef lint
2 static char *sccsid ="@(#)pftn.c	1.10 (Berkeley) 01/08/86";
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 ){ /* 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 iclass;  /* storage class of thing being initialized */
833 
834 int ilocctr = 0;  /* location counter for current initialization */
835 
836 beginit(curid){
837 	/* beginning of initilization; set location ctr and set type */
838 	register struct symtab *p;
839 
840 # ifndef BUG1
841 	if( idebug >= 3 ) printf( "beginit(), curid = %d\n", curid );
842 # endif
843 
844 	p = &stab[curid];
845 
846 	iclass = p->sclass;
847 	if( curclass == EXTERN || curclass == FORTRAN ) iclass = EXTERN;
848 	switch( iclass ){
849 
850 	case UNAME:
851 	case EXTERN:
852 		return;
853 	case AUTO:
854 	case REGISTER:
855 		break;
856 	case EXTDEF:
857 	case STATIC:
858 		ilocctr = ISARY(p->stype)?ADATA:DATA;
859 		locctr( ilocctr );
860 		defalign( talign( p->stype, p->sizoff ) );
861 		defnam( p );
862 
863 		}
864 
865 	inoff = 0;
866 	ibseen = 0;
867 
868 	pstk = 0;
869 
870 	instk( curid, p->stype, p->dimoff, p->sizoff, inoff );
871 
872 	}
873 
874 instk( id, t, d, s, off ) OFFSZ off; TWORD t; {
875 	/* make a new entry on the parameter stack to initialize id */
876 
877 	register struct symtab *p;
878 
879 	for(;;){
880 # ifndef BUG1
881 		if( idebug ) printf( "instk((%d, %o,%d,%d, %d)\n", id, t, d, s, off );
882 # endif
883 
884 		/* save information on the stack */
885 
886 		if( !pstk ) pstk = instack;
887 		else ++pstk;
888 
889 		pstk->in_fl = 0;	/* { flag */
890 		pstk->in_id =  id ;
891 		pstk->in_t =  t ;
892 		pstk->in_d =  d ;
893 		pstk->in_s =  s ;
894 		pstk->in_n = 0;  /* number seen */
895 		pstk->in_x =  t==STRTY ?dimtab[s+1] : 0 ;
896 		pstk->in_off =  off;   /* offset at the beginning of this element */
897 		/* if t is an array, DECREF(t) can't be a field */
898 		/* INS_sz has size of array elements, and -size for fields */
899 		if( ISARY(t) ){
900 			pstk->in_sz = tsize( DECREF(t), d+1, s );
901 			}
902 		else if( stab[id].sclass & FIELD ){
903 			pstk->in_sz = - ( stab[id].sclass & FLDSIZ );
904 			}
905 		else {
906 			pstk->in_sz = 0;
907 			}
908 
909 		if( (iclass==AUTO || iclass == REGISTER ) &&
910 			(ISARY(t) || t==STRTY) ) uerror( "no automatic aggregate initialization" );
911 
912 		/* now, if this is not a scalar, put on another element */
913 
914 		if( ISARY(t) ){
915 			t = DECREF(t);
916 			++d;
917 			continue;
918 			}
919 		else if( t == STRTY ){
920 			if( dimtab[pstk->in_s] == 0 ){
921 				uerror( "can't initialize undefined structure" );
922 				iclass = -1;
923 				return;
924 				}
925 			id = dimtab[pstk->in_x];
926 			p = &stab[id];
927 			if( p->sclass != MOS && !(p->sclass&FIELD) ) cerror( "insane structure member list" );
928 			t = p->stype;
929 			d = p->dimoff;
930 			s = p->sizoff;
931 			off += p->offset;
932 			continue;
933 			}
934 		else return;
935 		}
936 	}
937 
938 NODE *
939 getstr(){ /* decide if the string is external or an initializer, and get the contents accordingly */
940 
941 	register l, temp;
942 	register NODE *p;
943 
944 	if( (iclass==EXTDEF||iclass==STATIC) && (pstk->in_t == CHAR || pstk->in_t == UCHAR) &&
945 			pstk!=instack && ISARY( pstk[-1].in_t ) ){
946 		/* treat "abc" as { 'a', 'b', 'c', 0 } */
947 		strflg = 1;
948 		ilbrace();  /* simulate { */
949 		inforce( pstk->in_off );
950 		/* if the array is inflexible (not top level), pass in the size and
951 			be prepared to throw away unwanted initializers */
952 		lxstr((pstk-1)!=instack?dimtab[(pstk-1)->in_d]:0);  /* get the contents */
953 		irbrace();  /* simulate } */
954 		return( NIL );
955 		}
956 	else { /* make a label, and get the contents and stash them away */
957 		if( iclass != SNULL ){ /* initializing */
958 			/* fill out previous word, to permit pointer */
959 			vfdalign( ALPOINT );
960 			}
961 		temp = locctr( blevel==0?ISTRNG:STRNG ); /* set up location counter */
962 		deflab( l = getlab() );
963 		strflg = 0;
964 		lxstr(0); /* get the contents */
965 		locctr( blevel==0?ilocctr:temp );
966 		p = buildtree( STRING, NIL, NIL );
967 		p->tn.rval = -l;
968 		return(p);
969 		}
970 	}
971 
972 putbyte( v ){ /* simulate byte v appearing in a list of integer values */
973 	register NODE *p;
974 	p = bcon(v);
975 	incode( p, SZCHAR );
976 	tfree( p );
977 	gotscal();
978 	}
979 
980 endinit(){
981 	register TWORD t;
982 	register d, s, n, d1;
983 
984 # ifndef BUG1
985 	if( idebug ) printf( "endinit(), inoff = %d\n", inoff );
986 # endif
987 
988 	switch( iclass ){
989 
990 	case EXTERN:
991 	case AUTO:
992 	case REGISTER:
993 	case -1:
994 		return;
995 		}
996 
997 	pstk = instack;
998 
999 	t = pstk->in_t;
1000 	d = pstk->in_d;
1001 	s = pstk->in_s;
1002 	n = pstk->in_n;
1003 
1004 	if( ISARY(t) ){
1005 		d1 = dimtab[d];
1006 
1007 		vfdalign( pstk->in_sz );  /* fill out part of the last element, if needed */
1008 		n = inoff/pstk->in_sz;  /* real number of initializers */
1009 		if( d1 >= n ){
1010 			/* once again, t is an array, so no fields */
1011 			inforce( tsize( t, d, s ) );
1012 			n = d1;
1013 			}
1014 		if( d1!=0 && d1!=n ) uerror( "too many initializers");
1015 		if( n==0 ) werror( "empty array declaration");
1016 		dimtab[d] = n;
1017 		if( d1==0 ) FIXDEF(&stab[pstk->in_id]);
1018 		}
1019 
1020 	else if( t == STRTY || t == UNIONTY ){
1021 		/* clearly not fields either */
1022 		inforce( tsize( t, d, s ) );
1023 		}
1024 	else if( n > 1 ) uerror( "bad scalar initialization");
1025 	/* this will never be called with a field element... */
1026 	else inforce( tsize(t,d,s) );
1027 
1028 	paramno = 0;
1029 	vfdalign( AL_INIT );
1030 	inoff = 0;
1031 	iclass = SNULL;
1032 
1033 	}
1034 
1035 doinit( p ) register NODE *p; {
1036 
1037 	/* take care of generating a value for the initializer p */
1038 	/* inoff has the current offset (last bit written)
1039 		in the current word being generated */
1040 
1041 	register sz, d, s;
1042 	register TWORD t;
1043 	int o;
1044 
1045 	/* note: size of an individual initializer is assumed to fit into an int */
1046 
1047 	if( iclass < 0 ) goto leave;
1048 	if( iclass == EXTERN || iclass == UNAME ){
1049 		uerror( "cannot initialize extern or union" );
1050 		iclass = -1;
1051 		goto leave;
1052 		}
1053 
1054 	if( iclass == AUTO || iclass == REGISTER ){
1055 		/* do the initialization and get out, without regard
1056 		    for filing out the variable with zeros, etc. */
1057 		bccode();
1058 		idname = pstk->in_id;
1059 		p = buildtree( ASSIGN, buildtree( NAME, NIL, NIL ), p );
1060 		ecomp(p);
1061 		return;
1062 		}
1063 
1064 	if( p == NIL ) return;  /* for throwing away strings that have been turned into lists */
1065 
1066 	if( ibseen ){
1067 		uerror( "} expected");
1068 		goto leave;
1069 		}
1070 
1071 # ifndef BUG1
1072 	if( idebug > 1 ) printf( "doinit(%o)\n", p );
1073 # endif
1074 
1075 	t = pstk->in_t;  /* type required */
1076 	d = pstk->in_d;
1077 	s = pstk->in_s;
1078 	if( pstk->in_sz < 0 ){  /* bit field */
1079 		sz = -pstk->in_sz;
1080 		}
1081 	else {
1082 		sz = tsize( t, d, s );
1083 		}
1084 
1085 	inforce( pstk->in_off );
1086 
1087 	p = buildtree( ASSIGN, block( NAME, NIL,NIL, t, d, s ), p );
1088 	p->in.left->in.op = FREE;
1089 	p->in.left = p->in.right;
1090 	p->in.right = NIL;
1091 	p->in.left = optim( p->in.left );
1092 	o = p->in.left->in.op;
1093 	if( o == UNARY AND ){
1094 		o = p->in.left->in.op = FREE;
1095 		p->in.left = p->in.left->in.left;
1096 		}
1097 	p->in.op = INIT;
1098 
1099 	if( sz < SZINT ){ /* special case: bit fields, etc. */
1100 		if( o != ICON ) uerror( "illegal initialization" );
1101 		else incode( p->in.left, sz );
1102 		}
1103 	else if( o == FCON ){
1104 		fincode( p->in.left->fpn.fval, sz );
1105 		}
1106 	else if( o == DCON ){
1107 		fincode( p->in.left->dpn.dval, sz );
1108 		}
1109 	else {
1110 		p = optim(p);
1111 		if( p->in.left->in.op != ICON ) uerror( "illegal initialization" );
1112 		else cinit( p, sz );
1113 		}
1114 
1115 	gotscal();
1116 
1117 	leave:
1118 	tfree(p);
1119 	}
1120 
1121 gotscal(){
1122 	register t, ix;
1123 	register n, id;
1124 	struct symtab *p;
1125 	OFFSZ temp;
1126 
1127 	for( ; pstk > instack; ) {
1128 
1129 		if( pstk->in_fl ) ++ibseen;
1130 
1131 		--pstk;
1132 
1133 		t = pstk->in_t;
1134 
1135 		if( t == STRTY ){
1136 			ix = ++pstk->in_x;
1137 			if( (id=dimtab[ix]) < 0 ) continue;
1138 
1139 			/* otherwise, put next element on the stack */
1140 
1141 			p = &stab[id];
1142 			instk( id, p->stype, p->dimoff, p->sizoff, p->offset+pstk->in_off );
1143 			return;
1144 			}
1145 		else if( ISARY(t) ){
1146 			n = ++pstk->in_n;
1147 			if( n >= dimtab[pstk->in_d] && pstk > instack ) continue;
1148 
1149 			/* put the new element onto the stack */
1150 
1151 			temp = pstk->in_sz;
1152 			instk( pstk->in_id, (TWORD)DECREF(pstk->in_t), pstk->in_d+1, pstk->in_s,
1153 				pstk->in_off+n*temp );
1154 			return;
1155 			}
1156 
1157 		}
1158 
1159 	}
1160 
1161 ilbrace(){ /* process an initializer's left brace */
1162 	register t;
1163 	struct instk *temp;
1164 
1165 	temp = pstk;
1166 
1167 	for( ; pstk > instack; --pstk ){
1168 
1169 		t = pstk->in_t;
1170 		if( t != STRTY && !ISARY(t) ) continue; /* not an aggregate */
1171 		if( pstk->in_fl ){ /* already associated with a { */
1172 			if( pstk->in_n ) uerror( "illegal {");
1173 			continue;
1174 			}
1175 
1176 		/* we have one ... */
1177 		pstk->in_fl = 1;
1178 		break;
1179 		}
1180 
1181 	/* cannot find one */
1182 	/* ignore such right braces */
1183 
1184 	pstk = temp;
1185 	}
1186 
1187 irbrace(){
1188 	/* called when a '}' is seen */
1189 
1190 # ifndef BUG1
1191 	if( idebug ) printf( "irbrace(): paramno = %d on entry\n", paramno );
1192 # endif
1193 
1194 	if( ibseen ) {
1195 		--ibseen;
1196 		return;
1197 		}
1198 
1199 	for( ; pstk > instack; --pstk ){
1200 		if( !pstk->in_fl ) continue;
1201 
1202 		/* we have one now */
1203 
1204 		pstk->in_fl = 0;  /* cancel { */
1205 		gotscal();  /* take it away... */
1206 		return;
1207 		}
1208 
1209 	/* these right braces match ignored left braces: throw out */
1210 
1211 	}
1212 
1213 upoff( size, alignment, poff ) register alignment, *poff; {
1214 	/* update the offset pointed to by poff; return the
1215 	/* offset of a value of size `size', alignment `alignment',
1216 	/* given that off is increasing */
1217 
1218 	register off;
1219 
1220 	off = *poff;
1221 	SETOFF( off, alignment );
1222 	if( (offsz-off) <  size ){
1223 		if( instruct!=INSTRUCT )cerror("too many local variables");
1224 		else cerror("Structure too large");
1225 		}
1226 	*poff = off+size;
1227 	return( off );
1228 	}
1229 
1230 oalloc( p, poff ) register struct symtab *p; register *poff; {
1231 	/* allocate p with offset *poff, and update *poff */
1232 	register al, off, tsz;
1233 	int noff;
1234 
1235 	al = talign( p->stype, p->sizoff );
1236 	noff = off = *poff;
1237 	tsz = tsize( p->stype, p->dimoff, p->sizoff );
1238 #ifdef BACKAUTO
1239 	if( p->sclass == AUTO ){
1240 		if( (offsz-off) < tsz ) cerror("too many local variables");
1241 		noff = off + tsz;
1242 		SETOFF( noff, al );
1243 		off = -noff;
1244 		}
1245 	else
1246 #endif
1247 		if( p->sclass == PARAM && ( tsz < SZINT ) ){
1248 			off = upoff( SZINT, ALINT, &noff );
1249 # ifndef RTOLBYTES
1250 			off = noff - tsz;
1251 #endif
1252 			}
1253 		else
1254 		{
1255 		off = upoff( tsz, al, &noff );
1256 		}
1257 
1258 	if( p->sclass != REGISTER ){ /* in case we are allocating stack space for register arguments */
1259 		if( p->offset == NOOFFSET ) p->offset = off;
1260 		else if( off != p->offset ) return(1);
1261 		}
1262 
1263 	*poff = noff;
1264 	return(0);
1265 	}
1266 
1267 falloc( p, w, new, pty )  register struct symtab *p; NODE *pty; {
1268 	/* allocate a field of width w */
1269 	/* new is 0 if new entry, 1 if redefinition, -1 if alignment */
1270 
1271 	register al,sz,type;
1272 
1273 	type = (new<0)? pty->in.type : p->stype;
1274 
1275 	/* this must be fixed to use the current type in alignments */
1276 	switch( new<0?pty->in.type:p->stype ){
1277 
1278 	case ENUMTY:
1279 		{
1280 			int s;
1281 			s = new<0 ? pty->fn.csiz : p->sizoff;
1282 			al = dimtab[s+2];
1283 			sz = dimtab[s];
1284 			break;
1285 			}
1286 
1287 	case CHAR:
1288 	case UCHAR:
1289 		al = ALCHAR;
1290 		sz = SZCHAR;
1291 		break;
1292 
1293 	case SHORT:
1294 	case USHORT:
1295 		al = ALSHORT;
1296 		sz = SZSHORT;
1297 		break;
1298 
1299 	case INT:
1300 	case UNSIGNED:
1301 		al = ALINT;
1302 		sz = SZINT;
1303 		break;
1304 #ifdef LONGFIELDS
1305 
1306 	case LONG:
1307 	case ULONG:
1308 		al = ALLONG;
1309 		sz = SZLONG;
1310 		break;
1311 #endif
1312 
1313 	default:
1314 		if( new < 0 ) {
1315 			uerror( "illegal field type" );
1316 			al = ALINT;
1317 			}
1318 		else {
1319 			al = fldal( p->stype );
1320 			sz =SZINT;
1321 			}
1322 		}
1323 
1324 	if( w > sz ) {
1325 		uerror( "field too big");
1326 		w = sz;
1327 		}
1328 
1329 	if( w == 0 ){ /* align only */
1330 		SETOFF( strucoff, al );
1331 		if( new >= 0 ) uerror( "zero size field");
1332 		return(0);
1333 		}
1334 
1335 	if( strucoff%al + w > sz ) SETOFF( strucoff, al );
1336 	if( new < 0 ) {
1337 		if( (offsz-strucoff) < w )
1338 			cerror("structure too large");
1339 		strucoff += w;  /* we know it will fit */
1340 		return(0);
1341 		}
1342 
1343 	/* establish the field */
1344 
1345 	if( new == 1 ) { /* previous definition */
1346 		if( p->offset != strucoff || p->sclass != (FIELD|w) ) return(1);
1347 		}
1348 	p->offset = strucoff;
1349 	if( (offsz-strucoff) < w ) cerror("structure too large");
1350 	strucoff += w;
1351 	p->stype = type;
1352 	fldty( p );
1353 	return(0);
1354 	}
1355 
1356 nidcl( p ) NODE *p; { /* handle unitialized declarations */
1357 	/* assumed to be not functions */
1358 	register class;
1359 	register commflag;  /* flag for labelled common declarations */
1360 
1361 	commflag = 0;
1362 
1363 	/* compute class */
1364 	if( (class=curclass) == SNULL ){
1365 		if( blevel > 1 ) class = AUTO;
1366 		else if( blevel != 0 || instruct ) cerror( "nidcl error" );
1367 		else { /* blevel = 0 */
1368 			class = noinit();
1369 			if( class == EXTERN ) commflag = 1;
1370 			}
1371 		}
1372 #ifdef LCOMM
1373 	/* hack so stab will come at as LCSYM rather than STSYM */
1374 	if (class == STATIC) {
1375 		extern int stabLCSYM;
1376 		stabLCSYM = 1;
1377 	}
1378 #endif
1379 
1380 	defid( p, class );
1381 
1382 #ifndef LCOMM
1383 	if( class==EXTDEF || class==STATIC )
1384 #else
1385 	if (class==STATIC) {
1386 		register struct symtab *s = &stab[p->tn.rval];
1387 		extern int stabLCSYM;
1388 		int sz = tsize(s->stype, s->dimoff, s->sizoff)/SZCHAR;
1389 
1390 		stabLCSYM = 0;
1391 		if (sz % sizeof (int))
1392 			sz += sizeof (int) - (sz % sizeof (int));
1393 		if (s->slevel > 1)
1394 			printf("	.lcomm	L%d,%d\n", s->offset, sz);
1395 		else
1396 			printf("	.lcomm	%s,%d\n", exname(s->sname), sz);
1397 	}else if (class == EXTDEF)
1398 #endif
1399 		{
1400 		/* simulate initialization by 0 */
1401 		beginit(p->tn.rval);
1402 		endinit();
1403 		}
1404 	if( commflag ) commdec( p->tn.rval );
1405 	}
1406 
1407 TWORD
1408 types( t1, t2, t3 ) TWORD t1, t2, t3; {
1409 	/* return a basic type from basic types t1, t2, and t3 */
1410 
1411 	TWORD t[3], noun, adj, unsg;
1412 	register i;
1413 
1414 	t[0] = t1;
1415 	t[1] = t2;
1416 	t[2] = t3;
1417 
1418 	unsg = INT;  /* INT or UNSIGNED */
1419 	noun = UNDEF;  /* INT, CHAR, or FLOAT */
1420 	adj = INT;  /* INT, LONG, or SHORT */
1421 
1422 	for( i=0; i<3; ++i ){
1423 		switch( t[i] ){
1424 
1425 		default:
1426 		bad:
1427 			uerror( "illegal type combination" );
1428 			return( INT );
1429 
1430 		case UNDEF:
1431 			continue;
1432 
1433 		case UNSIGNED:
1434 			if( unsg != INT ) goto bad;
1435 			unsg = UNSIGNED;
1436 			continue;
1437 
1438 		case LONG:
1439 		case SHORT:
1440 			if( adj != INT ) goto bad;
1441 			adj = t[i];
1442 			continue;
1443 
1444 		case INT:
1445 		case CHAR:
1446 		case FLOAT:
1447 			if( noun != UNDEF ) goto bad;
1448 			noun = t[i];
1449 			continue;
1450 			}
1451 		}
1452 
1453 	/* now, construct final type */
1454 	if( noun == UNDEF ) noun = INT;
1455 	else if( noun == FLOAT ){
1456 		if( unsg != INT || adj == SHORT ) goto bad;
1457 		return( adj==LONG ? DOUBLE : FLOAT );
1458 		}
1459 	else if( noun == CHAR && adj != INT ) goto bad;
1460 
1461 	/* now, noun is INT or CHAR */
1462 	if( adj != INT ) noun = adj;
1463 	if( unsg == UNSIGNED ) return( noun + (UNSIGNED-INT) );
1464 	else return( noun );
1465 	}
1466 
1467 NODE *
1468 tymerge( typ, idp ) NODE *typ, *idp; {
1469 	/* merge type typ with identifier idp  */
1470 
1471 	register unsigned t;
1472 	register i;
1473 	extern int eprint();
1474 
1475 	if( typ->in.op != TYPE ) cerror( "tymerge: arg 1" );
1476 	if(idp == NIL ) return( NIL );
1477 
1478 # ifndef BUG1
1479 	if( ddebug > 2 ) fwalk( idp, eprint, 0 );
1480 # endif
1481 
1482 	idp->in.type = typ->in.type;
1483 	idp->fn.cdim = curdim;
1484 	tyreduce( idp );
1485 	idp->fn.csiz = typ->fn.csiz;
1486 
1487 	for( t=typ->in.type, i=typ->fn.cdim; t&TMASK; t = DECREF(t) ){
1488 		if( ISARY(t) ) dstash( dimtab[i++] );
1489 		}
1490 
1491 	/* now idp is a single node: fix up type */
1492 
1493 	idp->in.type = ctype( idp->in.type );
1494 
1495 	if( (t = BTYPE(idp->in.type)) != STRTY && t != UNIONTY && t != ENUMTY ){
1496 		idp->fn.csiz = t;  /* in case ctype has rewritten things */
1497 		}
1498 
1499 	return( idp );
1500 	}
1501 
1502 tyreduce( p ) register NODE *p; {
1503 
1504 	/* build a type, and stash away dimensions, from a parse tree of the declaration */
1505 	/* the type is build top down, the dimensions bottom up */
1506 	register o, temp;
1507 	register unsigned t;
1508 
1509 	o = p->in.op;
1510 	p->in.op = FREE;
1511 
1512 	if( o == NAME ) return;
1513 
1514 	t = INCREF( p->in.type );
1515 	if( o == UNARY CALL ) t += (FTN-PTR);
1516 	else if( o == LB ){
1517 		t += (ARY-PTR);
1518 		temp = p->in.right->tn.lval;
1519 		p->in.right->in.op = FREE;
1520 		if( ( temp == 0 ) & ( p->in.left->tn.op == LB ) )
1521 			uerror( "Null dimension" );
1522 		}
1523 
1524 	p->in.left->in.type = t;
1525 	tyreduce( p->in.left );
1526 
1527 	if( o == LB ) dstash( temp );
1528 
1529 	p->tn.rval = p->in.left->tn.rval;
1530 	p->in.type = p->in.left->in.type;
1531 
1532 	}
1533 
1534 fixtype( p, class ) register NODE *p; {
1535 	register unsigned t, type;
1536 	register mod1, mod2;
1537 	/* fix up the types, and check for legality */
1538 
1539 	if( (type = p->in.type) == UNDEF ) return;
1540 	if( mod2 = (type&TMASK) ){
1541 		t = DECREF(type);
1542 		while( mod1=mod2, mod2 = (t&TMASK) ){
1543 			if( mod1 == ARY && mod2 == FTN ){
1544 				uerror( "array of functions is illegal" );
1545 				type = 0;
1546 				}
1547 			else if( mod1 == FTN && ( mod2 == ARY || mod2 == FTN ) ){
1548 				uerror( "function returns illegal type" );
1549 				type = 0;
1550 				}
1551 			t = DECREF(t);
1552 			}
1553 		}
1554 
1555 	/* detect function arguments, watching out for structure declarations */
1556 	/* for example, beware of f(x) struct [ int a[10]; } *x; { ... } */
1557 	/* the danger is that "a" will be converted to a pointer */
1558 
1559 	if( class==SNULL && blevel==1 && !(instruct&(INSTRUCT|INUNION)) ) class = PARAM;
1560 	if( class == PARAM || ( class==REGISTER && blevel==1 ) ){
1561 		if( type == FLOAT ) type = DOUBLE;
1562 		else if( ISARY(type) ){
1563 			++p->fn.cdim;
1564 			type += (PTR-ARY);
1565 			}
1566 		else if( ISFTN(type) ){
1567 			werror( "a function is declared as an argument" );
1568 			type = INCREF(type);
1569 			}
1570 
1571 		}
1572 
1573 	if( instruct && ISFTN(type) ){
1574 		uerror( "function illegal in structure or union" );
1575 		type = INCREF(type);
1576 		}
1577 	p->in.type = type;
1578 	}
1579 
1580 uclass( class ) register class; {
1581 	/* give undefined version of class */
1582 	if( class == SNULL ) return( EXTERN );
1583 	else if( class == STATIC ) return( USTATIC );
1584 	else if( class == FORTRAN ) return( UFORTRAN );
1585 	else return( class );
1586 	}
1587 
1588 fixclass( class, type ) TWORD type; {
1589 
1590 	/* first, fix null class */
1591 
1592 	if( class == SNULL ){
1593 		if( instruct&INSTRUCT ) class = MOS;
1594 		else if( instruct&INUNION ) class = MOU;
1595 		else if( blevel == 0 ) class = EXTDEF;
1596 		else if( blevel == 1 ) class = PARAM;
1597 		else class = AUTO;
1598 
1599 		}
1600 
1601 	/* now, do general checking */
1602 
1603 	if( ISFTN( type ) ){
1604 		switch( class ) {
1605 		default:
1606 			uerror( "function has illegal storage class" );
1607 		case AUTO:
1608 			class = EXTERN;
1609 		case EXTERN:
1610 		case EXTDEF:
1611 		case FORTRAN:
1612 		case TYPEDEF:
1613 		case STATIC:
1614 		case UFORTRAN:
1615 		case USTATIC:
1616 			;
1617 			}
1618 		}
1619 
1620 	if( class&FIELD ){
1621 		if( !(instruct&INSTRUCT) ) uerror( "illegal use of field" );
1622 		return( class );
1623 		}
1624 
1625 	switch( class ){
1626 
1627 	case MOU:
1628 		if( !(instruct&INUNION) ) uerror( "illegal class" );
1629 		return( class );
1630 
1631 	case MOS:
1632 		if( !(instruct&INSTRUCT) ) uerror( "illegal class" );
1633 		return( class );
1634 
1635 	case MOE:
1636 		if( instruct & (INSTRUCT|INUNION) ) uerror( "illegal class" );
1637 		return( class );
1638 
1639 	case REGISTER:
1640 		if( blevel == 0 ) uerror( "illegal register declaration" );
1641 		else if( regvar >= MINRVAR && cisreg( type ) ) return( class );
1642 		if( blevel == 1 ) return( PARAM );
1643 		else return( AUTO );
1644 
1645 	case AUTO:
1646 	case LABEL:
1647 	case ULABEL:
1648 		if( blevel < 2 ) uerror( "illegal class" );
1649 		return( class );
1650 
1651 	case PARAM:
1652 		if( blevel != 1 ) uerror( "illegal class" );
1653 		return( class );
1654 
1655 	case UFORTRAN:
1656 	case FORTRAN:
1657 # ifdef NOFORTRAN
1658 			NOFORTRAN;    /* a condition which can regulate the FORTRAN usage */
1659 # endif
1660 		if( !ISFTN(type) ) uerror( "fortran declaration must apply to function" );
1661 		else {
1662 			type = DECREF(type);
1663 			if( ISFTN(type) || ISARY(type) || ISPTR(type) ) {
1664 				uerror( "fortran function has wrong type" );
1665 				}
1666 			}
1667 	case EXTERN:
1668 	case STATIC:
1669 	case EXTDEF:
1670 	case TYPEDEF:
1671 	case USTATIC:
1672 		if( blevel == 1 ){
1673 			uerror( "illegal class" );
1674 			return( PARAM );
1675 			}
1676 	case STNAME:
1677 	case UNAME:
1678 	case ENAME:
1679 		return( class );
1680 
1681 	default:
1682 		cerror( "illegal class: %d", class );
1683 		/* NOTREACHED */
1684 
1685 		}
1686 	}
1687 
1688 struct symtab *
1689 mknonuniq(idindex) int *idindex; {/* locate a symbol table entry for */
1690 	/* an occurrence of a nonunique structure member name */
1691 	/* or field */
1692 	register i;
1693 	register struct symtab * sp;
1694 	char *p,*q;
1695 
1696 	sp = & stab[ i= *idindex ]; /* position search at old entry */
1697 	while( sp->stype != TNULL ){ /* locate unused entry */
1698 		if( ++i >= SYMTSZ ){/* wrap around symbol table */
1699 			i = 0;
1700 			sp = stab;
1701 			}
1702 		else ++sp;
1703 		if( i == *idindex ) cerror("Symbol table full");
1704 		}
1705 	sp->sflags = SNONUNIQ | SMOS;
1706 	p = sp->sname;
1707 	q = stab[*idindex].sname; /* old entry name */
1708 #ifdef FLEXNAMES
1709 	sp->sname = stab[*idindex].sname;
1710 #endif
1711 # ifndef BUG1
1712 	if( ddebug ){
1713 		printf("\tnonunique entry for %s from %d to %d\n",
1714 			q, *idindex, i );
1715 		}
1716 # endif
1717 	*idindex = i;
1718 #ifndef FLEXNAMES
1719 	for( i=1; i<=NCHNAM; ++i ){ /* copy name */
1720 		if( *p++ = *q /* assign */ ) ++q;
1721 		}
1722 #endif
1723 	return ( sp );
1724 	}
1725 
1726 lookup( name, s) char *name; {
1727 	/* look up name: must agree with s w.r.t. STAG, SMOS and SHIDDEN */
1728 
1729 	register char *p, *q;
1730 	int i, j, ii;
1731 	register struct symtab *sp;
1732 
1733 	/* compute initial hash index */
1734 # ifndef BUG1
1735 	if( ddebug > 2 ){
1736 		printf( "lookup( %s, %d ), stwart=%d, instruct=%d\n", name, s, stwart, instruct );
1737 		}
1738 # endif
1739 
1740 	i = 0;
1741 #ifndef FLEXNAMES
1742 	for( p=name, j=0; *p != '\0'; ++p ){
1743 		i += *p;
1744 		if( ++j >= NCHNAM ) break;
1745 		}
1746 #else
1747 	i = (int)name;
1748 #endif
1749 	i = i%SYMTSZ;
1750 	sp = &stab[ii=i];
1751 
1752 	for(;;){ /* look for name */
1753 
1754 		if( sp->stype == TNULL ){ /* empty slot */
1755 			sp->sflags = s;  /* set STAG, SMOS if needed, turn off all others */
1756 #ifndef FLEXNAMES
1757 			p = sp->sname;
1758 			for( j=0; j<NCHNAM; ++j ) if( *p++ = *name ) ++name;
1759 #else
1760 			sp->sname = name;
1761 #endif
1762 			sp->stype = UNDEF;
1763 			sp->sclass = SNULL;
1764 			return( i );
1765 			}
1766 		if( (sp->sflags & (STAG|SMOS|SHIDDEN)) != s ) goto next;
1767 		p = sp->sname;
1768 		q = name;
1769 #ifndef FLEXNAMES
1770 		for( j=0; j<NCHNAM;++j ){
1771 			if( *p++ != *q ) goto next;
1772 			if( !*q++ ) break;
1773 			}
1774 		return( i );
1775 #else
1776 		if (p == q)
1777 			return ( i );
1778 #endif
1779 	next:
1780 		if( ++i >= SYMTSZ ){
1781 			i = 0;
1782 			sp = stab;
1783 			}
1784 		else ++sp;
1785 		if( i == ii ) cerror( "symbol table full" );
1786 		}
1787 	}
1788 
1789 #ifndef checkst
1790 /* if not debugging, make checkst a macro */
1791 checkst(lev){
1792 	register int s, i, j;
1793 	register struct symtab *p, *q;
1794 
1795 	for( i=0, p=stab; i<SYMTSZ; ++i, ++p ){
1796 		if( p->stype == TNULL ) continue;
1797 		j = lookup( p->sname, p->sflags&(SMOS|STAG) );
1798 		if( j != i ){
1799 			q = &stab[j];
1800 			if( q->stype == UNDEF ||
1801 			    q->slevel <= p->slevel ){
1802 #ifndef FLEXNAMES
1803 				cerror( "check error: %.8s", q->sname );
1804 #else
1805 				cerror( "check error: %s", q->sname );
1806 #endif
1807 				}
1808 			}
1809 #ifndef FLEXNAMES
1810 		else if( p->slevel > lev ) cerror( "%.8s check at level %d", p->sname, lev );
1811 #else
1812 		else if( p->slevel > lev ) cerror( "%s check at level %d", p->sname, lev );
1813 #endif
1814 		}
1815 	}
1816 #endif
1817 
1818 struct symtab *
1819 relook(p) register struct symtab *p; {  /* look up p again, and see where it lies */
1820 
1821 	register struct symtab *q;
1822 
1823 	/* I'm not sure that this handles towers of several hidden definitions in all cases */
1824 	q = &stab[lookup( p->sname, p->sflags&(STAG|SMOS|SHIDDEN) )];
1825 	/* make relook always point to either p or an empty cell */
1826 	if( q->stype == UNDEF ){
1827 		q->stype = TNULL;
1828 		return(q);
1829 		}
1830 	while( q != p ){
1831 		if( q->stype == TNULL ) break;
1832 		if( ++q >= &stab[SYMTSZ] ) q=stab;
1833 		}
1834 	return(q);
1835 	}
1836 
1837 clearst( lev ) register int lev; {
1838 	register struct symtab *p, *q;
1839 	register int temp;
1840 	struct symtab *clist = 0;
1841 
1842 	temp = lineno;
1843 	aobeg();
1844 
1845 	/* step 1: remove entries */
1846 	while( chaintop-1 > lev ){
1847 		register int type;
1848 
1849 		p = schain[--chaintop];
1850 		schain[chaintop] = 0;
1851 		for( ; p; p = q ){
1852 			q = p->snext;
1853 			type = p->stype;
1854 			if( p->stype == TNULL || p->slevel <= lev )
1855 				cerror( "schain botch" );
1856 			lineno = p->suse < 0 ? -p->suse : p->suse;
1857 			if( p->stype==UNDEF || ( p->sclass==ULABEL && lev<2 ) ){
1858 				lineno = temp;
1859 #ifndef FLEXNAMES
1860 				uerror( "%.8s undefined", p->sname );
1861 #else
1862 				uerror( "%s undefined", p->sname );
1863 #endif
1864 				}
1865 			else aocode(p);
1866 # ifndef BUG1
1867 			if( ddebug ){
1868 #ifndef FLEXNAMES
1869 				printf( "removing %.8s", p->sname );
1870 #else
1871 				printf( "removing %s", p->sname );
1872 #endif
1873 				printf( " from stab[%d], flags %o level %d\n",
1874 					p-stab, p->sflags, p->slevel);
1875 				}
1876 # endif
1877 			if( p->sflags & SHIDES )unhide( p );
1878 			p->stype = TNULL;
1879 			p->snext = clist;
1880 			clist = p;
1881 			}
1882 		}
1883 
1884 	/* step 2: fix any mishashed entries */
1885 	p = clist;
1886 	while( p ){
1887 		register struct symtab *r;
1888 
1889 		q = p;
1890 		for(;;){
1891 			if( ++q >= &stab[SYMTSZ] )q = stab;
1892 			if( q == p || q->stype == TNULL )break;
1893 			if( (r = relook(q)) != q ) {
1894 				*r = *q;
1895 				q->stype = NULL;
1896 				}
1897 			}
1898 		p = p->snext;
1899 		}
1900 
1901 	lineno = temp;
1902 	aoend();
1903 	}
1904 
1905 hide( p ) register struct symtab *p; {
1906 	register struct symtab *q;
1907 	for( q=p+1; ; ++q ){
1908 		if( q >= &stab[SYMTSZ] ) q = stab;
1909 		if( q == p ) cerror( "symbol table full" );
1910 		if( q->stype == TNULL ) break;
1911 		}
1912 	*q = *p;
1913 	p->sflags |= SHIDDEN;
1914 	q->sflags = (p->sflags&(SMOS|STAG)) | SHIDES;
1915 #ifndef FLEXNAMES
1916 	if( hflag ) werror( "%.8s redefinition hides earlier one", p->sname );
1917 #else
1918 	if( hflag ) werror( "%s redefinition hides earlier one", p->sname );
1919 #endif
1920 # ifndef BUG1
1921 	if( ddebug ) printf( "	%d hidden in %d\n", p-stab, q-stab );
1922 # endif
1923 	return( idname = q-stab );
1924 	}
1925 
1926 unhide( p ) register struct symtab *p; {
1927 	register struct symtab *q;
1928 	register s, j;
1929 
1930 	s = p->sflags & (SMOS|STAG);
1931 	q = p;
1932 
1933 	for(;;){
1934 
1935 		if( q == stab ) q = &stab[SYMTSZ-1];
1936 		else --q;
1937 
1938 		if( q == p ) break;
1939 
1940 		if( (q->sflags&(SMOS|STAG)) == s ){
1941 #ifndef FLEXNAMES
1942 			for( j =0; j<NCHNAM; ++j ) if( p->sname[j] != q->sname[j] ) break;
1943 			if( j == NCHNAM ){ /* found the name */
1944 #else
1945 			if (p->sname == q->sname) {
1946 #endif
1947 				q->sflags &= ~SHIDDEN;
1948 # ifndef BUG1
1949 				if( ddebug ) printf( "unhide uncovered %d from %d\n", q-stab,p-stab);
1950 # endif
1951 				return;
1952 				}
1953 			}
1954 
1955 		}
1956 	cerror( "unhide fails" );
1957 	}
1958