1%{
2/*	Id: scan.l,v 1.109 2011/09/03 08:04:18 ragge Exp 	*/
3/*	$NetBSD: scan.l,v 1.1.1.5 2012/01/11 20:33:13 plunky Exp $	*/
4
5/*
6 * Copyright (c) 2002 Anders Magnusson. All rights reserved.
7 *
8 * Redistribution and use in source and binary forms, with or without
9 * modification, are permitted provided that the following conditions
10 * are met:
11 * 1. Redistributions of source code must retain the above copyright
12 *    notice, this list of conditions and the following disclaimer.
13 * 2. Redistributions in binary form must reproduce the above copyright
14 *    notice, this list of conditions and the following disclaimer in the
15 *    documentation and/or other materials provided with the distribution.
16 * 3. The name of the author may not be used to endorse or promote products
17 *    derived from this software without specific prior written permission
18 *
19 * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR
20 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
21 * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
22 * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
23 * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
24 * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
25 * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
26 * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
27 * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
28 * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29 */
30%}
31
32
33D			[0-9]
34L			[a-zA-Z_]
35H			[a-fA-F0-9]
36E			[Ee][+-]?{D}+
37P			[Pp][+-]?{D}+
38FS			(f|F|l|L)?i?
39IS			(u|U|l|L)*
40UL			({L}|\\u{H}{H}{H}{H}|\\U{H}{H}{H}{H}{H}{H}{H}{H})
41
42%{
43#include <stdlib.h>
44#include <errno.h>
45#include <string.h>
46#include <stdarg.h>
47#include <ctype.h>
48
49#include "pass1.h"
50#include "cgram.h"
51
52static NODE *cvtdig(int radix);
53static NODE *charcon(void);
54static NODE *wcharcon(void);
55static void control(int);
56static void pragma(void);
57int notype, parbal, inattr, parlvl, nodinit, inoso;
58static int resw(TWORD, int);
59
60#define	CPP_IDENT 	2
61#define	CPP_LINE 	3
62#define	CPP_HASH	4
63
64#ifdef STABS
65#define	STABS_LINE(x) if (gflag && cftnsp) stabs_line(x)
66#else
67#define STABS_LINE(x)
68#endif
69#if defined(FLEX_SCANNER) && YY_FLEX_SUBMINOR_VERSION == 31
70/* Hack to avoid unnecessary warnings */
71FILE *yyget_in  (void);
72FILE *yyget_out  (void);
73int yyget_leng  (void);
74char *yyget_text  (void);
75void yyset_in (FILE *);
76void yyset_out (FILE *);
77int yyget_debug  (void);
78void yyset_debug (int);
79int yylex_destroy  (void);
80extern int yyget_lineno (void);
81extern void yyset_lineno (int);
82#endif
83
84%}
85
86%%
87
88"__func__"		{
89				if (cftnsp == NULL)
90					uerror("__func__ outside function");
91				yylval.strp = cftnsp->sname; /* XXX - not C99 */
92				return(C_STRING);
93			}
94"asm"			{ return(C_ASM); }
95"auto"			{ 	return resw(AUTO, C_CLASS); }
96"_Bool"			{ 	return resw(BOOL, C_TYPE); }
97"break"			{ return(C_BREAK); }
98"case"			{ return(C_CASE); }
99"char"			{ 	return resw(CHAR, C_TYPE); }
100"_Complex"		{ 	return resw(COMPLEX, C_TYPE); }
101"const"			{ 	return resw(CON, C_QUALIFIER); }
102"continue"		{ return(C_CONTINUE); }
103"default"		{ return(C_DEFAULT); }
104"do"			{ return(C_DO); }
105"double"		{ 	return resw(DOUBLE, C_TYPE); }
106"else"			{ return(C_ELSE); }
107"enum"			{ notype=1; return(C_ENUM); }
108"extern"		{ 	return resw(EXTERN, C_CLASS); }
109"float"			{ 	return resw(FLOAT, C_TYPE); }
110"for"			{ return(C_FOR); }
111"goto"			{ notype=1; return(C_GOTO); }
112"if"			{ return(C_IF); }
113"_Imaginary"		{ 	return resw(IMAG, C_TYPE); }
114"inline"		{ return(C_FUNSPEC); }
115"int"			{ 	return resw(INT, C_TYPE); }
116"long"			{ 	return resw(LONG, C_TYPE); }
117"register"		{ 	return resw(REGISTER, C_CLASS); }
118"restrict"		{ ; /* just ignore */ }
119"return"		{ return(C_RETURN); }
120"short"			{ 	return resw(SHORT, C_TYPE); }
121"signed"		{ 	return resw(SIGNED, C_TYPE); }
122"sizeof"		{ return(C_SIZEOF); }
123"static"		{ 	return resw(STATIC, C_CLASS); }
124"struct"		{ yylval.intval = STNAME; notype=1; return(C_STRUCT); }
125"switch"		{ return(C_SWITCH); }
126"typedef"		{ 	return resw(TYPEDEF, C_CLASS); }
127"union"			{ yylval.intval = UNAME; notype=1; return(C_STRUCT); }
128"unsigned"		{ 	return resw(UNSIGNED, C_TYPE); }
129"void"			{ 	return resw(VOID, C_TYPE); }
130"volatile"		{	return resw(VOL, C_QUALIFIER); }
131"while"			{ return(C_WHILE); }
132
133{UL}({UL}|{D})*	{ 	struct symtab *s;
134			int i = 0;
135
136			yylval.strp = addname(yytext);
137#ifdef GCC_COMPAT
138			if (doing_init && nodinit == 0) {
139				/* check for name: for old gcc compat */
140				while ((i = input()) == ' ' || i == '\t')
141					;
142				if (i == ':')
143					return(GCC_DESIG);
144				unput(i);
145			}
146			if ((i = gcc_keyword(yylval.strp, &yylval.nodep)) > 0) {
147				if (i == PCC_OFFSETOF)
148					inoso = 1;
149				return i;
150			}
151#endif
152			if (i == 0) {
153				if (notype)
154					return(C_NAME);
155				s = lookup(yylval.strp, SNOCREAT);
156				return s && s->sclass == TYPEDEF ?
157				    notype=1, C_TYPENAME : C_NAME;
158			}
159		}
160
1610[xX]{H}+{IS}?		{ yylval.nodep = cvtdig(16); return(C_ICON); }
1620{D}+{IS}?		{ yylval.nodep = cvtdig(8); return(C_ICON); }
163{D}+{IS}?		{ yylval.nodep = cvtdig(10); return(C_ICON); }
164L'(\\.|[^\\'])+'	{ yylval.nodep = wcharcon(); return(C_ICON); }
165'(\\.|[^\\'])+'		{ yylval.nodep = charcon(); return(C_ICON); }
166
167{D}+{E}{FS}?		{ yylval.nodep = floatcon(yytext); return(C_FCON); }
168{D}*"."{D}+({E})?{FS}?	{ yylval.nodep = floatcon(yytext); return(C_FCON); }
169{D}+"."{D}*({E})?{FS}?	{ yylval.nodep = floatcon(yytext); return(C_FCON); }
1700[xX]{H}*"."{H}+{P}{FS}? { yylval.nodep = fhexcon(yytext); return(C_FCON); }
1710[xX]{H}+"."{P}{FS}?	{ yylval.nodep = fhexcon(yytext); return(C_FCON); }
1720[xX]{H}+{P}{FS}?	{ yylval.nodep = fhexcon(yytext); return(C_FCON); }
173
174L?\"(\\.|[^\\"])*\"	{ yylval.strp = yytext; return C_STRING; }
175
176"..."			{ return(C_ELLIPSIS); }
177">>="			{ yylval.intval = RSEQ; return(C_ASOP); }
178"<<="			{ yylval.intval = LSEQ; return(C_ASOP); }
179"+="			{ yylval.intval = PLUSEQ; return(C_ASOP); }
180"-="			{ yylval.intval = MINUSEQ; return(C_ASOP); }
181"*="			{ yylval.intval = MULEQ; return(C_ASOP); }
182"/="			{ yylval.intval = DIVEQ; return(C_ASOP); }
183"%="			{ yylval.intval = MODEQ; return(C_ASOP); }
184"&="			{ yylval.intval = ANDEQ; return(C_ASOP); }
185"^="			{ yylval.intval = EREQ; return(C_ASOP); }
186"|="			{ yylval.intval = OREQ; return(C_ASOP); }
187">>"			{ yylval.intval = RS; return(C_SHIFTOP); }
188"<<"			{ yylval.intval = LS; return(C_SHIFTOP); }
189"++"			{ yylval.intval = INCR; return(C_INCOP); }
190"--"			{ yylval.intval = DECR; return(C_INCOP); }
191"->"			{ yylval.intval = STREF; return(C_STROP); }
192"&&"			{ yylval.intval = ANDAND; return(C_ANDAND); }
193"||"			{ yylval.intval = OROR; return(C_OROR); }
194"<="			{ yylval.intval = LE; return(C_RELOP); }
195">="			{ yylval.intval = GE; return(C_RELOP); }
196"=="			{ yylval.intval = EQ; return(C_EQUOP); }
197"!="			{ yylval.intval = NE; return(C_EQUOP); }
198";"			{ notype = 0; return(';'); }
199("{"|"<%")		{ notype = 0; return('{'); }
200("}"|"%>")		{ if (rpole) notype = 1; return('}'); }
201","			{ if (parbal && !inoso) notype = 0; return(','); }
202":"			{ if (doing_init) nodinit--; return(':'); }
203"="			{ return('='); }
204"("			{ parbal++; notype = 0; return('('); }
205")"			{	parbal--;
206				inoso = 0;
207				if (parbal==0) { notype = 0; }
208				if (inattr && parlvl == parbal)
209					inattr = 0;
210				return(')'); }
211("["|"<:")		{ return('['); }
212("]"|":>")		{ return(']'); }
213"."			{ yylval.intval = DOT; return(C_STROP); }
214"&"			{ return('&'); }
215"!"			{ yylval.intval = NOT; return(C_UNOP); }
216"~"			{ yylval.intval = COMPL; return(C_UNOP); }
217"-"			{ return('-'); }
218"+"			{ return('+'); }
219"*"			{ if (parbal && notype == 0) notype = 1; return('*'); }
220"/"			{ yylval.intval = DIV; return(C_DIVOP); }
221"%"			{ yylval.intval = MOD; return(C_DIVOP); }
222"<"			{ yylval.intval = LT; return(C_RELOP); }
223">"			{ yylval.intval = GT; return(C_RELOP); }
224"^"			{ return('^'); }
225"|"			{ return('|'); }
226"?"			{ if (doing_init) nodinit++; return('?'); }
227^#pragma[ \t].*		{ pragma(); }
228^#ident[ \t].*		{ control(CPP_IDENT); }
229^#line[ \t].*		{ control(CPP_LINE); }
230^#.*			{ control(CPP_HASH); }
231
232[ \t\v\f]		{ }
233"\n"			{ ++lineno; STABS_LINE(lineno); }
234.			{ /* ignore bad characters */ }
235
236%%
237
238int lineno;
239char *ftitle = "<stdin>";
240
241int
242yywrap(void)
243{
244	if (0) unput(0); /* quiet gcc */
245	return(1);
246}
247
248int
249resw(TWORD t, int rv)
250{
251	if (inattr) {
252		yylval.strp = addname(yytext);
253		return C_NAME;
254	}
255
256	switch (rv) {
257	case C_CLASS:
258		yylval.nodep = block(CLASS, NIL, NIL, t, 0, 0);
259		return rv;
260
261	case C_QUALIFIER:
262		yylval.nodep = block(QUALIFIER, NIL, NIL, 0, 0, 0);
263		yylval.nodep->n_qual = t;
264		return rv;
265
266	case C_TYPE:
267		yylval.nodep = mkty(t, 0, 0);
268		notype=1;
269		return(rv);
270
271	default:
272		cerror("resw");
273	}
274	return 0;
275}
276
277#ifndef SOFTFLOAT
278
279static long double
280typround(long double dc, char *e, TWORD *tw)
281{
282	int im = 0;
283
284	*tw = DOUBLE;
285	for (; *e; e++) {
286		switch (*e) {
287		case 'f':
288		case 'F':
289			*tw = FLOAT;
290			dc = (float)dc;
291			break;
292		case 'l':
293		case 'L':
294			*tw = LDOUBLE;
295			break;
296		case 'i':
297		case 'I':
298			im = 1;
299			break;
300		}
301	}
302	if (*tw == DOUBLE)
303		dc = (double)dc;
304#ifndef NO_COMPLEX
305	if (im)
306		*tw += (FIMAG-FLOAT);
307#endif
308	return dc;
309}
310
311/*
312 * XXX floatcon() and fhexcon() should be in support libraries for
313 * the target floating point.
314 */
315static NODE *
316f2(char *str)
317{
318	TWORD tw;
319	NODE *p;
320	long double dc;
321	char *eptr;
322
323#ifdef HAVE_STRTOLD
324	dc = strtold(str, &eptr); /* XXX - avoid strtod() */
325#else
326	dc = strtod(str, &eptr); /* XXX - avoid strtod() */
327#endif
328	dc = typround(dc, eptr, &tw);
329	p = block(FCON, NIL, NIL, tw, 0, 0);
330	p->n_dcon = dc;
331	return p;
332}
333
334NODE *
335floatcon(char *s)
336{
337	return f2(s);
338}
339
340static int
341h2n(int ch)
342{
343	if (ch >= '0' && ch <= '9')
344		return ch - '0';
345	if (ch >= 'a' && ch <= 'f')
346		return ch - 'a' + 10;
347	return ch - 'A' + 10;
348
349}
350
351NODE *
352fhexcon(char *c)
353{
354	TWORD tw;
355	char *ep;
356	long double d;
357	int i, ed;
358	NODE *p;
359
360	d = 0.0;
361	ed = 0;
362	c+= 2; /* skip 0x */
363#define FSET(n) { d *= 2; if (i & n) d += 1.0; }
364	for (; *c != '.' && *c != 'p' && *c != 'P'; c++) {
365		i = h2n(*c);
366		FSET(8); FSET(4); FSET(2); FSET(1);
367	}
368	if (*c != '.' && *c != 'p' && *c != 'P')
369		cerror("fhexcon");
370	if (*c == '.') {
371		c++;
372		for (; *c != 'p' && *c != 'P'; c++) {
373			i = h2n(*c);
374			FSET(8); FSET(4); FSET(2); FSET(1);
375			ed -= 4;
376		}
377	}
378	if (*c != 'P' && *c != 'p')
379		cerror("fhexcon2");
380	c++;
381	ed += strtol(c, &ep, 10);
382
383	/* avoid looping in vain. Idea from Fred J. Tydeman */
384	if (ed > 32769) ed = 32769;
385	if (ed < -32769) ed = -32769;
386
387	while (ed > 0)
388		d *= 2, ed--;
389	while (ed < 0)
390		d /= 2, ed++;
391	d = typround(d, ep, &tw);
392	p = block(FCON, NIL, NIL, tw, 0, 0);
393	p->n_dcon = d;
394	return p;
395}
396#endif
397
398unsigned int
399esccon(char **sptr)
400{
401	char *wr = *sptr;
402	char *owr;
403	char c;
404	unsigned int val;
405	int wsz = 4, esccon_warn = 1;
406
407	switch (*wr++) {
408	case 'a': val = '\a'; break;
409	case 'b': val = '\b'; break;
410	case 'f': val = '\f'; break;
411	case 'n': val = '\n'; break;
412	case 'r': val = '\r'; break;
413	case 't': val = '\t'; break;
414	case 'v': val = '\v'; break;
415	case '\"': val = '\"'; break;
416	case 'x': val = strtoul(wr, &wr, 16); break;
417	/* ISO/IEC 9099:1999 (E) 6.4.3 */
418	case 'U'|(char)0x80:
419		esccon_warn = 0;
420		/* FALLTHROUGH */
421	case 'U':
422		wsz = 8;
423		/* FALLTHROUGH */
424	case 'u':
425		owr = wr;
426		while (wr < (owr + wsz))
427			if (*wr == '\0')
428				break;
429			else
430				++wr;
431		if (wr != (owr + wsz)) {
432			/* incomplete */
433			val = strtoul(owr, &wr, 16);
434		} else {
435			c = owr[wsz];
436			owr[wsz] = '\0'; /* prevent it from reading too much */
437			val = strtoul(owr, &wr, 16);
438			owr[wsz] = c;
439		}
440		if (wr != (owr + wsz))
441			werror("incomplete universal character name");
442		if (wsz == 4)
443			val &= 0xFFFF;
444		if (esccon_warn && ((val >= 0xD800 && val <= 0xDFFF) ||
445		    (val < 0xA0 && val != 0x24 && val != 0x40 && val != 0x60)))
446			werror("invalid universal character name %04X", val);
447		break;
448	case '0': case '1': case '2': case '3': case '4':
449	case '5': case '6': case '7':
450		val = wr[-1] - '0';
451		if (*wr >= '0' && *wr <= '7') {
452			val = (val << 3) + (*wr++ - '0');
453			if (*wr >= '0' && *wr <= '7')
454				val = (val << 3) + (*wr++ - '0');
455		}
456		break;
457	default: val = wr[-1];
458	}
459	*sptr = wr;
460	return val;
461}
462
463NODE *
464cvtdig(int radix)
465{
466	NODE *p;
467	TWORD otype, ntype;
468	unsigned long long v;
469	char *ch = yytext;
470	int n, numl, numu;
471
472	if (radix == 16)
473		ch += 2; /* Skip 0x */
474
475	v = 0;
476	while ((*ch >= '0' && *ch <= '9') || (*ch >= 'a' && *ch <= 'f') ||
477	    (*ch >= 'A' && *ch <= 'F')) {
478		v *= radix;
479		n = *ch;
480		n = (n <= '9' ? n - '0' : (n > 'F' ? n - 'a' : n - 'A') + 10);
481		ch++;
482		v += n;
483	}
484	/* Parse trailing chars */
485	ntype = INT;
486	numl = numu = 0;
487	for (n = 0; n < 3; n++) {
488		if (*ch == 0)
489			break;
490		if ((*ch == 'l' || *ch == 'L') && numl < 2)
491			ntype+=2, numl++;
492		else if ((*ch == 'u' || *ch == 'U') && numu < 1)
493			ntype = ENUNSIGN(ntype), numu++;
494		else
495			break;
496		ch++;
497	}
498	if (*ch)
499		uerror("constant has too many '%c'", *ch);
500
501	otype = ntype;
502	switch (ntype) {
503	case INT:
504	case LONG:
505	case LONGLONG:
506		if (radix == 10) {
507			if (otype == LONGLONG)
508				break;
509			if (v > MAX_LONG) {
510				ntype = LONGLONG;
511				if (otype == LONG)
512					break;
513			} else if (v > MAX_INT)
514				ntype = LONG;
515		} else {
516			if (v > MAX_LONGLONG) {
517				ntype = ULONGLONG;
518				if (otype == LONGLONG)
519					break;
520			} else if (v > MAX_ULONG) {
521				ntype = LONGLONG;
522			} else if (v > MAX_LONG) {
523				ntype = ULONG;
524				if (otype == LONG)
525					break;
526			} else if (v > MAX_UNSIGNED) {
527				ntype = LONG;
528			} else if (v > MAX_INT)
529				ntype = UNSIGNED;
530		}
531		break;
532	case UNSIGNED:
533	case ULONG:
534		if (v > MAX_ULONG) {
535			ntype = ULONGLONG;
536			if (otype == ULONG)
537				break;
538		} else if (v > MAX_UNSIGNED)
539			ntype = ULONG;
540		break;
541	}
542
543	ntype = ctype(ntype);
544	p = xbcon(v, NULL, ntype);
545	ASGLVAL(p->n_slval, v);
546
547	return p;
548}
549
550/*
551 * Convert a character constant to an integer.
552 */
553NODE *
554charcon(void)
555{
556	int lastcon = 0;
557	int val, i = 0;
558	char *pp = yytext;
559
560	if (*pp == 'L')
561		pp++;
562	pp++;
563	while (*pp != '\'') {
564		if (*pp++ == '\\') {
565			val = esccon(&pp);
566		} else
567			val = pp[-1];
568		makecc(val, i);
569		i++;
570	}
571
572	if (i == 0)
573		uerror("empty character constant");
574	if (i > (SZINT/SZCHAR) || (i>1))
575		werror("too many characters in character constant");
576	return bcon(lastcon);
577}
578
579NODE *
580wcharcon(void)
581{
582	unsigned int lastcon = 0;
583	unsigned int val, i = 0;
584	char *pp = yytext;
585
586	if (*pp == 'L')
587		pp++;
588	pp++;
589	while (*pp != '\'') {
590		if (*pp++ == '\\') {
591			val = esccon(&pp);
592		} else
593			val = pp[-1];
594#if WCHAR_SIZE == 2
595		lastcon = (lastcon << 16) | (val & 0xFFFF);
596#else
597		lastcon = val;
598#endif
599		i++;
600	}
601
602	if (i == 0)
603		uerror("empty wide-character constant");
604	if (i > 1)
605		werror("too many characters in wide-character constant");
606	return xbcon(lastcon, NULL, ctype(UNSIGNED));
607}
608
609void
610control(int t)
611{
612	char *wr = yytext;
613	char *eptr;
614	int val;
615
616	wr++;	/* Skip initial '#' */
617	switch (t) {
618	case CPP_IDENT:
619		return;	/* Just skip these for now. */
620
621	case CPP_LINE:
622		wr += 4;
623		/* FALLTHROUGH */
624	case CPP_HASH:
625		val = strtol(wr, &eptr, 10);
626		if (wr == eptr)	/* Illegal string */
627			goto bad;
628		wr = eptr;
629		lineno = val - 1;
630		while (*wr && *wr != '\"')
631			wr++;
632		if (*wr == 0)
633			return;
634		if (*wr++ != '\"')
635			goto bad;
636		eptr = wr;
637		while (*wr && *wr != '\"')
638			wr++;
639		if (*wr != '\"')
640			goto bad;
641		*wr = 0;
642		ftitle = addstring(eptr);
643#ifdef STABS
644		if (gflag)
645			stabs_file(ftitle);
646#endif
647	}
648	return;
649bad:
650	werror("%s: illegal control", yytext);
651}
652
653int pragma_allpacked;
654int pragma_packed, pragma_aligned;
655char *pragma_renamed;
656
657static int
658pragmas_weak(char *str)
659{
660	struct symtab *sp;
661	char *s1, *s2;
662
663	if ((s1 = pragtok(NULL)) == NULL)
664		return 1;
665	if ((s2 = pragtok(NULL)) == NULL) {
666		sp = lookup(addname(s1), SNORMAL);
667		sp->sap = attr_add(sp->sap, gcc_attr_parse(bdty(NAME, "weak")));
668	} else if (*s2 == '=') {
669		if ((s2 = pragtok(NULL)) == NULL)
670			return 1;
671		sp = lookup(addname(s2), SNORMAL);
672		sp->sap = attr_add(sp->sap, gcc_attr_parse(bdty(CALL,
673		    bdty(NAME, "aliasweak"), bdty(STRING, s1, 0))));
674	} else
675		return 1;
676	return 0;
677}
678
679char *pragstore;
680
681/* trivial tokenizer for pragmas */
682#define ps pragstore
683char *
684pragtok(char *sin)
685{
686	static char ss[2];
687	char *rv;
688
689	if (sin)
690		ps = sin;
691
692	for (; isspace((int)*ps); ps++)
693		;
694	if (*ps == 0)
695		return NULL;
696	for (rv = ps; isalpha((int)*ps) || isdigit((int)*ps) || *ps == '_'; ps++)
697		;
698	ss[0] = *ps;
699	if (rv == ps) {
700		rv = ss, ps++;
701	} else {
702		*ps = 0;
703		rv = tmpstrdup(rv);
704		*ps = ss[0];
705	}
706	return rv;
707}
708
709/* return 1 on error */
710int
711eat(int ch)
712{
713	char *s = pragtok(0);
714	return (s == 0 || *s != ch);
715}
716
717static int
718pragmas_alpack(char *t)
719{
720	char *s;
721	int ap;
722
723	ap = (s = pragtok(0)) ? atoi(s) : 1;
724	if (strcmp(t, "packed") == 0)
725		pragma_packed = ap;
726	else
727		pragma_aligned = ap;
728	return 0;
729}
730
731
732/*
733 * Packing control.
734 * still missing push/pop.
735 */
736static int
737pragmas_pack(char *t)
738{
739	char *s;
740
741	if (eat('('))
742		return 1;
743	s = pragtok(0);
744	if (*s == ')')
745		return pragma_allpacked = 0;
746
747	if (*s < '0' || *s > '9') /* no number */
748		return 1;
749	pragma_allpacked = atoi(s);
750	return eat(')');
751}
752
753static int
754pragmas_renamed(char *t)
755{
756	char *f = pragtok(0);
757
758	if (f == 0)
759		return 1;
760	pragma_renamed = newstring(f, strlen(f));
761	return 0;
762}
763
764static int
765pragmas_stdc(char *t)
766{
767	return 0; /* Just ignore */
768}
769
770struct pragmas {
771	char *name;
772	int (*fun)(char *);
773} pragmas[] = {
774	{ "pack", pragmas_pack },
775	{ "packed", pragmas_alpack },
776	{ "aligned", pragmas_alpack },
777	{ "rename", pragmas_renamed },
778#ifdef GCC_COMPAT
779	{ "GCC", pragmas_gcc },
780#endif
781	{ "STDC", pragmas_stdc },
782	{ "weak", pragmas_weak },
783	{ "ident", NULL },
784	{ 0 },
785};
786/*
787 * got a full pragma line.  Split it up here.
788 */
789static void
790pragma()
791{
792	struct pragmas *p;
793	char *t, *pt;
794
795	if ((t = pragtok(&yytext[7])) != NULL) {
796		pt = ps;
797		for (p = pragmas; p->name; p++) {
798			if (strcmp(t, p->name) == 0) {
799				if (p->fun && (*p->fun)(t))
800					uerror("bad argument to #pragma");
801				return;
802			}
803		}
804		ps = pt;
805		if (mypragma(t))
806			return;
807	}
808	warner(Wunknown_pragmas, t, ps);
809}
810
811void
812cunput(char c)
813{
814	unput(c);
815}
816