![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to lex.c CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib2 / asir2000 / parse|
Return to lex.c CVS log | Up to [local] / OpenXM_contrib2 / asir2000 / parse |
1.4 noro 1: /*
2: * Copyright (c) 1994-2000 FUJITSU LABORATORIES LIMITED
3: * All rights reserved.
4: *
5: * FUJITSU LABORATORIES LIMITED ("FLL") hereby grants you a limited,
6: * non-exclusive and royalty-free license to use, copy, modify and
7: * redistribute, solely for non-commercial and non-profit purposes, the
8: * computer program, "Risa/Asir" ("SOFTWARE"), subject to the terms and
9: * conditions of this Agreement. For the avoidance of doubt, you acquire
10: * only a limited right to use the SOFTWARE hereunder, and FLL or any
11: * third party developer retains all rights, including but not limited to
12: * copyrights, in and to the SOFTWARE.
13: *
14: * (1) FLL does not grant you a license in any way for commercial
15: * purposes. You may use the SOFTWARE only for non-commercial and
16: * non-profit purposes only, such as academic, research and internal
17: * business use.
18: * (2) The SOFTWARE is protected by the Copyright Law of Japan and
19: * international copyright treaties. If you make copies of the SOFTWARE,
20: * with or without modification, as permitted hereunder, you shall affix
21: * to all such copies of the SOFTWARE the above copyright notice.
22: * (3) An explicit reference to this SOFTWARE and its copyright owner
23: * shall be made on your publication or presentation in any form of the
24: * results obtained by use of the SOFTWARE.
25: * (4) In the event that you modify the SOFTWARE, you shall notify FLL by
1.5 noro 26: * e-mail at risa-admin@sec.flab.fujitsu.co.jp of the detailed specification
1.4 noro 27: * for such modification or the source code of the modified part of the
28: * SOFTWARE.
29: *
30: * THE SOFTWARE IS PROVIDED AS IS WITHOUT ANY WARRANTY OF ANY KIND. FLL
31: * MAKES ABSOLUTELY NO WARRANTIES, EXPRESSED, IMPLIED OR STATUTORY, AND
32: * EXPRESSLY DISCLAIMS ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS
33: * FOR A PARTICULAR PURPOSE OR NONINFRINGEMENT OF THIRD PARTIES'
34: * RIGHTS. NO FLL DEALER, AGENT, EMPLOYEES IS AUTHORIZED TO MAKE ANY
35: * MODIFICATIONS, EXTENSIONS, OR ADDITIONS TO THIS WARRANTY.
36: * UNDER NO CIRCUMSTANCES AND UNDER NO LEGAL THEORY, TORT, CONTRACT,
37: * OR OTHERWISE, SHALL FLL BE LIABLE TO YOU OR ANY OTHER PERSON FOR ANY
38: * DIRECT, INDIRECT, SPECIAL, INCIDENTAL, PUNITIVE OR CONSEQUENTIAL
39: * DAMAGES OF ANY CHARACTER, INCLUDING, WITHOUT LIMITATION, DAMAGES
40: * ARISING OUT OF OR RELATING TO THE SOFTWARE OR THIS AGREEMENT, DAMAGES
41: * FOR LOSS OF GOODWILL, WORK STOPPAGE, OR LOSS OF DATA, OR FOR ANY
42: * DAMAGES, EVEN IF FLL SHALL HAVE BEEN INFORMED OF THE POSSIBILITY OF
43: * SUCH DAMAGES, OR FOR ANY CLAIM BY ANY OTHER PARTY. EVEN IF A PART
44: * OF THE SOFTWARE HAS BEEN DEVELOPED BY A THIRD PARTY, THE THIRD PARTY
45: * DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE,
46: * PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE.
47: *
1.51 ! ohara 48: * $OpenXM: OpenXM_contrib2/asir2000/parse/lex.c,v 1.50 2015/08/14 13:51:56 fujimoto Exp $
1.4 noro 49: */
1.1 noro 50: #include <ctype.h>
51: #include "ca.h"
52: #include "al.h"
53: #include "base.h"
54: #include "parse.h"
55: #include <sys/types.h>
56: #include <sys/stat.h>
1.50 fujimoto 57: #if defined(VISUAL) || defined(__MINGW32__)
1.10 noro 58: #include "ytab.h"
59: #else
1.1 noro 60: #include "y.tab.h"
1.10 noro 61: #endif
1.44 saito 62: #if FEP
63: #include <readline/readline.h>
64: #endif
1.1 noro 65:
1.18 noro 66: static int Getc();
67: static void Ungetc(int c);
68: static void Gets(char *s);
69: static int skipspace();
70:
71: extern INFILE asir_infile;
1.1 noro 72: extern struct oTKWD kwd[];
1.37 noro 73: extern Obj VOIDobj;
1.1 noro 74:
75: extern int main_parser;
76: extern char *parse_strp;
77:
1.2 noro 78: #define NBUFSIZ (BUFSIZ*10)
79: #define TBUFSIZ (BUFSIZ)
80:
81: #define REALLOC_NBUF \
82: if ( i >= nbufsize ) {\
83: nbufsize += NBUFSIZ;\
84: if ( nbuf == nbuf0 ) {\
85: nbuf = (char *)MALLOC_ATOMIC(nbufsize);\
86: bcopy(nbuf0,nbuf,nbufsize-NBUFSIZ);\
87: } else\
88: nbuf = REALLOC(nbuf,nbufsize);\
89: }
90:
91: #define REALLOC_TBUF \
92: if ( i >= tbufsize ) {\
93: tbufsize += TBUFSIZ;\
94: if ( tbuf == tbuf0 ) {\
95: tbuf = (char *)MALLOC_ATOMIC(tbufsize);\
96: bcopy(tbuf0,tbuf,tbufsize-TBUFSIZ);\
97: } else\
98: tbuf = REALLOC(tbuf,tbufsize);\
99: }
100:
101: #define READ_ALNUM_NBUF \
102: while ( 1 ) {\
103: c = Getc();\
104: if ( isalnum(c) ) {\
105: REALLOC_NBUF nbuf[i++] = c;\
106: } else\
107: break;\
108: }
109:
110: #define READ_DIGIT_NBUF \
111: while ( 1 ) {\
112: c = Getc();\
113: if ( isdigit(c) ) {\
114: REALLOC_NBUF nbuf[i++] = c;\
115: } else\
116: break;\
117: }
118:
1.18 noro 119: int yylex()
1.1 noro 120: {
121: #define yylvalp (&yylval)
122: register int c,c1;
123: register int *ptr;
124: char *cptr;
125: int d,i,j;
1.2 noro 126: char nbuf0[NBUFSIZ],tbuf0[TBUFSIZ];
127: char *nbuf, *tbuf;
128: int nbufsize, tbufsize;
1.1 noro 129: N n,n1;
130: Q q;
131: Obj r;
1.20 kondoh 132: int floatingpoint = 0;
133: double dbl;
134: Real real;
135: double atof();
136: extern int bigfloat;
137:
1.1 noro 138:
1.2 noro 139: /* initialize buffer pointers */
140: nbuf = nbuf0; tbuf = tbuf0;
141: nbufsize = NBUFSIZ; tbufsize = TBUFSIZ;
142:
1.1 noro 143: switch ( c = skipspace() ) {
144: case EOF :
145: asir_terminate(2); break;
146: case '0' :
147: while ( ( c = Getc() ) == '0' );
148: if ( c == '.' ) {
149: Ungetc(c); c = '0';
1.21 noro 150: } else if ( c == 'x' || c == 'X' ) {
1.1 noro 151: for ( i = 0; i < 8; i++ )
152: nbuf[i] = '0';
1.2 noro 153: READ_ALNUM_NBUF
154: Ungetc(c); REALLOC_NBUF nbuf[i] = 0;
1.1 noro 155: hexton(nbuf,&n1);
156: NTOQ(n1,1,q); r = (Obj)q;
157: yylvalp->p = (pointer)r;
158: return ( FORMULA );
1.21 noro 159: } else if ( c == 'b' || c == 'B' ) {
1.1 noro 160: for ( i = 0; i < 32; i++ )
161: nbuf[i] = '0';
1.2 noro 162: READ_ALNUM_NBUF
163: Ungetc(c); REALLOC_NBUF nbuf[i] = 0;
1.1 noro 164: binaryton(nbuf,&n1);
165: NTOQ(n1,1,q); r = (Obj)q;
166: yylvalp->p = (pointer)r;
167: return ( FORMULA );
168: } else if ( !isdigit(c) ) {
169: yylvalp->p = 0; Ungetc(c);
170: return ( FORMULA );
171: }
172: break;
173: case '\'' :
174: for ( i = 0; ; i++ ) {
175: c = Getc();
176: if ( c == '\'' )
177: break;
178: if ( c == '\\' )
179: c = Getc();
1.2 noro 180: REALLOC_TBUF tbuf[i] = c;
1.1 noro 181: }
1.2 noro 182: REALLOC_TBUF tbuf[i] = 0;
1.1 noro 183: cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf);
184: yylvalp->p = (pointer)cptr;
185: return LCASE; break;
186: case '"' :
187: i = 0;
188: do {
189: c = Getc();
190: if ( c == '\\' ) {
191: c1 = Getc();
1.27 ohara 192: if ( c1 == 'n' ) {
1.1 noro 193: c1 = '\n';
1.33 noro 194: }else if ( c1 == 'r' ) {
195: c1 = '\r';
1.27 ohara 196: }else if ( c1 == 't' ) {
197: c1 = '\t';
198: }else if ( isdigit(c1) ){
199: d = c1 - '0';
200: c1 = Getc();
201: if ( isdigit(c1) ) {
202: d = 8*d + (c1 - '0');
203: c1 = Getc();
204: if ( isdigit(c1) ) {
205: d = 8*d + (c1 - '0');
206: }else {
207: Ungetc(c1);
208: }
209: }else {
210: Ungetc(c1);
211: }
212: c1 = d;
213: }
1.2 noro 214: REALLOC_NBUF nbuf[i++] = c1;
215: } else {
216: REALLOC_NBUF nbuf[i++] = c;
217: }
1.1 noro 218: } while ( c != '"' );
1.2 noro 219: nbuf[i-1] = 0; /* REALLOC_NBUF is not necessary */
1.1 noro 220: cptr = (char *)MALLOC(strlen(nbuf)+1);
221: strcpy(cptr,nbuf); yylvalp->p = (pointer) cptr;
222: return ( STR ); break;
223: case '>': case '<': case '=': case '!':
224: if ( (c1 = Getc()) == '=' )
225: switch ( c ) {
226: case '>': yylvalp->i = (int)C_GE; break;
227: case '<': yylvalp->i = (int)C_LE; break;
228: case '=': yylvalp->i = (int)C_EQ; break;
229: case '!': yylvalp->i = (int)C_NE; break;
230: default: break;
231: }
232: else if ( (c == '<' && c1 == '<') || (c == '>' && c1 == '>') )
233: return c;
234: else {
235: Ungetc(c1);
236: switch ( c ) {
237: case '>': yylvalp->i = (int)C_GT; break;
238: case '<': yylvalp->i = (int)C_LT; break;
239: default: return c; break;
240: }
241: }
242: return CMP; break;
243: case '+': case '-': case '*': case '/': case '%': case '^':
244: case '|': case '&':
245: switch ( c ) {
246: case '+': yylvalp->p = (pointer)addfs; break;
247: case '-': yylvalp->p = (pointer)subfs; break;
248: case '*': yylvalp->p = (pointer)mulfs; break;
249: case '/': yylvalp->p = (pointer)divfs; break;
250: case '%': yylvalp->p = (pointer)remfs; break;
251: case '^': yylvalp->p = (pointer)pwrfs; break;
252: default: break;
253: }
254: if ( (c1 = Getc()) == c )
255: switch ( c ) {
256: case '+': case '-': return SELF; break;
257: case '|': return OR; break;
258: case '&': return AND; break;
259: default: Ungetc(c1); return c; break;
260: }
261: else if ( c1 == '=' )
262: return BOPASS;
263: else if ( (c == '-') && (c1 == '>') )
264: return POINT;
265: else {
266: Ungetc(c1); return c;
267: }
268: break;
269: default :
270: break;
271: }
272: if ( isdigit(c) ) {
273: for ( i = 0; i < DLENGTH; i++ )
274: nbuf[i] = '0';
1.2 noro 275: REALLOC_NBUF nbuf[i++] = c;
276: READ_DIGIT_NBUF
1.1 noro 277: if ( c == '.' ) {
1.20 kondoh 278: floatingpoint = 1;
1.1 noro 279:
1.2 noro 280: REALLOC_NBUF nbuf[i++] = c;
281: READ_DIGIT_NBUF
1.21 noro 282: if ( c == 'e' || c == 'E' ) {
1.2 noro 283: REALLOC_NBUF nbuf[i++] = c;
284: c = Getc();
285: if ( (c == '+') || (c == '-') ) {
286: REALLOC_NBUF nbuf[i++] = c;
287: } else
288: Ungetc(c);
289: READ_DIGIT_NBUF
1.1 noro 290: }
1.21 noro 291: } else if ( c == 'e' || c == 'E' ) {
1.20 kondoh 292: floatingpoint = 1;
293: REALLOC_NBUF nbuf[i++] = c;
294: c = Getc();
295: if ( (c == '+') || (c == '-') ) {
296: REALLOC_NBUF nbuf[i++] = c;
297: } else
298: Ungetc(c);
299: READ_DIGIT_NBUF
300: }
301: if ( floatingpoint ) {
1.2 noro 302: Ungetc(c); REALLOC_NBUF nbuf[i] = 0;
1.1 noro 303: if ( !bigfloat ) {
304: dbl = (double)atof(nbuf+DLENGTH);
305: MKReal(dbl,real); r = (Obj)real;
306: } else
307: strtobf(nbuf,(BF *)&r);
308: } else {
309: Ungetc(c);
310: i -= DLENGTH; d = (i%DLENGTH?i/DLENGTH+1:i/DLENGTH);
311: n = NALLOC(d); PL(n) = d;
312: for ( j = 0, ptr = BD(n); j < d; j++ ,i -= DLENGTH )
313: ptr[j] = myatoi(nbuf+i);
314: bnton(DBASE,n,&n1);
315: NTOQ(n1,1,q); r = (Obj)q;
316: /* optobj(&r); */
317: }
318: yylvalp->p = (pointer)r;
319: return ( FORMULA );
1.36 noro 320: } else if ( isalpha(c) || c == ':' || c == '_' ) {
1.25 noro 321: if ( c == ':' ) {
322: c1 = Getc();
323: if ( c1 != ':' ) {
324: Ungetc(c1);
325: return c;
326: }
327: c1 = Getc();
328: if ( !isalpha(c1) ) {
329: Ungetc(c1);
330: return COLONCOLON;
331: }
332: i = 0;
333: tbuf[i++] = ':';
334: tbuf[i++] = ':';
335: tbuf[i++] = c1;
336: } else {
337: i = 0;
338: tbuf[i++] = c;
339: }
1.2 noro 340: while ( 1 ) {
341: c = Getc();
1.24 noro 342: if ( isalpha(c)||isdigit(c)||(c=='_')||(c=='.') ) {
1.2 noro 343: REALLOC_TBUF tbuf[i++] = c;
344: } else
345: break;
346: }
347: REALLOC_TBUF tbuf[i] = 0; Ungetc(c);
1.36 noro 348: if ( isupper(tbuf[0]) || (tbuf[0] == '_' && isupper(tbuf[1])) ) {
1.1 noro 349: cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf);
350: yylvalp->p = (pointer)cptr;
351: return UCASE;
352: } else {
353: for ( i = 0; kwd[i].name && strcmp(tbuf,kwd[i].name); i++ );
354: if ( kwd[i].name ) {
355: yylvalp->i = asir_infile->ln;
356: return kwd[i].token;
357: } else {
358: cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf);
359: yylvalp->p = (pointer)cptr;
360: return LCASE;
361: }
362: }
363: } else if ( c == '@' ) {
364: if ( isdigit(c = Getc()) ) {
1.2 noro 365: i = 0;
366: nbuf[i++] = c;
367: READ_DIGIT_NBUF
368: Ungetc(c); REALLOC_NBUF nbuf[i] = 0;
369: yylvalp->i = atoi(nbuf);
1.1 noro 370: return ANS;
371: } else if ( c == '@' ) {
372: yylvalp->i = MAX(0,APVS->n-1);
373: return ANS;
374: } else if ( c == '>' || c == '<' || c == '=' || c == '!' ) {
375: if ( (c1 = Getc()) == '=' )
376: switch ( c ) {
377: case '>': yylvalp->i = (int)L_GE; break;
378: case '<': yylvalp->i = (int)L_LE; break;
379: case '=': yylvalp->i = (int)L_EQ; break;
380: case '!': yylvalp->i = (int)L_NE; break;
381: default: break;
382: }
383: else {
384: Ungetc(c1);
385: switch ( c ) {
386: case '>': yylvalp->i = (int)L_GT; break;
387: case '<': yylvalp->i = (int)L_LT; break;
388: case '=': yylvalp->i = (int)L_EQ; break;
389: case '!': yylvalp->i = (int)L_NOT; return FOP_NOT; break;
390: default: break;
391: }
392: }
393: return LOP;
394: } else if ( c == '|' || c == '&' ) {
395: if ( (c1 = Getc()) != c )
396: Ungetc(c1);
397: switch ( c ) {
398: case '|': yylvalp->i = (int)L_OR;
399: return FOP_OR; break;
400: case '&': yylvalp->i = (int)L_AND;
401: return FOP_AND; break;
402: }
403: } else if ( isalpha(c) ) {
1.2 noro 404: i = 0;
405: tbuf[i++] = '@';
406: tbuf[i++] = c;
407: while ( 1 ) {
408: c = Getc();
409: if ( isalpha(c) ) {
410: REALLOC_TBUF tbuf[i++] = c;
411: } else
412: break;
413: }
414: Ungetc(c); REALLOC_TBUF tbuf[i] = 0;
1.1 noro 415: if ( !strcmp(tbuf,"@p") )
416: return GFPNGEN;
1.17 noro 417: else if ( !strcmp(tbuf,"@s") )
418: return GFSNGEN;
1.37 noro 419: else if ( !strcmp(tbuf,"@void") ) {
420: yylvalp->p = VOIDobj;
421: return FORMULA;
422: } else if ( !strcmp(tbuf,"@i") ) {
1.1 noro 423: extern pointer IU;
424:
425: yylvalp->p = IU;
426: return FORMULA;
427: } else if ( !strcmp(tbuf,"@true") ) {
428: yylvalp->p = F_TRUE;
429: return FORMULA;
430: } else if ( !strcmp(tbuf,"@false") ) {
431: yylvalp->p = F_FALSE;
432: return FORMULA;
433: } else if ( !strcmp(tbuf,"@impl") ) {
434: yylvalp->i = (int)L_IMPL;
435: return FOP_IMPL;
436: } else if ( !strcmp(tbuf,"@repl") ) {
437: yylvalp->i = (int)L_REPL;
438: return FOP_REPL;
439: } else if ( !strcmp(tbuf,"@equiv") ) {
440: yylvalp->i = (int)L_EQUIV;
441: return FOP_EQUIV;
1.29 noro 442: } else if ( !strcmp(tbuf,"@grlex") ) {
443: yylvalp->p = Symbol_grlex;
444: return FORMULA;
445: } else if ( !strcmp(tbuf,"@glex") ) {
446: yylvalp->p = Symbol_glex;
447: return FORMULA;
448: } else if ( !strcmp(tbuf,"@lex") ) {
449: yylvalp->p = Symbol_lex;
450: return FORMULA;
1.1 noro 451: } else {
452: cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf);
453: yylvalp->p = (pointer)cptr;
454: return LCASE;
455: }
456: } else {
457: Ungetc(c);
458: return GF2NGEN;
459: }
460: } else
461: return ( c );
1.6 noro 462: }
463:
464: void purge_stdin()
465: {
1.43 ohara 466: #if defined(__FreeBSD__) || defined(__DARWIN__)
1.6 noro 467: fpurge(stdin);
468: #elif defined(linux)
469: stdin->_IO_read_end = stdin->_IO_read_base;
470: stdin->_IO_read_ptr = stdin->_IO_read_base;
1.10 noro 471: #elif defined(VISUAL_LIB)
1.18 noro 472: void w_purge_stdin();
473:
1.10 noro 474: w_purge_stdin();
1.50 fujimoto 475: #elif defined(sparc) || defined(__alpha) || defined(__SVR4) || defined(mips) || defined(VISUAL) || defined(__MINGW32__) || defined(_IBMR2)
1.6 noro 476: stdin->_ptr = stdin->_base; stdin->_cnt = 0;
1.28 ohara 477: #elif (defined(__MACH__) && defined(__ppc__)) || defined(__CYGWIN__) || defined(__FreeBSD__) || defined(__INTERIX)
1.15 noro 478: stdin->_r = 0; stdin->_p = stdin->_bf._base;
1.6 noro 479: #else
480: --->FIXIT
481: #endif
1.1 noro 482: }
1.32 noro 483:
1.1 noro 484: static int skipspace() {
485: int c,c1;
486:
487: for ( c = Getc(); ; )
488: switch ( c ) {
1.14 noro 489: case ' ': case '\t': case '\r':
1.1 noro 490: c = Getc(); break;
491: case '\n':
1.32 noro 492: c = afternl(); break;
1.1 noro 493: case '/':
494: if ( (c1 = Getc()) == '*' )
495: c = aftercomment();
496: else {
497: Ungetc(c1); return c;
498: }
499: break;
500: default:
501: return c; break;
502: }
503: }
504:
505: int afternl() {
506: int c,ac,i,quote;
1.46 noro 507: char *ptr,*buf0;
1.1 noro 508: char *av[BUFSIZ];
509: static int ilevel = 0;
510: char buf[BUFSIZ];
511:
512: if ( !ilevel )
513: asir_infile->ln++;
514: while ( (c = Getc()) == '#' ) {
515: Gets(buf);
1.46 noro 516: #define LINE "line"
517: if ( !strncmp(buf,LINE,strlen(LINE)) ) buf0 = buf+strlen(LINE);
518: else buf0 = buf;
519: for ( quote = 0, ptr = buf0; *ptr; ptr++ )
1.1 noro 520: if ( *ptr == '"' )
521: quote = quote ? 0 : 1;
522: else if ( quote && (*ptr == ' ') )
523: *ptr = '_';
1.46 noro 524: stoarg(buf0,&ac,av);
1.1 noro 525: if ( ac == 3 )
526: if ( (i = atoi(av[2])) == 1 )
527: ilevel++;
528: else if ( i == 2 )
529: ilevel--;
530: if ( !ilevel )
531: asir_infile->ln = atoi(av[0]);
532: }
533: return c;
534: }
535:
536: int aftercomment() {
537: int c,c1;
538:
539: for ( c = Getc(); ; ) {
1.39 noro 540: if ( c == '\n' ) asir_infile->ln++;
1.1 noro 541: c1 = Getc();
542: if ( (c == '*') && (c1 == '/') )
543: return Getc();
544: else
545: c = c1;
546: }
547: }
548:
1.18 noro 549: int myatoi(char *s)
1.1 noro 550: {
551: int i,r;
552: for ( i = 0, r = 0; i < DLENGTH; i++ ) r = r * 10 + ( s[i] - '0' );
553: return ( r );
554: }
555:
556: extern int ox_do_copy;
1.30 noro 557: extern int I_am_server;
558: extern JMP_BUF main_env;
1.40 noro 559: extern int at_root;
560: extern LIST LastStackTrace;
1.41 noro 561: extern char *CUR_FUNC;
1.1 noro 562:
1.18 noro 563: void yyerror(char *s)
1.1 noro 564: {
1.41 noro 565: STRING fname,name,kwd;
1.42 noro 566: USINT u;
1.40 noro 567: NODE t;
568: LIST l,l2;
569:
1.31 noro 570: if ( main_parser ) {
571: if ( ox_do_copy ) {
1.1 noro 572: /* push errors to DebugStack */
573: } else {
574: if ( asir_infile->fp == stdin )
575: fprintf(stderr,"%s\n",s);
576: else
577: fprintf(stderr,"\"%s\", near line %d: %s\n",asir_infile->name,asir_infile->ln,s);
578: }
1.31 noro 579: if ( I_am_server ) {
1.40 noro 580: if ( NEXT(asir_infile) ) {
581: /* error in a file; record the position */
1.41 noro 582: MKSTR(fname,asir_infile->name);
583: if ( CPVS == GPVS )
584: MKSTR(name,"");
585: else
586: MKSTR(name,CUR_FUNC);
1.42 noro 587: MKUSINT(u,asir_infile->ln);
588: t = mknode(3,fname,name,u); MKLIST(l,t);
1.40 noro 589: /* line number at the toplevel */
1.42 noro 590: MKSTR(fname,"toplevel"); MKUSINT(u,at_root);
591: t = mknode(2,fname,u); MKLIST(l2,t);
1.40 noro 592: t = mknode(2,l2,l);
593: } else {
1.42 noro 594: MKSTR(fname,"toplevel"); MKUSINT(u,asir_infile->ln);
595: t = mknode(2,fname,u); MKLIST(l,t);
1.40 noro 596: t = mknode(1,l);
597: }
1.41 noro 598: MKLIST(l,t);
599: MKSTR(kwd,"asir_where"); t = mknode(2,kwd,l);
1.40 noro 600: MKLIST(LastStackTrace,t);
1.31 noro 601: set_lasterror(s);
602: LONGJMP(main_env,1);
603: }
604: } else
1.1 noro 605: fprintf(stderr,"exprparse : %s\n",s);
606: }
607:
608: int echoback;
609:
1.38 noro 610: extern int do_fep, do_file;
1.1 noro 611:
612: unsigned char encrypt_char(unsigned char);
613: unsigned char decrypt_char(unsigned char);
614:
1.18 noro 615: int Egetc(FILE *fp)
1.1 noro 616: {
617: int c;
618:
619: if ( fp ) {
1.23 noro 620: #if FEP
1.13 noro 621: if ( do_fep && isatty(fileno(fp)) )
622: c = readline_getc();
623: else
624: #endif
625: c = getc(fp);
1.50 fujimoto 626: #if defined(VISUAL) || defined(__MINGW32__)
1.51 ! ohara 627: check_intr();
1.11 noro 628: #endif
1.1 noro 629: if ( c == EOF )
630: return c;
631: if ( asir_infile->encoded )
632: c = decrypt_char((unsigned char)c);
633: return c;
1.38 noro 634: } else {
1.1 noro 635: c = *parse_strp++;
636: if ( !c )
637: return EOF;
638: else
639: return c;
640: }
641: }
642:
1.18 noro 643: void Eungetc(int c,FILE *fp)
1.1 noro 644: {
645: if ( fp ) {
646: if ( asir_infile->encoded )
647: c = (int)encrypt_char((unsigned char)c);
1.23 noro 648: #if FEP
1.13 noro 649: if ( do_fep && isatty(fileno(fp)) )
650: readline_ungetc();
651: else
652: #endif
653: ungetc(c,fp);
1.1 noro 654: } else
655: *--parse_strp = c;
656: }
657:
658: static int Getc() {
659: int c;
660:
661: if ( main_parser ) {
662: while ( 1 ) {
663: if ((c = Egetc(asir_infile->fp)) == EOF)
664: if ( NEXT(asir_infile) ) {
665: closecurrentinput();
1.9 noro 666: /* if the input is the top level, generate error */
667: if ( !NEXT(asir_infile) )
668: error("end-of-file detected during parsing");
669: else
670: c = Getc();
1.1 noro 671: break;
1.45 noro 672: } else if ( asir_infile->fp || do_file ) {
1.1 noro 673: if ( asir_infile->fp )
674: clearerr(asir_infile->fp);
1.45 noro 675: asir_terminate(2);
676: } else {
677: error("end-of-line detected during parsing");
1.1 noro 678: }
679: else
680: break;
681: }
682: if ( echoback )
683: fputc(c,asir_out);
684: } else
685: c = *parse_strp++;
686: return ( c );
687: }
688:
1.18 noro 689: static void Ungetc(int c) {
1.1 noro 690: if ( main_parser ) {
691: Eungetc(c,asir_infile->fp);
692: if ( echoback )
693: fputc('',asir_out);
694: } else
695: *--parse_strp = c;
696: }
697:
1.18 noro 698: static void Gets(char *s)
1.1 noro 699: {
700: int c;
701:
702: while ( (c = Getc()) != '\n' )
703: *s++ = c;
704: *s = 0;
705: }
1.12 saito 706:
1.23 noro 707: #if FEP
1.12 saito 708:
709: static char *readline_line;
710: static int readline_nc,readline_index;
711: char *readline_console();
712:
713: int readline_getc()
714: {
715: char buf[BUFSIZ];
716:
717: if ( !readline_nc ) {
718: if ( readline_line )
719: free(readline_line);
720: sprompt(buf);
721: readline_line = readline_console(buf);
722: readline_nc = strlen(readline_line);
723: readline_index = 0;
724: }
725: readline_nc--;
726: return readline_line[readline_index++];
727: }
728:
729: void readline_ungetc()
730: {
731: readline_nc++; readline_index--;
732: }
733:
1.18 noro 734: char *readline_console(char *prompt)
1.12 saito 735: {
736: char *line;
737: int exp_result;
738: char *expansion;
739:
740: while ( 1 ) {
741: line = (char *)readline(prompt);
742: if ( line && *line ) {
743: using_history();
744: exp_result = history_expand(line,&expansion);
745: if ( !exp_result ) {
746: free(expansion);
1.35 noro 747: for ( ; isspace((unsigned char)*line); line++ );
1.12 saito 748: add_history(line);
749: break;
750: } else if ( exp_result > 0 ) {
751: free(line);
752: line = expansion;
753: break;
754: }
755: }
756: }
757: return line;
758: }
759: #endif