1*10986Srrh %{
2*10986Srrh 
3*10986Srrh #ifndef lint
4*10986Srrh static char sccsid[] = "@(#)lextab.l	4.1	(Berkeley)	02/11/83";
5*10986Srrh #endif not lint
6*10986Srrh 
7*10986Srrh #include "y.tab.h"
8*10986Srrh #include "b.h"
9*10986Srrh #undef	input
10*10986Srrh #define input()	ninput()
11*10986Srrh #undef	unput
12*10986Srrh #define unput(c)	nunput(c)
13*10986Srrh extern int yylval;
14*10986Srrh #define xxbpmax	1700
15*10986Srrh char xxbuf[xxbpmax + 2];
16*10986Srrh int xxbp = -1;
17*10986Srrh #define xxunmax	200
18*10986Srrh char xxunbuf[xxunmax + 2];
19*10986Srrh int xxunbp = -1;
20*10986Srrh 
21*10986Srrh 
22*10986Srrh int blflag;
23*10986Srrh %}
24*10986Srrh 
25*10986Srrh D	[0-9]
26*10986Srrh A	[0-9a-z]
27*10986Srrh L	[a-z]
28*10986Srrh SP	[^0-9a-z]
29*10986Srrh 
30*10986Srrh %%
31*10986Srrh 
32*10986Srrh %{
33*10986Srrh char *xxtbuff;
34*10986Srrh int xxj, xxn, xxk;
35*10986Srrh char *xxp;
36*10986Srrh %}
37*10986Srrh [=/,(]{D}+[h]			{
38*10986Srrh 				blflag = 1;
39*10986Srrh 				sscanf(&yytext[1],"%d",&xxn);
40*10986Srrh 				xxtbuff = malloc(2*xxn+3);
41*10986Srrh 				for (xxj = xxk = 1; xxj <= xxn; ++xxj)
42*10986Srrh 					{
43*10986Srrh 					xxtbuff[xxk] = ninput();
44*10986Srrh 					if (xxtbuff[xxk] == '"')
45*10986Srrh 						xxtbuff[++xxk] = '"';
46*10986Srrh 					++xxk;
47*10986Srrh 					}
48*10986Srrh 				xxtbuff[0] = xxtbuff[xxk++] = '"';
49*10986Srrh 				xxtbuff[xxk] = '\0';
50*10986Srrh 				putback(xxtbuff);
51*10986Srrh 				free(xxtbuff);
52*10986Srrh 
53*10986Srrh 				backup(yytext[0]);
54*10986Srrh 				blflag = 0;
55*10986Srrh 				xxbp = -1;
56*10986Srrh 				}
57*10986Srrh IF			{fixval(); xxbp = -1; return(xxif);}
58*10986Srrh ELSE			{fixval(); xxbp = -1; return(xxelse);}
59*10986Srrh REPEAT			{fixval(); xxbp = -1; return(xxrept); }
60*10986Srrh WHILE			{fixval(); xxbp = -1; return(xxwhile); }
61*10986Srrh UNTIL			{ fixval(); xxbp = -1; return(xxuntil); }
62*10986Srrh DO			{fixval(); xxbp = -1; return(xxdo); }
63*10986Srrh SWITCH			{fixval(); xxbp = -1; return(xxswitch); }
64*10986Srrh CASE			{fixval(); xxbp = -1; return(xxcase); }
65*10986Srrh DEFAULT			{fixval(); xxbp = -1; return(xxdefault); }
66*10986Srrh END			{fixval(); xxbp = -1; return(xxend); }
67*10986Srrh 
68*10986Srrh ".true."		|
69*10986Srrh ".false."		|
70*10986Srrh 
71*10986Srrh {L}{A}*		{fixval(); xxbp = -1; return(xxident); }
72*10986Srrh ~{D}+			{xxbuf[0] = ' '; fixval(); xxbp = -1; return(xxnum); }
73*10986Srrh {D}+/"."(ge|gt|le|lt|eq|ne|not|or|and)"."	|
74*10986Srrh {D}+\.?			|
75*10986Srrh {D}+\.?[de][+-]?{D}+		|
76*10986Srrh {D}*\.{D}+[de][+-]?{D}+		|
77*10986Srrh {D}*\.{D}+			{fixval(); xxbp = -1; return(xxnum); }
78*10986Srrh 
79*10986Srrh ".gt."			{ putback(">"); xxbp = -1; }
80*10986Srrh ".ge."			{ putback(">=");xxbp = -1; }
81*10986Srrh ".lt."			{ putback("<"); xxbp = -1; }
82*10986Srrh ".le."			{ putback("<="); xxbp = -1; }
83*10986Srrh ".eq."			{ putback("=="); xxbp = -1; }
84*10986Srrh ".ne."			{ putback("!="); xxbp = -1; }
85*10986Srrh ".not."			{ putback("!"); xxbp = -1; }
86*10986Srrh ".or."			{ putback("||"); xxbp = -1; }
87*10986Srrh ".and."			{ putback("&&"); xxbp = -1; }
88*10986Srrh ">="		{fixval(); xxbp = -1;  return(xxge);  }
89*10986Srrh "<="		{fixval(); xxbp = -1;  return(xxle); }
90*10986Srrh ==			{fixval(); xxbp = -1; return(xxeq); }
91*10986Srrh !=			{fixval(); xxbp = -1; return(xxne); }
92*10986Srrh "||"			{fixval(); xxbp = -1; return('|'); }
93*10986Srrh "&&"			{fixval(); xxbp = -1;  return('&'); }
94*10986Srrh "**"			{fixval(); xxbp = -1; return('^'); }
95*10986Srrh 
96*10986Srrh #.*			{fixval(); xxbp = -1; return(xxcom); }
97*10986Srrh \"([^"]|\"\")*\"		{fixval(); xxbp = -1; return(xxstring); }
98*10986Srrh '([^']|'')*'				{
99*10986Srrh 					fixval();
100*10986Srrh 					xxp = yylval;
101*10986Srrh 					xxn = slength(xxp);
102*10986Srrh 					xxtbuff = malloc(2*xxn+1);
103*10986Srrh 					xxtbuff[0] = '"';
104*10986Srrh 					for (xxj = xxk = 1; xxj < xxn-1; ++xxj)
105*10986Srrh 						{
106*10986Srrh 						if (xxp[xxj] == '\'' && xxp[++xxj] == '\'')
107*10986Srrh 							xxtbuff[xxk++] = '\'';
108*10986Srrh 						else if (xxp[xxj] == '"')
109*10986Srrh 							{
110*10986Srrh 							xxtbuff[xxk++] = '"';
111*10986Srrh 							xxtbuff[xxk++] = '"';
112*10986Srrh 							}
113*10986Srrh 						else
114*10986Srrh 							xxtbuff[xxk++] = xxp[xxj];
115*10986Srrh 						}
116*10986Srrh 					xxtbuff[xxk++] = '"';
117*10986Srrh 					xxtbuff[xxk] = '\0';
118*10986Srrh 					free(xxp);
119*10986Srrh 					yylval = xxtbuff;
120*10986Srrh 					xxbp = -1;
121*10986Srrh 					return(xxstring);
122*10986Srrh 					}
123*10986Srrh 
124*10986Srrh ^\n		xxbp = -1;
125*10986Srrh \n		{xxbp = -1; if (newflag) {fixval(); return('\n'); }  }
126*10986Srrh {SP}		{fixval(); xxbp = -1; return(yytext[0]); }
127*10986Srrh 
128*10986Srrh %%
129*10986Srrh 
130*10986Srrh rdchar()
131*10986Srrh 	{
132*10986Srrh 	int c;
133*10986Srrh 	if (xxunbp >= 0)
134*10986Srrh 		return(xxunbuf[xxunbp--]);
135*10986Srrh 	c = getchar();
136*10986Srrh 	if (c == EOF) return('\0');
137*10986Srrh 	else return((char)c);
138*10986Srrh 	}
139*10986Srrh 
140*10986Srrh backup(c)
141*10986Srrh char c;
142*10986Srrh 	{
143*10986Srrh 	if (++xxunbp > xxunmax)
144*10986Srrh 		{
145*10986Srrh 		xxunbuf[xxunmax + 1] = '\0';
146*10986Srrh 		error("RATFOR beautifying; input backed up too far during lex:\n",
147*10986Srrh 			xxunbuf,"\n");
148*10986Srrh 		}
149*10986Srrh 	xxunbuf[xxunbp] = c;
150*10986Srrh 	}
151*10986Srrh 
152*10986Srrh nunput(c)
153*10986Srrh char c;
154*10986Srrh 	{
155*10986Srrh 	backup(c);
156*10986Srrh 	if (xxbp < 0) return;
157*10986Srrh 	if (c != xxbuf[xxbp])
158*10986Srrh 		{
159*10986Srrh 		xxbuf[xxbp + 1] = '\0';
160*10986Srrh 		error("RATFOR beautifying; lex call of nunput with wrong char:\n",
161*10986Srrh 			xxbuf,"\n");
162*10986Srrh 		}
163*10986Srrh 	for ( --xxbp; xxbp >= 0 && (xxbuf[xxbp] == ' ' || xxbuf[xxbp] == '\t'); --xxbp)
164*10986Srrh 		backup(xxbuf[xxbp]);
165*10986Srrh 	xxbuf[xxbp+1] = '\0';
166*10986Srrh 	}
167*10986Srrh 
168*10986Srrh ninput()
169*10986Srrh 	{
170*10986Srrh 	char c,d;
171*10986Srrh 	if (blflag) c = rdchar();
172*10986Srrh 	else
173*10986Srrh 		while ( (c = rdchar()) == ' ' || c == '\t')
174*10986Srrh 		addbuf(c);
175*10986Srrh 	if (c != '\n')
176*10986Srrh 		return(addbuf(c));
177*10986Srrh 	while ( (d = rdchar()) == ' ' || d == '\t');
178*10986Srrh 	if (d == '&')
179*10986Srrh 		return(ninput());
180*10986Srrh 	backup(d);
181*10986Srrh 	return(addbuf('\n'));
182*10986Srrh 	}
183*10986Srrh 
184*10986Srrh addbuf(c)
185*10986Srrh char c;
186*10986Srrh 	{
187*10986Srrh 	if (++xxbp > xxbpmax)
188*10986Srrh 		{
189*10986Srrh 		xxbuf[xxbpmax +1] = '\0';
190*10986Srrh 		error("RATFOR beautifying; buffer xxbuf too small for token beginning:\n",
191*10986Srrh 			xxbuf,"\n");
192*10986Srrh 		}
193*10986Srrh 	xxbuf[xxbp] = c;
194*10986Srrh 	xxbuf[xxbp + 1] = '\0';
195*10986Srrh 	return(c);
196*10986Srrh 	}
197*10986Srrh 
198*10986Srrh 
199*10986Srrh fixval()
200*10986Srrh 	{
201*10986Srrh 	int i, j, k;
202*10986Srrh 	for (j = 0; xxbuf[j] == ' ' || xxbuf[j] == '\t'; ++j);
203*10986Srrh 	for (k = j; xxbuf[k] != '\0'; ++k);
204*10986Srrh 	for (--k; k > j && xxbuf[k] == ' ' || xxbuf[k]  == '\t'; --k);
205*10986Srrh 	xxbuf[k+1] = '\0';
206*10986Srrh 	i = slength(&xxbuf[j]) + 1;
207*10986Srrh 	yylval = malloc(i);
208*10986Srrh 	str_copy(&xxbuf[j],yylval,i);
209*10986Srrh 	}
210*10986Srrh 
211*10986Srrh 
212*10986Srrh 
213*10986Srrh putback(str)
214*10986Srrh char *str;
215*10986Srrh 	{
216*10986Srrh 	int i;
217*10986Srrh 	for (i = 0; str[i] != '\0'; ++i);
218*10986Srrh 	for (--i; i >= 0; --i)
219*10986Srrh 		backup(str[i]);
220*10986Srrh 	}
221*10986Srrh 
222