![[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.46 ! noro 48: * $OpenXM: OpenXM_contrib2/asir2000/parse/lex.c,v 1.45 2010/04/16 07:13:42 noro 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.10 noro 57: #if defined(VISUAL)
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;
1.11 noro 77: extern int recv_intr;
1.1 noro 78:
1.2 noro 79: #define NBUFSIZ (BUFSIZ*10)
80: #define TBUFSIZ (BUFSIZ)
81:
82: #define REALLOC_NBUF \
83: if ( i >= nbufsize ) {\
84: nbufsize += NBUFSIZ;\
85: if ( nbuf == nbuf0 ) {\
86: nbuf = (char *)MALLOC_ATOMIC(nbufsize);\
87: bcopy(nbuf0,nbuf,nbufsize-NBUFSIZ);\
88: } else\
89: nbuf = REALLOC(nbuf,nbufsize);\
90: }
91:
92: #define REALLOC_TBUF \
93: if ( i >= tbufsize ) {\
94: tbufsize += TBUFSIZ;\
95: if ( tbuf == tbuf0 ) {\
96: tbuf = (char *)MALLOC_ATOMIC(tbufsize);\
97: bcopy(tbuf0,tbuf,tbufsize-TBUFSIZ);\
98: } else\
99: tbuf = REALLOC(tbuf,tbufsize);\
100: }
101:
102: #define READ_ALNUM_NBUF \
103: while ( 1 ) {\
104: c = Getc();\
105: if ( isalnum(c) ) {\
106: REALLOC_NBUF nbuf[i++] = c;\
107: } else\
108: break;\
109: }
110:
111: #define READ_DIGIT_NBUF \
112: while ( 1 ) {\
113: c = Getc();\
114: if ( isdigit(c) ) {\
115: REALLOC_NBUF nbuf[i++] = c;\
116: } else\
117: break;\
118: }
119:
1.18 noro 120: int yylex()
1.1 noro 121: {
122: #define yylvalp (&yylval)
123: register int c,c1;
124: register int *ptr;
125: char *cptr;
126: int d,i,j;
1.2 noro 127: char nbuf0[NBUFSIZ],tbuf0[TBUFSIZ];
128: char *nbuf, *tbuf;
129: int nbufsize, tbufsize;
1.1 noro 130: N n,n1;
131: Q q;
132: Obj r;
1.20 kondoh 133: int floatingpoint = 0;
134: double dbl;
135: Real real;
136: double atof();
137: extern int bigfloat;
138:
1.1 noro 139:
1.2 noro 140: /* initialize buffer pointers */
141: nbuf = nbuf0; tbuf = tbuf0;
142: nbufsize = NBUFSIZ; tbufsize = TBUFSIZ;
143:
1.1 noro 144: switch ( c = skipspace() ) {
145: case EOF :
146: asir_terminate(2); break;
147: case '0' :
148: while ( ( c = Getc() ) == '0' );
149: if ( c == '.' ) {
150: Ungetc(c); c = '0';
1.21 noro 151: } else if ( c == 'x' || c == 'X' ) {
1.1 noro 152: for ( i = 0; i < 8; i++ )
153: nbuf[i] = '0';
1.2 noro 154: READ_ALNUM_NBUF
155: Ungetc(c); REALLOC_NBUF nbuf[i] = 0;
1.1 noro 156: hexton(nbuf,&n1);
157: NTOQ(n1,1,q); r = (Obj)q;
158: yylvalp->p = (pointer)r;
159: return ( FORMULA );
1.21 noro 160: } else if ( c == 'b' || c == 'B' ) {
1.1 noro 161: for ( i = 0; i < 32; i++ )
162: nbuf[i] = '0';
1.2 noro 163: READ_ALNUM_NBUF
164: Ungetc(c); REALLOC_NBUF nbuf[i] = 0;
1.1 noro 165: binaryton(nbuf,&n1);
166: NTOQ(n1,1,q); r = (Obj)q;
167: yylvalp->p = (pointer)r;
168: return ( FORMULA );
169: } else if ( !isdigit(c) ) {
170: yylvalp->p = 0; Ungetc(c);
171: return ( FORMULA );
172: }
173: break;
174: case '\'' :
175: for ( i = 0; ; i++ ) {
176: c = Getc();
177: if ( c == '\'' )
178: break;
179: if ( c == '\\' )
180: c = Getc();
1.2 noro 181: REALLOC_TBUF tbuf[i] = c;
1.1 noro 182: }
1.2 noro 183: REALLOC_TBUF tbuf[i] = 0;
1.1 noro 184: cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf);
185: yylvalp->p = (pointer)cptr;
186: return LCASE; break;
187: case '"' :
188: i = 0;
189: do {
190: c = Getc();
191: if ( c == '\\' ) {
192: c1 = Getc();
1.27 ohara 193: if ( c1 == 'n' ) {
1.1 noro 194: c1 = '\n';
1.33 noro 195: }else if ( c1 == 'r' ) {
196: c1 = '\r';
1.27 ohara 197: }else if ( c1 == 't' ) {
198: c1 = '\t';
199: }else if ( isdigit(c1) ){
200: d = c1 - '0';
201: c1 = Getc();
202: if ( isdigit(c1) ) {
203: d = 8*d + (c1 - '0');
204: c1 = Getc();
205: if ( isdigit(c1) ) {
206: d = 8*d + (c1 - '0');
207: }else {
208: Ungetc(c1);
209: }
210: }else {
211: Ungetc(c1);
212: }
213: c1 = d;
214: }
1.2 noro 215: REALLOC_NBUF nbuf[i++] = c1;
216: } else {
217: REALLOC_NBUF nbuf[i++] = c;
218: }
1.1 noro 219: } while ( c != '"' );
1.2 noro 220: nbuf[i-1] = 0; /* REALLOC_NBUF is not necessary */
1.1 noro 221: cptr = (char *)MALLOC(strlen(nbuf)+1);
222: strcpy(cptr,nbuf); yylvalp->p = (pointer) cptr;
223: return ( STR ); break;
224: case '>': case '<': case '=': case '!':
225: if ( (c1 = Getc()) == '=' )
226: switch ( c ) {
227: case '>': yylvalp->i = (int)C_GE; break;
228: case '<': yylvalp->i = (int)C_LE; break;
229: case '=': yylvalp->i = (int)C_EQ; break;
230: case '!': yylvalp->i = (int)C_NE; break;
231: default: break;
232: }
233: else if ( (c == '<' && c1 == '<') || (c == '>' && c1 == '>') )
234: return c;
235: else {
236: Ungetc(c1);
237: switch ( c ) {
238: case '>': yylvalp->i = (int)C_GT; break;
239: case '<': yylvalp->i = (int)C_LT; break;
240: default: return c; break;
241: }
242: }
243: return CMP; break;
244: case '+': case '-': case '*': case '/': case '%': case '^':
245: case '|': case '&':
246: switch ( c ) {
247: case '+': yylvalp->p = (pointer)addfs; break;
248: case '-': yylvalp->p = (pointer)subfs; break;
249: case '*': yylvalp->p = (pointer)mulfs; break;
250: case '/': yylvalp->p = (pointer)divfs; break;
251: case '%': yylvalp->p = (pointer)remfs; break;
252: case '^': yylvalp->p = (pointer)pwrfs; break;
253: default: break;
254: }
255: if ( (c1 = Getc()) == c )
256: switch ( c ) {
257: case '+': case '-': return SELF; break;
258: case '|': return OR; break;
259: case '&': return AND; break;
260: default: Ungetc(c1); return c; break;
261: }
262: else if ( c1 == '=' )
263: return BOPASS;
264: else if ( (c == '-') && (c1 == '>') )
265: return POINT;
266: else {
267: Ungetc(c1); return c;
268: }
269: break;
270: default :
271: break;
272: }
273: if ( isdigit(c) ) {
274: for ( i = 0; i < DLENGTH; i++ )
275: nbuf[i] = '0';
1.2 noro 276: REALLOC_NBUF nbuf[i++] = c;
277: READ_DIGIT_NBUF
1.1 noro 278: if ( c == '.' ) {
1.20 kondoh 279: floatingpoint = 1;
1.1 noro 280:
1.2 noro 281: REALLOC_NBUF nbuf[i++] = c;
282: READ_DIGIT_NBUF
1.21 noro 283: if ( c == 'e' || c == 'E' ) {
1.2 noro 284: REALLOC_NBUF nbuf[i++] = c;
285: c = Getc();
286: if ( (c == '+') || (c == '-') ) {
287: REALLOC_NBUF nbuf[i++] = c;
288: } else
289: Ungetc(c);
290: READ_DIGIT_NBUF
1.1 noro 291: }
1.21 noro 292: } else if ( c == 'e' || c == 'E' ) {
1.20 kondoh 293: floatingpoint = 1;
294: REALLOC_NBUF nbuf[i++] = c;
295: c = Getc();
296: if ( (c == '+') || (c == '-') ) {
297: REALLOC_NBUF nbuf[i++] = c;
298: } else
299: Ungetc(c);
300: READ_DIGIT_NBUF
301: }
302: if ( floatingpoint ) {
1.2 noro 303: Ungetc(c); REALLOC_NBUF nbuf[i] = 0;
1.22 ohara 304: #if defined(PARI)
1.1 noro 305: if ( !bigfloat ) {
306: dbl = (double)atof(nbuf+DLENGTH);
307: MKReal(dbl,real); r = (Obj)real;
308: } else
309: strtobf(nbuf,(BF *)&r);
310: #else
311: dbl = (double)atof(nbuf+DLENGTH);
312: MKReal(dbl,real); r = (Obj)real;
313: #endif
314: } else {
315: Ungetc(c);
316: i -= DLENGTH; d = (i%DLENGTH?i/DLENGTH+1:i/DLENGTH);
317: n = NALLOC(d); PL(n) = d;
318: for ( j = 0, ptr = BD(n); j < d; j++ ,i -= DLENGTH )
319: ptr[j] = myatoi(nbuf+i);
320: bnton(DBASE,n,&n1);
321: NTOQ(n1,1,q); r = (Obj)q;
322: /* optobj(&r); */
323: }
324: yylvalp->p = (pointer)r;
325: return ( FORMULA );
1.36 noro 326: } else if ( isalpha(c) || c == ':' || c == '_' ) {
1.25 noro 327: if ( c == ':' ) {
328: c1 = Getc();
329: if ( c1 != ':' ) {
330: Ungetc(c1);
331: return c;
332: }
333: c1 = Getc();
334: if ( !isalpha(c1) ) {
335: Ungetc(c1);
336: return COLONCOLON;
337: }
338: i = 0;
339: tbuf[i++] = ':';
340: tbuf[i++] = ':';
341: tbuf[i++] = c1;
342: } else {
343: i = 0;
344: tbuf[i++] = c;
345: }
1.2 noro 346: while ( 1 ) {
347: c = Getc();
1.24 noro 348: if ( isalpha(c)||isdigit(c)||(c=='_')||(c=='.') ) {
1.2 noro 349: REALLOC_TBUF tbuf[i++] = c;
350: } else
351: break;
352: }
353: REALLOC_TBUF tbuf[i] = 0; Ungetc(c);
1.36 noro 354: if ( isupper(tbuf[0]) || (tbuf[0] == '_' && isupper(tbuf[1])) ) {
1.1 noro 355: cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf);
356: yylvalp->p = (pointer)cptr;
357: return UCASE;
358: } else {
359: for ( i = 0; kwd[i].name && strcmp(tbuf,kwd[i].name); i++ );
360: if ( kwd[i].name ) {
361: yylvalp->i = asir_infile->ln;
362: return kwd[i].token;
363: } else {
364: cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf);
365: yylvalp->p = (pointer)cptr;
366: return LCASE;
367: }
368: }
369: } else if ( c == '@' ) {
370: if ( isdigit(c = Getc()) ) {
1.2 noro 371: i = 0;
372: nbuf[i++] = c;
373: READ_DIGIT_NBUF
374: Ungetc(c); REALLOC_NBUF nbuf[i] = 0;
375: yylvalp->i = atoi(nbuf);
1.1 noro 376: return ANS;
377: } else if ( c == '@' ) {
378: yylvalp->i = MAX(0,APVS->n-1);
379: return ANS;
380: } else if ( c == '>' || c == '<' || c == '=' || c == '!' ) {
381: if ( (c1 = Getc()) == '=' )
382: switch ( c ) {
383: case '>': yylvalp->i = (int)L_GE; break;
384: case '<': yylvalp->i = (int)L_LE; break;
385: case '=': yylvalp->i = (int)L_EQ; break;
386: case '!': yylvalp->i = (int)L_NE; break;
387: default: break;
388: }
389: else {
390: Ungetc(c1);
391: switch ( c ) {
392: case '>': yylvalp->i = (int)L_GT; break;
393: case '<': yylvalp->i = (int)L_LT; break;
394: case '=': yylvalp->i = (int)L_EQ; break;
395: case '!': yylvalp->i = (int)L_NOT; return FOP_NOT; break;
396: default: break;
397: }
398: }
399: return LOP;
400: } else if ( c == '|' || c == '&' ) {
401: if ( (c1 = Getc()) != c )
402: Ungetc(c1);
403: switch ( c ) {
404: case '|': yylvalp->i = (int)L_OR;
405: return FOP_OR; break;
406: case '&': yylvalp->i = (int)L_AND;
407: return FOP_AND; break;
408: }
409: } else if ( isalpha(c) ) {
1.2 noro 410: i = 0;
411: tbuf[i++] = '@';
412: tbuf[i++] = c;
413: while ( 1 ) {
414: c = Getc();
415: if ( isalpha(c) ) {
416: REALLOC_TBUF tbuf[i++] = c;
417: } else
418: break;
419: }
420: Ungetc(c); REALLOC_TBUF tbuf[i] = 0;
1.1 noro 421: if ( !strcmp(tbuf,"@p") )
422: return GFPNGEN;
1.17 noro 423: else if ( !strcmp(tbuf,"@s") )
424: return GFSNGEN;
1.37 noro 425: else if ( !strcmp(tbuf,"@void") ) {
426: yylvalp->p = VOIDobj;
427: return FORMULA;
428: } else if ( !strcmp(tbuf,"@i") ) {
1.1 noro 429: extern pointer IU;
430:
431: yylvalp->p = IU;
432: return FORMULA;
433: } else if ( !strcmp(tbuf,"@true") ) {
434: yylvalp->p = F_TRUE;
435: return FORMULA;
436: } else if ( !strcmp(tbuf,"@false") ) {
437: yylvalp->p = F_FALSE;
438: return FORMULA;
439: } else if ( !strcmp(tbuf,"@impl") ) {
440: yylvalp->i = (int)L_IMPL;
441: return FOP_IMPL;
442: } else if ( !strcmp(tbuf,"@repl") ) {
443: yylvalp->i = (int)L_REPL;
444: return FOP_REPL;
445: } else if ( !strcmp(tbuf,"@equiv") ) {
446: yylvalp->i = (int)L_EQUIV;
447: return FOP_EQUIV;
1.29 noro 448: } else if ( !strcmp(tbuf,"@grlex") ) {
449: yylvalp->p = Symbol_grlex;
450: return FORMULA;
451: } else if ( !strcmp(tbuf,"@glex") ) {
452: yylvalp->p = Symbol_glex;
453: return FORMULA;
454: } else if ( !strcmp(tbuf,"@lex") ) {
455: yylvalp->p = Symbol_lex;
456: return FORMULA;
1.1 noro 457: } else {
458: cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf);
459: yylvalp->p = (pointer)cptr;
460: return LCASE;
461: }
462: } else {
463: Ungetc(c);
464: return GF2NGEN;
465: }
466: } else
467: return ( c );
1.6 noro 468: }
469:
470: void purge_stdin()
471: {
1.43 ohara 472: #if defined(__FreeBSD__) || defined(__DARWIN__)
1.6 noro 473: fpurge(stdin);
474: #elif defined(linux)
475: stdin->_IO_read_end = stdin->_IO_read_base;
476: stdin->_IO_read_ptr = stdin->_IO_read_base;
1.10 noro 477: #elif defined(VISUAL_LIB)
1.18 noro 478: void w_purge_stdin();
479:
1.10 noro 480: w_purge_stdin();
1.16 noro 481: #elif defined(sparc) || defined(__alpha) || defined(__SVR4) || defined(mips) || defined(VISUAL) || defined(_IBMR2)
1.6 noro 482: stdin->_ptr = stdin->_base; stdin->_cnt = 0;
1.28 ohara 483: #elif (defined(__MACH__) && defined(__ppc__)) || defined(__CYGWIN__) || defined(__FreeBSD__) || defined(__INTERIX)
1.15 noro 484: stdin->_r = 0; stdin->_p = stdin->_bf._base;
1.6 noro 485: #else
486: --->FIXIT
487: #endif
1.1 noro 488: }
1.32 noro 489:
1.1 noro 490: static int skipspace() {
491: int c,c1;
492:
493: for ( c = Getc(); ; )
494: switch ( c ) {
1.14 noro 495: case ' ': case '\t': case '\r':
1.1 noro 496: c = Getc(); break;
497: case '\n':
1.32 noro 498: c = afternl(); break;
1.1 noro 499: case '/':
500: if ( (c1 = Getc()) == '*' )
501: c = aftercomment();
502: else {
503: Ungetc(c1); return c;
504: }
505: break;
506: default:
507: return c; break;
508: }
509: }
510:
511: int afternl() {
512: int c,ac,i,quote;
1.46 ! noro 513: char *ptr,*buf0;
1.1 noro 514: char *av[BUFSIZ];
515: static int ilevel = 0;
516: char buf[BUFSIZ];
517:
518: if ( !ilevel )
519: asir_infile->ln++;
520: while ( (c = Getc()) == '#' ) {
521: Gets(buf);
1.46 ! noro 522: #define LINE "line"
! 523: if ( !strncmp(buf,LINE,strlen(LINE)) ) buf0 = buf+strlen(LINE);
! 524: else buf0 = buf;
! 525: for ( quote = 0, ptr = buf0; *ptr; ptr++ )
1.1 noro 526: if ( *ptr == '"' )
527: quote = quote ? 0 : 1;
528: else if ( quote && (*ptr == ' ') )
529: *ptr = '_';
1.46 ! noro 530: stoarg(buf0,&ac,av);
1.1 noro 531: if ( ac == 3 )
532: if ( (i = atoi(av[2])) == 1 )
533: ilevel++;
534: else if ( i == 2 )
535: ilevel--;
536: if ( !ilevel )
537: asir_infile->ln = atoi(av[0]);
538: }
539: return c;
540: }
541:
542: int aftercomment() {
543: int c,c1;
544:
545: for ( c = Getc(); ; ) {
1.39 noro 546: if ( c == '\n' ) asir_infile->ln++;
1.1 noro 547: c1 = Getc();
548: if ( (c == '*') && (c1 == '/') )
549: return Getc();
550: else
551: c = c1;
552: }
553: }
554:
1.18 noro 555: int myatoi(char *s)
1.1 noro 556: {
557: int i,r;
558: for ( i = 0, r = 0; i < DLENGTH; i++ ) r = r * 10 + ( s[i] - '0' );
559: return ( r );
560: }
561:
562: extern int ox_do_copy;
1.30 noro 563: extern int I_am_server;
564: extern JMP_BUF main_env;
1.40 noro 565: extern int at_root;
566: extern LIST LastStackTrace;
1.41 noro 567: extern char *CUR_FUNC;
1.1 noro 568:
1.18 noro 569: void yyerror(char *s)
1.1 noro 570: {
1.41 noro 571: STRING fname,name,kwd;
1.42 noro 572: USINT u;
1.40 noro 573: NODE t;
574: LIST l,l2;
575:
1.31 noro 576: if ( main_parser ) {
577: if ( ox_do_copy ) {
1.1 noro 578: /* push errors to DebugStack */
579: } else {
580: if ( asir_infile->fp == stdin )
581: fprintf(stderr,"%s\n",s);
582: else
583: fprintf(stderr,"\"%s\", near line %d: %s\n",asir_infile->name,asir_infile->ln,s);
584: }
1.31 noro 585: if ( I_am_server ) {
1.40 noro 586: if ( NEXT(asir_infile) ) {
587: /* error in a file; record the position */
1.41 noro 588: MKSTR(fname,asir_infile->name);
589: if ( CPVS == GPVS )
590: MKSTR(name,"");
591: else
592: MKSTR(name,CUR_FUNC);
1.42 noro 593: MKUSINT(u,asir_infile->ln);
594: t = mknode(3,fname,name,u); MKLIST(l,t);
1.40 noro 595: /* line number at the toplevel */
1.42 noro 596: MKSTR(fname,"toplevel"); MKUSINT(u,at_root);
597: t = mknode(2,fname,u); MKLIST(l2,t);
1.40 noro 598: t = mknode(2,l2,l);
599: } else {
1.42 noro 600: MKSTR(fname,"toplevel"); MKUSINT(u,asir_infile->ln);
601: t = mknode(2,fname,u); MKLIST(l,t);
1.40 noro 602: t = mknode(1,l);
603: }
1.41 noro 604: MKLIST(l,t);
605: MKSTR(kwd,"asir_where"); t = mknode(2,kwd,l);
1.40 noro 606: MKLIST(LastStackTrace,t);
1.31 noro 607: set_lasterror(s);
608: LONGJMP(main_env,1);
609: }
610: } else
1.1 noro 611: fprintf(stderr,"exprparse : %s\n",s);
612: }
613:
614: int echoback;
615:
1.38 noro 616: extern int do_fep, do_file;
1.1 noro 617:
618: unsigned char encrypt_char(unsigned char);
619: unsigned char decrypt_char(unsigned char);
620:
1.18 noro 621: int Egetc(FILE *fp)
1.1 noro 622: {
623: int c;
624:
625: if ( fp ) {
1.23 noro 626: #if FEP
1.13 noro 627: if ( do_fep && isatty(fileno(fp)) )
628: c = readline_getc();
629: else
630: #endif
631: c = getc(fp);
1.11 noro 632: #if defined(VISUAL)
633: if ( recv_intr ) {
634: #include <signal.h>
635: if ( recv_intr == 1 ) {
636: recv_intr = 0;
637: int_handler(SIGINT);
638: } else {
639: recv_intr = 0;
640: ox_usr1_handler(0);
641: }
642: }
643: #endif
1.1 noro 644: if ( c == EOF )
645: return c;
646: if ( asir_infile->encoded )
647: c = decrypt_char((unsigned char)c);
648: return c;
1.38 noro 649: } else {
1.1 noro 650: c = *parse_strp++;
651: if ( !c )
652: return EOF;
653: else
654: return c;
655: }
656: }
657:
1.18 noro 658: void Eungetc(int c,FILE *fp)
1.1 noro 659: {
660: if ( fp ) {
661: if ( asir_infile->encoded )
662: c = (int)encrypt_char((unsigned char)c);
1.23 noro 663: #if FEP
1.13 noro 664: if ( do_fep && isatty(fileno(fp)) )
665: readline_ungetc();
666: else
667: #endif
668: ungetc(c,fp);
1.1 noro 669: } else
670: *--parse_strp = c;
671: }
672:
673: static int Getc() {
674: int c;
675:
676: if ( main_parser ) {
677: while ( 1 ) {
678: if ((c = Egetc(asir_infile->fp)) == EOF)
679: if ( NEXT(asir_infile) ) {
680: closecurrentinput();
1.9 noro 681: /* if the input is the top level, generate error */
682: if ( !NEXT(asir_infile) )
683: error("end-of-file detected during parsing");
684: else
685: c = Getc();
1.1 noro 686: break;
1.45 noro 687: } else if ( asir_infile->fp || do_file ) {
1.1 noro 688: if ( asir_infile->fp )
689: clearerr(asir_infile->fp);
1.45 noro 690: asir_terminate(2);
691: } else {
692: error("end-of-line detected during parsing");
1.1 noro 693: }
694: else
695: break;
696: }
697: if ( echoback )
698: fputc(c,asir_out);
699: } else
700: c = *parse_strp++;
701: return ( c );
702: }
703:
1.18 noro 704: static void Ungetc(int c) {
1.1 noro 705: if ( main_parser ) {
706: Eungetc(c,asir_infile->fp);
707: if ( echoback )
708: fputc('',asir_out);
709: } else
710: *--parse_strp = c;
711: }
712:
1.18 noro 713: static void Gets(char *s)
1.1 noro 714: {
715: int c;
716:
717: while ( (c = Getc()) != '\n' )
718: *s++ = c;
719: *s = 0;
720: }
1.12 saito 721:
1.23 noro 722: #if FEP
1.12 saito 723:
724: static char *readline_line;
725: static int readline_nc,readline_index;
726: char *readline_console();
727:
728: int readline_getc()
729: {
730: char buf[BUFSIZ];
731:
732: if ( !readline_nc ) {
733: if ( readline_line )
734: free(readline_line);
735: sprompt(buf);
736: readline_line = readline_console(buf);
737: readline_nc = strlen(readline_line);
738: readline_index = 0;
739: }
740: readline_nc--;
741: return readline_line[readline_index++];
742: }
743:
744: void readline_ungetc()
745: {
746: readline_nc++; readline_index--;
747: }
748:
1.18 noro 749: char *readline_console(char *prompt)
1.12 saito 750: {
751: char *line;
752: int exp_result;
753: char *expansion;
754:
755: while ( 1 ) {
756: line = (char *)readline(prompt);
757: if ( line && *line ) {
758: using_history();
759: exp_result = history_expand(line,&expansion);
760: if ( !exp_result ) {
761: free(expansion);
1.35 noro 762: for ( ; isspace((unsigned char)*line); line++ );
1.12 saito 763: add_history(line);
764: break;
765: } else if ( exp_result > 0 ) {
766: free(line);
767: line = expansion;
768: break;
769: }
770: }
771: }
772: return line;
773: }
774: #endif