Annotation of OpenXM_contrib2/asir2000/parse/lex.c, Revision 1.1.1.1
1.1 noro 1: /* $OpenXM: OpenXM/src/asir99/parse/lex.c,v 1.1.1.1 1999/11/10 08:12:34 noro Exp $ */
2: #include <ctype.h>
3: #include "ca.h"
4: #include "al.h"
5: #include "base.h"
6: #include "parse.h"
7: #if !defined(THINK_C)
8: #include <sys/types.h>
9: #include <sys/stat.h>
10: #endif
11: #include "y.tab.h"
12:
13: extern IN asir_infile;
14: extern struct oTKWD kwd[];
15:
16: int afternl();
17: int myatoi();
18: int aftercomment();
19:
20: extern int main_parser;
21: extern char *parse_strp;
22:
23: static int skipspace();
24: static int Getc();
25: static void Ungetc();
26: static void Gets();
27:
28: yylex()
29: {
30: #define yylvalp (&yylval)
31: register int c,c1;
32: register int *ptr;
33: char *cptr;
34: int d,i,j;
35: #if defined(__MWERKS__)
36: char nbuf[BUFSIZ],tbuf[BUFSIZ];
37: #else
38: char nbuf[BUFSIZ*10],tbuf[BUFSIZ];
39: #endif
40: N n,n1;
41: Q q;
42: Obj r;
43:
44: switch ( c = skipspace() ) {
45: case EOF :
46: asir_terminate(2); break;
47: case '0' :
48: while ( ( c = Getc() ) == '0' );
49: if ( c == '.' ) {
50: Ungetc(c); c = '0';
51: } else if ( c == 'x' ) {
52: for ( i = 0; i < 8; i++ )
53: nbuf[i] = '0';
54: for ( ; isalnum(c = Getc()); nbuf[i++] = c );
55: Ungetc(c); nbuf[i] = 0;
56: hexton(nbuf,&n1);
57: NTOQ(n1,1,q); r = (Obj)q;
58: yylvalp->p = (pointer)r;
59: return ( FORMULA );
60: } else if ( c == 'b' ) {
61: for ( i = 0; i < 32; i++ )
62: nbuf[i] = '0';
63: for ( ; isalnum(c = Getc()); nbuf[i++] = c );
64: Ungetc(c); nbuf[i] = 0;
65: binaryton(nbuf,&n1);
66: NTOQ(n1,1,q); r = (Obj)q;
67: yylvalp->p = (pointer)r;
68: return ( FORMULA );
69: } else if ( !isdigit(c) ) {
70: yylvalp->p = 0; Ungetc(c);
71: return ( FORMULA );
72: }
73: break;
74: case '\'' :
75: for ( i = 0; ; i++ ) {
76: c = Getc();
77: if ( c == '\'' )
78: break;
79: if ( c == '\\' )
80: c = Getc();
81: tbuf[i] = c;
82: }
83: tbuf[i] = 0;
84: cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf);
85: yylvalp->p = (pointer)cptr;
86: return LCASE; break;
87: case '"' :
88: #if 0
89: for ( i = 0; (nbuf[i] = Getc()) != '"'; i++ );
90: #endif
91: i = 0;
92: do {
93: c = Getc();
94: if ( c == '\\' ) {
95: c1 = Getc();
96: if ( c1 == 'n' )
97: c1 = '\n';
98: nbuf[i++] = c1;
99: } else
100: nbuf[i++] = c;
101: } while ( c != '"' );
102: nbuf[i-1] = 0;
103: cptr = (char *)MALLOC(strlen(nbuf)+1);
104: strcpy(cptr,nbuf); yylvalp->p = (pointer) cptr;
105: return ( STR ); break;
106: case '>': case '<': case '=': case '!':
107: if ( (c1 = Getc()) == '=' )
108: switch ( c ) {
109: case '>': yylvalp->i = (int)C_GE; break;
110: case '<': yylvalp->i = (int)C_LE; break;
111: case '=': yylvalp->i = (int)C_EQ; break;
112: case '!': yylvalp->i = (int)C_NE; break;
113: default: break;
114: }
115: else if ( (c == '<' && c1 == '<') || (c == '>' && c1 == '>') )
116: return c;
117: else {
118: Ungetc(c1);
119: switch ( c ) {
120: case '>': yylvalp->i = (int)C_GT; break;
121: case '<': yylvalp->i = (int)C_LT; break;
122: default: return c; break;
123: }
124: }
125: return CMP; break;
126: case '+': case '-': case '*': case '/': case '%': case '^':
127: case '|': case '&':
128: switch ( c ) {
129: case '+': yylvalp->p = (pointer)addfs; break;
130: case '-': yylvalp->p = (pointer)subfs; break;
131: case '*': yylvalp->p = (pointer)mulfs; break;
132: case '/': yylvalp->p = (pointer)divfs; break;
133: case '%': yylvalp->p = (pointer)remfs; break;
134: case '^': yylvalp->p = (pointer)pwrfs; break;
135: default: break;
136: }
137: if ( (c1 = Getc()) == c )
138: switch ( c ) {
139: case '+': case '-': return SELF; break;
140: case '|': return OR; break;
141: case '&': return AND; break;
142: default: Ungetc(c1); return c; break;
143: }
144: else if ( c1 == '=' )
145: return BOPASS;
146: else if ( (c == '-') && (c1 == '>') )
147: return POINT;
148: else {
149: Ungetc(c1); return c;
150: }
151: break;
152: default :
153: break;
154: }
155: if ( isdigit(c) ) {
156: for ( i = 0; i < DLENGTH; i++ )
157: nbuf[i] = '0';
158: for ( nbuf[i++] = c; isdigit(c = Getc()); nbuf[i++] = c);
159: if ( c == '.' ) {
160: double dbl;
161: Real real;
162: double atof();
163: extern int bigfloat;
164:
165: for ( nbuf[i++] = c; isdigit(c = Getc()); nbuf[i++] = c);
166: if ( c == 'e' ) {
167: nbuf[i++] = c;
168: if ( ((c = Getc()) == '+') || (c == '-') ) {
169: nbuf[i++] = c; c = Getc();
170: }
171: for ( ; isdigit(c); nbuf[i++] = c, c = Getc());
172: }
173: Ungetc(c); nbuf[i] = 0;
174: #if PARI
175: if ( !bigfloat ) {
176: dbl = (double)atof(nbuf+DLENGTH);
177: MKReal(dbl,real); r = (Obj)real;
178: } else
179: strtobf(nbuf,(BF *)&r);
180: #else
181: dbl = (double)atof(nbuf+DLENGTH);
182: MKReal(dbl,real); r = (Obj)real;
183: #endif
184: } else {
185: Ungetc(c);
186: i -= DLENGTH; d = (i%DLENGTH?i/DLENGTH+1:i/DLENGTH);
187: n = NALLOC(d); PL(n) = d;
188: for ( j = 0, ptr = BD(n); j < d; j++ ,i -= DLENGTH )
189: ptr[j] = myatoi(nbuf+i);
190: bnton(DBASE,n,&n1);
191: NTOQ(n1,1,q); r = (Obj)q;
192: /* optobj(&r); */
193: }
194: yylvalp->p = (pointer)r;
195: return ( FORMULA );
196: } else if ( isalpha(c) ) {
197: for ( i = 1, tbuf[0] = c; isalpha(c = Getc())||isdigit(c)||(c=='_'); i++ )
198: tbuf[i] = c;
199: tbuf[i] = 0; Ungetc(c);
200: if ( isupper(tbuf[0]) ) {
201: cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf);
202: yylvalp->p = (pointer)cptr;
203: return UCASE;
204: } else {
205: for ( i = 0; kwd[i].name && strcmp(tbuf,kwd[i].name); i++ );
206: if ( kwd[i].name ) {
207: yylvalp->i = asir_infile->ln;
208: return kwd[i].token;
209: } else {
210: cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf);
211: yylvalp->p = (pointer)cptr;
212: return LCASE;
213: }
214: }
215: } else if ( c == '@' ) {
216: if ( isdigit(c = Getc()) ) {
217: for ( i = 1, nbuf[0] = c; isdigit(c = Getc()); nbuf[i++] = c);
218: Ungetc(c); nbuf[i] = 0; yylvalp->i = atoi(nbuf);
219: return ANS;
220: } else if ( c == '@' ) {
221: yylvalp->i = MAX(0,APVS->n-1);
222: return ANS;
223: } else if ( c == '>' || c == '<' || c == '=' || c == '!' ) {
224: if ( (c1 = Getc()) == '=' )
225: switch ( c ) {
226: case '>': yylvalp->i = (int)L_GE; break;
227: case '<': yylvalp->i = (int)L_LE; break;
228: case '=': yylvalp->i = (int)L_EQ; break;
229: case '!': yylvalp->i = (int)L_NE; break;
230: default: break;
231: }
232: else {
233: Ungetc(c1);
234: switch ( c ) {
235: case '>': yylvalp->i = (int)L_GT; break;
236: case '<': yylvalp->i = (int)L_LT; break;
237: case '=': yylvalp->i = (int)L_EQ; break;
238: case '!': yylvalp->i = (int)L_NOT; return FOP_NOT; break;
239: default: break;
240: }
241: }
242: return LOP;
243: } else if ( c == '|' || c == '&' ) {
244: if ( (c1 = Getc()) != c )
245: Ungetc(c1);
246: switch ( c ) {
247: case '|': yylvalp->i = (int)L_OR;
248: return FOP_OR; break;
249: case '&': yylvalp->i = (int)L_AND;
250: return FOP_AND; break;
251: }
252: } else if ( isalpha(c) ) {
253: for ( i = 2, tbuf[0] = '@', tbuf[1] = c;
254: isalpha(c = Getc()); tbuf[i++] = c);
255: Ungetc(c); tbuf[i] = 0;
256: if ( !strcmp(tbuf,"@p") )
257: return GFPNGEN;
258: else if ( !strcmp(tbuf,"@i") ) {
259: extern pointer IU;
260:
261: yylvalp->p = IU;
262: return FORMULA;
263: } else if ( !strcmp(tbuf,"@true") ) {
264: yylvalp->p = F_TRUE;
265: return FORMULA;
266: } else if ( !strcmp(tbuf,"@false") ) {
267: yylvalp->p = F_FALSE;
268: return FORMULA;
269: } else if ( !strcmp(tbuf,"@impl") ) {
270: yylvalp->i = (int)L_IMPL;
271: return FOP_IMPL;
272: } else if ( !strcmp(tbuf,"@repl") ) {
273: yylvalp->i = (int)L_REPL;
274: return FOP_REPL;
275: } else if ( !strcmp(tbuf,"@equiv") ) {
276: yylvalp->i = (int)L_EQUIV;
277: return FOP_EQUIV;
278: } else {
279: cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf);
280: yylvalp->p = (pointer)cptr;
281: return LCASE;
282: }
283: } else {
284: Ungetc(c);
285: return GF2NGEN;
286: }
287: } else
288: return ( c );
289: }
290:
291: static int skipspace() {
292: int c,c1;
293:
294: for ( c = Getc(); ; )
295: switch ( c ) {
296: case ' ': case '\t':
297: c = Getc(); break;
298: case '\n':
299: c = afternl(); break;
300: case '/':
301: if ( (c1 = Getc()) == '*' )
302: c = aftercomment();
303: else {
304: Ungetc(c1); return c;
305: }
306: break;
307: default:
308: return c; break;
309: }
310: }
311:
312: int afternl() {
313: int c,ac,i,quote;
314: char *ptr;
315: char *av[BUFSIZ];
316: static int ilevel = 0;
317: char buf[BUFSIZ];
318:
319: if ( !ilevel )
320: asir_infile->ln++;
321: while ( (c = Getc()) == '#' ) {
322: Gets(buf);
323: for ( quote = 0, ptr = buf; *ptr; ptr++ )
324: if ( *ptr == '"' )
325: quote = quote ? 0 : 1;
326: else if ( quote && (*ptr == ' ') )
327: *ptr = '_';
328: stoarg(buf,&ac,av);
329: if ( ac == 3 )
330: if ( (i = atoi(av[2])) == 1 )
331: ilevel++;
332: else if ( i == 2 )
333: ilevel--;
334: if ( !ilevel )
335: asir_infile->ln = atoi(av[0]);
336: }
337: return c;
338: }
339:
340: int aftercomment() {
341: int c,c1;
342:
343: for ( c = Getc(); ; ) {
344: c1 = Getc();
345: if ( (c == '*') && (c1 == '/') )
346: return Getc();
347: else
348: c = c1;
349: }
350: }
351:
352: int myatoi(s)
353: char *s;
354: {
355: int i,r;
356: for ( i = 0, r = 0; i < DLENGTH; i++ ) r = r * 10 + ( s[i] - '0' );
357: return ( r );
358: }
359:
360: extern int ox_do_copy;
361:
362: void yyerror(s)
363: char *s;
364: {
365: if ( main_parser )
366: if ( ox_do_copy ) {
367: /* push errors to DebugStack */
368: } else {
369: if ( asir_infile->fp == stdin )
370: fprintf(stderr,"%s\n",s);
371: else
372: fprintf(stderr,"\"%s\", near line %d: %s\n",asir_infile->name,asir_infile->ln,s);
373: }
374: else
375: fprintf(stderr,"exprparse : %s\n",s);
376: }
377:
378: int echoback;
379:
380: extern int read_exec_file, do_fep, do_file;
381:
382: int readline_getc();
383: void readline_ungetc();
384: int Egetc();
385: void Eungetc();
386:
387: unsigned char encrypt_char(unsigned char);
388: unsigned char decrypt_char(unsigned char);
389:
390: int Egetc(fp)
391: FILE *fp;
392: {
393: int c;
394:
395: if ( fp ) {
396: c = getc(fp);
397: if ( c == EOF )
398: return c;
399: if ( asir_infile->encoded )
400: c = decrypt_char((unsigned char)c);
401: return c;
402: } else {
403: c = *parse_strp++;
404: if ( !c )
405: return EOF;
406: else
407: return c;
408: }
409: }
410:
411: void Eungetc(c,fp)
412: int c;
413: FILE *fp;
414: {
415: if ( fp ) {
416: if ( asir_infile->encoded )
417: c = (int)encrypt_char((unsigned char)c);
418: ungetc(c,fp);
419: } else
420: *--parse_strp = c;
421: }
422:
423: static int Getc() {
424: int c;
425:
426: if ( main_parser ) {
427: while ( 1 ) {
428: if ((c = Egetc(asir_infile->fp)) == EOF)
429: if ( NEXT(asir_infile) ) {
430: closecurrentinput();
431: c = Getc();
432: break;
433: } else if ( read_exec_file || do_file )
434: asir_terminate(2);
435: else {
436: if ( asir_infile->fp )
437: clearerr(asir_infile->fp);
438: }
439: else
440: break;
441: }
442: if ( echoback )
443: fputc(c,asir_out);
444: } else
445: c = *parse_strp++;
446: return ( c );
447: }
448:
449: static void Ungetc(c) {
450: if ( main_parser ) {
451: Eungetc(c,asir_infile->fp);
452: if ( echoback )
453: fputc('',asir_out);
454: } else
455: *--parse_strp = c;
456: }
457:
458: static void Gets(s)
459: char *s;
460: {
461: int c;
462:
463: while ( (c = Getc()) != '\n' )
464: *s++ = c;
465: *s = 0;
466: }
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>