Annotation of OpenXM_contrib2/asir2000/parse/lex.c, Revision 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>