scc

simple C compiler
git clone git://git.2f30.org/scc
Log | Files | Refs | README | LICENSE

decl.c (17714B)


      1 static char sccsid[] = "@(#) ./cc1/decl.c";
      2 #include <stdarg.h>
      3 #include <stdlib.h>
      4 #include <string.h>
      5 
      6 #include <cstd.h>
      7 #include "../inc/scc.h"
      8 #include "cc1.h"
      9 
     10 #define NOSCLASS  0
     11 
     12 #define NOREP 0
     13 #define REP 1
     14 #define QUIET   1
     15 #define NOQUIET 0
     16 
     17 #define NR_DCL_TYP (NR_DECLARATORS+NR_FUNPARAM)
     18 #define NR_DCL_SYM (NR_DECLARATORS+NR_FUNPARAM+1)
     19 
     20 struct declarators {
     21 	unsigned nr;
     22 	unsigned ns;
     23 	struct decl *dcl;
     24 	unsigned nr_types;
     25 	Type **tpars;
     26 	Symbol **pars;
     27 	struct declarator {
     28 		unsigned char op;
     29 		TINT  nelem;
     30 		Symbol *sym;
     31 		Type **tpars;
     32 		Symbol **pars;
     33 	} d [NR_DECLARATORS];
     34 };
     35 
     36 struct decl {
     37 	unsigned ns;
     38 	int sclass;
     39 	int qualifier;
     40 	Symbol *sym;
     41 	Type *type;
     42 	Type *parent;
     43 	Symbol **pars;
     44 	Symbol *bufpars[NR_DCL_SYM];
     45 	Type *buftpars[NR_DCL_TYP];
     46 };
     47 
     48 
     49 static void
     50 endfundcl(Type *tp, Symbol **pars)
     51 {
     52 	if (tp->prop&TK_R && *pars)
     53 		warn("parameter names (without types) in function declaration");
     54 	/*
     55 	 * avoid non used warnings in prototypes
     56 	 */
     57 	while (*pars)
     58 		(*pars++)->flags |= SUSED;
     59 	popctx();
     60 }
     61 
     62 static void
     63 push(struct declarators *dp, int op, ...)
     64 {
     65 	va_list va;
     66 	unsigned n;
     67 	struct declarator *p;
     68 
     69 	va_start(va, op);
     70 	if ((n = dp->nr++) == NR_DECLARATORS)
     71 		error("too many declarators");
     72 
     73 	p = &dp->d[n];
     74 	p->op = op;
     75 	p->tpars = NULL;
     76 
     77 	switch (op) {
     78 	case ARY:
     79 		p->nelem = va_arg(va, TINT);
     80 		break;
     81 	case KRFTN:
     82 	case FTN:
     83 		p->nelem = va_arg(va, unsigned);
     84 		p->tpars = va_arg(va, Type **);
     85 		p->pars = va_arg(va, Symbol **);
     86 		break;
     87 	case IDEN:
     88 		p->sym = va_arg(va, Symbol *);
     89 		break;
     90 	}
     91 	va_end(va);
     92 }
     93 
     94 static int
     95 pop(struct declarators *dp, struct decl *dcl)
     96 {
     97 	struct declarator *p;
     98 
     99 	if (dp->nr == 0)
    100 		return 0;
    101 
    102 	p = &dp->d[--dp->nr];
    103 	if (p->op == IDEN) {
    104 		dcl->sym = p->sym;
    105 		return 1;
    106 	}
    107 
    108 	if (dcl->type->op == FTN)
    109 		endfundcl(dcl->type, dcl->pars);
    110 	dcl->pars = p->pars;
    111 
    112 	dcl->type = mktype(dcl->type, p->op, p->nelem, p->tpars);
    113 	return 1;
    114 }
    115 
    116 static void
    117 arydcl(struct declarators *dp)
    118 {
    119 	Node *np = NULL;
    120 	TINT n = 0;
    121 
    122 	expect('[');
    123 	if (yytoken != ']') {
    124 		if ((np = constexpr()) == NULL) {
    125 			errorp("invalid storage size");
    126 		} else {
    127 			if ((n = np->sym->u.i) <= 0) {
    128 				errorp("array size is not a positive number");
    129 				n = 1;
    130 			}
    131 			freetree(np);
    132 		}
    133 	}
    134 	expect(']');
    135 
    136 	push(dp, ARY, n);
    137 }
    138 
    139 static int
    140 empty(Symbol *sym, Type *tp, int param)
    141 {
    142 	if (!sym->name) {
    143 		sym->type = tp;
    144 		switch (tp->op) {
    145 		default:
    146 			 /* warn if it is not a parameter */
    147 			if (!param)
    148 				warn("empty declaration");
    149 		case STRUCT:
    150 		case UNION:
    151 		case ENUM:
    152 			return 1;
    153 		}
    154 	}
    155 	return 0;
    156 }
    157 
    158 static void
    159 bad_storage(Type *tp, char *name)
    160 {
    161 	if (tp->op != FTN)
    162 		errorp("incorrect storage class for file-scope declaration");
    163 	else
    164 		errorp("invalid storage class for function '%s'", name);
    165 }
    166 
    167 static Symbol *
    168 redcl(Symbol *sym, Type *tp, int sclass)
    169 {
    170 	int flags;
    171 	char *name = sym->name;
    172 
    173 	if (!eqtype(sym->type, tp, 1)) {
    174 		errorp("conflicting types for '%s'", name);
    175 		return sym;
    176 	}
    177 
    178 	if (sym->token == TYPEIDEN && sclass != TYPEDEF ||
    179 	    sym->token != TYPEIDEN && sclass == TYPEDEF) {
    180 		goto redeclaration;
    181 	}
    182 	if (curctx != GLOBALCTX && tp->op != FTN) {
    183 		/* is it the redeclaration of a local variable? */
    184 		if ((sym->flags & SEXTERN) && sclass == EXTERN)
    185 			return sym;
    186 		goto redeclaration;
    187 	}
    188 
    189 	flags = sym->flags;
    190 	switch (sclass) {
    191 	case REGISTER:
    192 	case AUTO:
    193 		bad_storage(tp, name);
    194 		break;
    195 	case NOSCLASS:
    196 		if ((flags & SPRIVATE) == 0) {
    197 			if (flags & SEXTERN)
    198 				flags &= ~(SEXTERN|SEMITTED);
    199 			flags |= SGLOBAL;
    200 			break;
    201 		}
    202 		errorp("non-static declaration of '%s' follows static declaration",
    203 		       name);
    204 		break;
    205 	case TYPEDEF:
    206 	case EXTERN:
    207 		break;
    208 	case STATIC:
    209 		if ((flags & (SGLOBAL|SEXTERN)) == 0) {
    210 			flags |= SPRIVATE;
    211 			break;
    212 		}
    213 		errorp("static declaration of '%s' follows non-static declaration",
    214 		       name);
    215 		break;
    216 	}
    217 	sym->flags = flags;
    218 
    219 	return sym;
    220 
    221 redeclaration:
    222 	errorp("redeclaration of '%s'", name);
    223 	return sym;
    224 }
    225 
    226 static Symbol *
    227 identifier(struct decl *dcl)
    228 {
    229 	Symbol *sym = dcl->sym;
    230 	Type *tp = dcl->type;
    231 	int sclass = dcl->sclass;
    232 	char *name = sym->name;
    233 
    234 	if (empty(sym, tp, 0))
    235 		return sym;
    236 
    237 	/* TODO: Add warning about ANSI limits */
    238 	if (!(tp->prop & TDEFINED)                &&
    239 	    sclass != EXTERN && sclass != TYPEDEF &&
    240 	    !(tp->op == ARY && yytoken == '=')) {
    241 		errorp("declared variable '%s' of incomplete type", name);
    242 	}
    243 
    244 	if (tp->op == FTN) {
    245 		if (sclass == NOSCLASS)
    246 			sclass = EXTERN;
    247 		if (!strcmp(name, "main") && tp->type != inttype) {
    248 			errorp("main shall be defined with a return type of int");
    249 			errorp("please contact __20h__ on irc.freenode.net (#bitreich-en) via IRC");
    250 		}
    251 	}
    252 
    253 	if (sym->flags & SDECLARED) {
    254 		sym = redcl(dcl->sym, tp, sclass);
    255 	} else {
    256 		int flags = sym->flags | SDECLARED;
    257 
    258 		sym->type = tp;
    259 
    260 		switch (sclass) {
    261 		case REGISTER:
    262 		case AUTO:
    263 			if (curctx != GLOBALCTX && tp->op != FTN) {
    264 				flags |= (sclass == REGISTER) ? SREGISTER : SAUTO;
    265 				break;
    266 			}
    267 			bad_storage(tp, name);
    268 		case NOSCLASS:
    269 			if (tp->op == FTN)
    270 				flags |= SEXTERN;
    271 			else
    272 				flags |= (curctx == GLOBALCTX) ? SGLOBAL : SAUTO;
    273 			break;
    274 		case EXTERN:
    275 			flags |= SEXTERN;
    276 			break;
    277 		case STATIC:
    278 			flags |= (curctx == GLOBALCTX) ? SPRIVATE : SLOCAL;
    279 			break;
    280 		case TYPEDEF:
    281 			flags |= STYPEDEF;
    282 			sym->u.token = sym->token = TYPEIDEN;
    283 			break;
    284 		}
    285 		sym->flags = flags;
    286 	}
    287 
    288 	if (accept('='))
    289 		initializer(sym, sym->type);
    290 	if (!(sym->flags & (SGLOBAL|SEXTERN)) && tp->op != FTN)
    291 		sym->flags |= SDEFINED;
    292 	if (sym->token == IDEN && tp->op != FTN)
    293 		emit(ODECL, sym);
    294 	return sym;
    295 }
    296 
    297 static Symbol *
    298 parameter(struct decl *dcl)
    299 {
    300 	Symbol *sym = dcl->sym;
    301 	Type *funtp = dcl->parent, *tp = dcl->type;
    302 	char *name = sym->name;
    303 	int flags;
    304 
    305 	flags = 0;
    306 	switch (dcl->sclass) {
    307 	case STATIC:
    308 	case EXTERN:
    309 	case AUTO:
    310 		errorp("bad storage class in function parameter");
    311 		break;
    312 	case REGISTER:
    313 		flags |= SREGISTER;
    314 		break;
    315 	case NOSCLASS:
    316 		flags |= SAUTO;
    317 		break;
    318 	}
    319 
    320 	switch (tp->op) {
    321 	case VOID:
    322 		funtp->n.elem = 1;
    323 		if (dcl->sclass)
    324 			errorp("void as unique parameter may not be qualified");
    325 		return NULL;
    326 	case ARY:
    327 		tp = mktype(tp->type, PTR, 0, NULL);
    328 		break;
    329 	case FTN:
    330 		errorp("incorrect function type for a function parameter");
    331 		return NULL;
    332 	}
    333 	if (!empty(sym, tp, 1)) {
    334 		int isdcl = sym->flags&SDECLARED, isk_r = funtp->prop & TK_R;
    335 		if (isdcl && !isk_r) {
    336 			errorp("redefinition of parameter '%s'", name);
    337 			return NULL;
    338 		}
    339 		if (!isdcl && isk_r) {
    340 			errorp("declaration for parameter '%s' but no such parameter",
    341 			       sym->name);
    342 			return NULL;
    343 		}
    344 		sym->flags |= SDECLARED;
    345 	}
    346 
    347 	sym->type = tp;
    348 	sym->flags &= ~(SAUTO|SREGISTER);
    349 	sym->flags |= flags;
    350 	return sym;
    351 }
    352 
    353 static Symbol *dodcl(int rep,
    354                      Symbol *(*fun)(struct decl *),
    355                      unsigned ns,
    356                      Type *type);
    357 
    358 static int
    359 krpars(struct declarators *dp)
    360 {
    361 	Symbol *sym;
    362 	int toomany = 0;
    363 	unsigned npars = 0;
    364 
    365 	do {
    366 		sym = yylval.sym;
    367 		expect(IDEN);
    368 		sym->flags |= SAUTO;
    369 		if ((sym = install(NS_IDEN, sym)) == NULL) {
    370 			errorp("redefinition of parameter '%s'",
    371 			       yylval.sym->name);
    372 			continue;
    373 		}
    374 		if (npars < NR_FUNPARAM) {
    375 			++npars;
    376 			*dp->pars++ = sym;
    377 			continue;
    378 		}
    379 		if (!toomany)
    380 		toomany = 1;
    381 	} while (accept(','));
    382 
    383 	return toomany;
    384 }
    385 
    386 static unsigned
    387 krfun(struct declarators *dp)
    388 {
    389 	int toomany = 0;
    390 
    391 
    392 	if (yytoken != ')')
    393 		toomany = krpars(dp);
    394 
    395 	if (dp->nr_types == NR_DCL_TYP) {
    396 		toomany = 1;
    397 	} else {
    398 		++dp->nr_types;
    399 		*dp->tpars++ = ellipsistype;
    400 	}
    401 
    402 	if (toomany)
    403 		errorp("too many parameters in function definition");
    404 	return 1;
    405 }
    406 
    407 static unsigned
    408 ansifun(struct declarators *dp)
    409 {
    410 	Symbol *sym;
    411 	unsigned npars, ntype, toomany, distoomany, voidpar;
    412 	Type type, *tp;
    413 
    414 	type.n.elem = 0;
    415 	type.prop = 0;
    416 	npars = ntype = toomany = distoomany = voidpar = 0;
    417 
    418 	do {
    419 		if (accept(ELLIPSIS)) {
    420 			if (ntype < 1)
    421 				errorp("a named argument is requiered before '...'");
    422 			if (yytoken != ')')
    423 				errorp("... must be the last parameter");
    424 			sym = NULL;
    425 			tp = ellipsistype;
    426 		} else if ((sym = dodcl(NOREP, parameter, NS_IDEN, &type)) == NULL) {
    427 			if (type.n.elem == 1 && ntype > 1)
    428 				voidpar = 1;
    429 			sym = NULL;
    430 			tp = NULL;
    431 		} else {
    432 			tp = sym->type;
    433 		}
    434 
    435 		if (sym) {
    436 			if (npars == NR_FUNPARAM) {
    437 				toomany = 1;
    438 			} else {
    439 				npars++;
    440 				*dp->pars++ = sym;
    441 			}
    442 		}
    443 
    444 		if (tp) {
    445 			if (dp->nr_types == NR_DCL_TYP) {
    446 				toomany = 1;
    447 			} else {
    448 				ntype++;
    449 				dp->nr_types++;
    450 				*dp->tpars++ = tp;
    451 			}
    452 		}
    453 
    454 	} while (accept(','));
    455 
    456 	if (toomany == 1)
    457 		errorp("too many parameters in function definition");
    458 	if (voidpar && ntype > 1)
    459 		errorp("'void' must be the only parameter");
    460 	return ntype;
    461 }
    462 
    463 static int
    464 funbody(Symbol *sym, Symbol *pars[])
    465 {
    466 	Type *tp;
    467 	Symbol **bp, *p;
    468 
    469 	if (!sym)
    470 		return 0;
    471 	tp = sym->type;
    472 	if (tp->op != FTN)
    473 		return 0;
    474 
    475 	switch (yytoken) {
    476 	case '{':
    477 	case TYPE:
    478 	case TYPEIDEN:
    479 		if (curctx != PARAMCTX)
    480 			errorp("nested function declaration");
    481 		if (sym && sym->ns == NS_IDEN)
    482 			break;
    483 	default:
    484 		emit(ODECL, sym);
    485 		endfundcl(tp, pars);
    486 		return  0;
    487 	}
    488 
    489 	tp->prop |= TFUNDEF;
    490 	curfun = sym;
    491 	if (sym->type->prop & TK_R) {
    492 		while (yytoken != '{') {
    493 			dodcl(REP, parameter, NS_IDEN, sym->type);
    494 			expect(';');
    495 		}
    496 		for (bp = pars; p = *bp; ++bp) {
    497 			if (p->type == NULL) {
    498 				warn("type of '%s' defaults to int", p->name);
    499 				p->type = inttype;
    500 			}
    501 		}
    502 	}
    503 	if (sym->flags & STYPEDEF)
    504 		errorp("function definition declared 'typedef'");
    505 	if (sym->flags & SDEFINED)
    506 		errorp("redefinition of '%s'", sym->name);
    507 	if (sym->flags & SEXTERN) {
    508 		sym->flags &= ~SEXTERN;
    509 		sym->flags |= SGLOBAL;
    510 	}
    511 	sym->flags |= SDEFINED;
    512 	sym->flags &= ~SEMITTED;
    513 	sym->u.pars = pars;
    514 	emit(OFUN, sym);
    515 	compound(NULL, NULL, NULL);
    516 	emit(OEFUN, NULL);
    517 	popctx();
    518 	flushtypes();
    519 	curfun = NULL;
    520 	return 1;
    521 }
    522 
    523 static void
    524 fundcl(struct declarators *dp)
    525 {
    526 	Type **types = dp->tpars;
    527 	unsigned ntypes, typefun;
    528 	Symbol **pars = dp->pars;
    529 	unsigned (*fun)(struct declarators *);
    530 
    531 	pushctx();
    532 	expect('(');
    533 	if (yytoken == ')' || yytoken == IDEN) {
    534 		typefun = KRFTN;
    535 		fun = krfun;
    536 	} else {
    537 		typefun = FTN;
    538 		fun = ansifun;
    539 	}
    540 	ntypes = (*fun)(dp);
    541 	*dp->pars++= NULL;
    542 	expect(')');
    543 
    544 	push(dp, typefun, ntypes, types, pars);
    545 }
    546 
    547 static void declarator(struct declarators *dp);
    548 
    549 static void
    550 directdcl(struct declarators *dp)
    551 {
    552 	Symbol *p, *sym;
    553 	static int nested;
    554 
    555 	if (accept('(')) {
    556 		if (nested == NR_SUBTYPE)
    557 			error("too many declarators nested by parentheses");
    558 		++nested;
    559 		declarator(dp);
    560 		--nested;
    561 		expect(')');
    562 	} else {
    563 		if (yytoken == IDEN || yytoken == TYPEIDEN) {
    564 			sym = yylval.sym;
    565 			if (p = install(dp->ns, sym)) {
    566 				sym = p;
    567 				sym->flags &= ~SDECLARED;
    568 			}
    569 			next();
    570 		} else {
    571 			sym = newsym(dp->ns, NULL);
    572 		}
    573 		push(dp, IDEN, sym);
    574 	}
    575 
    576 	for (;;) {
    577 		switch (yytoken) {
    578 		case '(':  fundcl(dp); break;
    579 		case '[':  arydcl(dp); break;
    580 		default:   return;
    581 		}
    582 	}
    583 }
    584 
    585 static void
    586 declarator(struct declarators *dp)
    587 {
    588 	unsigned  n;
    589 
    590 	for (n = 0; accept('*'); ++n) {
    591 		while (accept(TQUALIFIER))
    592 			/* nothing */;
    593 	}
    594 
    595 	directdcl(dp);
    596 
    597 	while (n--)
    598 		push(dp, PTR);
    599 }
    600 
    601 static Type *structdcl(void), *enumdcl(void);
    602 
    603 static Type *
    604 specifier(int *sclass, int *qualifier)
    605 {
    606 	Type *tp = NULL;
    607 	unsigned spec, qlf, sign, type, cls, size;
    608 
    609 	spec = qlf = sign = type = cls = size = 0;
    610 
    611 	for (;;) {
    612 		unsigned *p = NULL;
    613 		Type *(*dcl)(void) = NULL;
    614 
    615 		switch (yytoken) {
    616 		case SCLASS:
    617 			p = &cls;
    618 			break;
    619 		case TQUALIFIER:
    620 			qlf |= yylval.token;
    621 			next();
    622 			continue;
    623 		case TYPEIDEN:
    624 			if (type)
    625 				goto return_type;
    626 			tp = yylval.sym->type;
    627 			p = &type;
    628 			break;
    629 		case TYPE:
    630 			switch (yylval.token) {
    631 			case ENUM:
    632 				dcl = enumdcl;
    633 				p = &type;
    634 				break;
    635 			case STRUCT:
    636 			case UNION:
    637 				dcl = structdcl;
    638 				p = &type;
    639 				break;
    640 			case VA_LIST:
    641 			case VOID:
    642 			case BOOL:
    643 			case CHAR:
    644 			case INT:
    645 			case FLOAT:
    646 			case DOUBLE:
    647 				p = &type;
    648 				break;
    649 			case SIGNED:
    650 			case UNSIGNED:
    651 				p = &sign;
    652 				break;
    653 			case LONG:
    654 				if (size == LONG) {
    655 					yylval.token = LLONG;
    656 					size = 0;
    657 				}
    658 			case SHORT:
    659 				p = &size;
    660 				break;
    661 			}
    662 			break;
    663 		default:
    664 			goto return_type;
    665 		}
    666 		if (*p)
    667 			errorp("invalid type specification");
    668 		*p = yylval.token;
    669 		if (dcl) {
    670 			if (size || sign)
    671 				errorp("invalid type specification");
    672 			tp = (*dcl)();
    673 			goto return_type;
    674 		} else {
    675 			next();
    676 		}
    677 		spec = 1;
    678 	}
    679 
    680 return_type:
    681 	*sclass = cls;
    682 	*qualifier = qlf;
    683 	if (!tp) {
    684 		if (spec) {
    685 			tp = ctype(type, sign, size);
    686 		} else {
    687 			if (curctx != GLOBALCTX)
    688 				unexpected();
    689 			warn("type defaults to 'int' in declaration");
    690 			tp = inttype;
    691 		}
    692 	}
    693 	return tp;
    694 }
    695 
    696 static Symbol *
    697 newtag(void)
    698 {
    699 	Symbol *sym;
    700 	int ns, op, tag = yylval.token;
    701 	static unsigned tpns = NS_STRUCTS;
    702 
    703 	ns = namespace;
    704 	namespace = NS_TAG;
    705 	next();
    706 	namespace = ns;
    707 
    708 	switch (yytoken) {
    709 	case IDEN:
    710 	case TYPEIDEN:
    711 		sym = yylval.sym;
    712 		if ((sym->flags & SDECLARED) == 0)
    713 			install(NS_TAG, yylval.sym);
    714 		next();
    715 		break;
    716 	default:
    717 		sym = newsym(NS_TAG, NULL);
    718 		break;
    719 	}
    720 	if (!sym->type) {
    721 		Type *tp;
    722 
    723 		if (tpns == NS_STRUCTS + NR_MAXSTRUCTS)
    724 			error("too many tags declared");
    725 		tp = mktype(NULL, tag, 0, NULL);
    726 		tp->ns = tpns++;
    727 		sym->type = tp;
    728 		tp->tag = sym;
    729 		DBG("declared tag '%s' with ns = %d\n",
    730 		    (sym->name) ? sym->name : "anonymous", tp->ns);
    731 	}
    732 
    733 	if ((op = sym->type->op) != tag &&  op != INT)
    734 		error("'%s' defined as wrong kind of tag", sym->name);
    735 	return sym;
    736 }
    737 
    738 static void fieldlist(Type *tp);
    739 
    740 static Type *
    741 structdcl(void)
    742 {
    743 	Symbol *sym;
    744 	Type *tp;
    745 	static int nested;
    746 	int ns;
    747 
    748 	sym = newtag();
    749 	tp = sym->type;
    750 
    751 	if (!accept('{'))
    752 		return tp;
    753 
    754 	ns = namespace;
    755 	namespace = tp->ns;
    756 
    757 	if (tp->prop & TDEFINED && sym->ctx == curctx)
    758 		error("redefinition of struct/union '%s'", sym->name);
    759 
    760 	if (nested == NR_STRUCT_LEVEL)
    761 		error("too many levels of nested structure or union definitions");
    762 
    763 	++nested;
    764 	while (yytoken != '}') {
    765 		fieldlist(tp);
    766 	}
    767 	--nested;
    768 
    769 	deftype(tp);
    770 	namespace = ns;
    771 	expect('}');
    772 	return tp;
    773 }
    774 
    775 static Type *
    776 enumdcl(void)
    777 {
    778 	Type *tp;
    779 	Symbol *sym, *tagsym;
    780 	int ns, val, toomany;
    781 	unsigned nctes;
    782 
    783 	ns = namespace;
    784 	tagsym = newtag();
    785 	tp = tagsym->type;
    786 
    787 	if (!accept('{'))
    788 		goto restore_name;
    789 	if (tp->prop & TDEFINED)
    790 		errorp("redefinition of enumeration '%s'", tagsym->name);
    791 	deftype(tp);
    792 	namespace = NS_IDEN;
    793 
    794 	/* TODO: check incorrect values in val */
    795 	for (nctes = val = 0; yytoken != '}'; ++nctes, ++val) {
    796 		if (yytoken != IDEN)
    797 			unexpected();
    798 		sym = yylval.sym;
    799 		next();
    800 		if (nctes == NR_ENUM_CTES && !toomany) {
    801 			errorp("too many enum constants in a single enum");
    802 			toomany = 1;
    803 		}
    804 		if (accept('=')) {
    805 			Node *np = constexpr();
    806 
    807 			if (np == NULL)
    808 				errorp("invalid enumeration value");
    809 			else
    810 				val = np->sym->u.i;
    811 			freetree(np);
    812 		}
    813 		if ((sym = install(NS_IDEN, sym)) == NULL) {
    814 			errorp("'%s' redeclared as different kind of symbol",
    815 			       yytext);
    816 		} else {
    817 			sym->u.i = val;
    818 			sym->flags |= SCONSTANT;
    819 			sym->type = inttype;
    820 		}
    821 		if (!accept(','))
    822 			break;
    823 	}
    824 	expect('}');
    825 
    826 restore_name:
    827 	namespace = ns;
    828 	return tp;
    829 }
    830 
    831 static Symbol *
    832 type(struct decl *dcl)
    833 {
    834 	Symbol *sym = dcl->sym;
    835 
    836 	if (dcl->sclass)
    837 		error("class storage in type name");
    838 	if (sym->name)
    839 		error("unexpected identifier in type name");
    840 	sym->type = dcl->type;
    841 
    842 	return sym;
    843 }
    844 
    845 static Symbol *
    846 field(struct decl *dcl)
    847 {
    848 	static char *anon = "<anonymous>";
    849 	Symbol *sym = dcl->sym;
    850 	char *name = (sym->name) ? sym->name : anon;
    851 	Type *structp = dcl->parent, *tp = dcl->type;
    852 	TINT n = structp->n.elem;
    853 	int err = 0;
    854 
    855 	if (accept(':')) {
    856 		Node *np;
    857 		TINT n;
    858 
    859 		if ((np = constexpr()) == NULL) {
    860 			unexpected();
    861 			n = 0;
    862 		} else {
    863 			n = np->sym->u.i;
    864 			freetree(np);
    865 		}
    866 		if (n == 0 && name != anon)
    867 			errorp("zero width for bit-field '%s'", name);
    868 		if (tp != booltype && tp != inttype && tp != uinttype)
    869 			errorp("bit-field '%s' has invalid type", name);
    870 		if (n < 0)
    871 			errorp("negative width in bit-field '%s'", name);
    872 		else if (n > tp->size*8)
    873 			errorp("width of '%s' exceeds its type", name);
    874 	} else if (empty(sym, tp, 0)) {
    875 		return sym;
    876 	}
    877 
    878 	if (tp->op == FTN) {
    879 		errorp("invalid type '%s' in struct/union", name);
    880 		err = 1;
    881 	}
    882 	if (dcl->sclass) {
    883 		errorp("storage class in struct/union field '%s'", name);
    884 		err = 1;
    885 	}
    886 	if (!(tp->prop & TDEFINED)) {
    887 		error("field '%s' has incomplete type", name);
    888 		err = 1;
    889 	}
    890 	if (err)
    891 		return sym;
    892 
    893 	if (sym->flags & SDECLARED)
    894 		error("duplicated member '%s'", name);
    895 	sym->flags |= SFIELD|SDECLARED;
    896 	sym->type = tp;
    897 
    898 	if (n == NR_FIELDS)
    899 		error("too many fields in struct/union");
    900 	DBG("New field '%s' in namespace %d\n", name, structp->ns);
    901 	structp->p.fields = xrealloc(structp->p.fields, ++n * sizeof(*sym));
    902 	structp->p.fields[n-1] = sym;
    903 	structp->n.elem = n;
    904 
    905 	return sym;
    906 }
    907 
    908 static Symbol *
    909 dodcl(int rep, Symbol *(*fun)(struct decl *), unsigned ns, Type *parent)
    910 {
    911 	Symbol *sym;
    912 	Type *base;
    913 	struct decl dcl;
    914 	struct declarators stack;
    915 
    916 	dcl.ns = ns;
    917 	dcl.parent = parent;
    918 	base = specifier(&dcl.sclass, &dcl.qualifier);
    919 
    920 	do {
    921 		dcl.type = base;
    922 		stack.nr_types = stack.nr = 0;
    923 		stack.tpars = dcl.buftpars;
    924 		stack.pars = dcl.bufpars;
    925 		stack.dcl = &dcl;
    926 		stack.ns = ns;
    927 
    928 		declarator(&stack);
    929 
    930 		while (pop(&stack, &dcl))
    931 			/* nothing */;
    932 		sym = (*fun)(&dcl);
    933 		if (funbody(sym, dcl.pars))
    934 			return sym;
    935 	} while (rep && accept(','));
    936 
    937 	return sym;
    938 }
    939 
    940 void
    941 decl(void)
    942 {
    943 	Symbol *sym;
    944 
    945 	if (accept(';'))
    946 		return;
    947 	sym = dodcl(REP, identifier, NS_IDEN, NULL);
    948 	if (sym->type->prop & TFUNDEF)
    949 		return;
    950 	expect(';');
    951 }
    952 
    953 static void
    954 fieldlist(Type *tp)
    955 {
    956 	if (yytoken != ';')
    957 		dodcl(REP, field, tp->ns, tp);
    958 	expect(';');
    959 }
    960 
    961 Type *
    962 typename(void)
    963 {
    964 	return dodcl(NOREP, type, NS_DUMMY, NULL)->type;
    965 }