version 1.6, 2000/11/13 01:48:13 |
version 1.54, 2018/09/09 08:13:42 |
|
|
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* DEVELOPER SHALL HAVE NO LIABILITY IN CONNECTION WITH THE USE, |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
* PERFORMANCE OR NON-PERFORMANCE OF THE SOFTWARE. |
* |
* |
* $OpenXM: OpenXM_contrib2/asir2000/parse/lex.c,v 1.5 2000/08/22 05:04:27 noro Exp $ |
* $OpenXM: OpenXM_contrib2/asir2000/parse/lex.c,v 1.53 2018/03/29 01:32:54 noro Exp $ |
*/ |
*/ |
#include <ctype.h> |
#include <ctype.h> |
#include "ca.h" |
#include "ca.h" |
#include "al.h" |
#include "al.h" |
#include "base.h" |
#include "base.h" |
#include "parse.h" |
#include "parse.h" |
#if !defined(THINK_C) |
|
#include <sys/types.h> |
#include <sys/types.h> |
#include <sys/stat.h> |
#include <sys/stat.h> |
#endif |
#if defined(VISUAL) || defined(__MINGW32__) |
|
#include "ytab.h" |
|
#else |
#include "y.tab.h" |
#include "y.tab.h" |
|
#endif |
|
#if FEP |
|
#include <readline/readline.h> |
|
#endif |
|
|
extern IN asir_infile; |
static int Getc(); |
|
static void Ungetc(int c); |
|
static void Gets(char *s); |
|
static int skipspace(); |
|
|
|
extern INFILE asir_infile; |
extern struct oTKWD kwd[]; |
extern struct oTKWD kwd[]; |
|
extern Obj VOIDobj; |
|
|
int afternl(); |
|
int myatoi(); |
|
int aftercomment(); |
|
|
|
extern int main_parser; |
extern int main_parser; |
extern char *parse_strp; |
extern char *parse_strp; |
|
|
static int skipspace(); |
|
static int Getc(); |
|
static void Ungetc(); |
|
static void Gets(); |
|
|
|
#define NBUFSIZ (BUFSIZ*10) |
#define NBUFSIZ (BUFSIZ*10) |
#define TBUFSIZ (BUFSIZ) |
#define TBUFSIZ (BUFSIZ) |
|
|
#define REALLOC_NBUF \ |
#define REALLOC_NBUF \ |
if ( i >= nbufsize ) {\ |
if ( i >= nbufsize ) {\ |
nbufsize += NBUFSIZ;\ |
nbufsize += NBUFSIZ;\ |
if ( nbuf == nbuf0 ) {\ |
if ( nbuf == nbuf0 ) {\ |
nbuf = (char *)MALLOC_ATOMIC(nbufsize);\ |
nbuf = (char *)MALLOC_ATOMIC(nbufsize);\ |
bcopy(nbuf0,nbuf,nbufsize-NBUFSIZ);\ |
bcopy(nbuf0,nbuf,nbufsize-NBUFSIZ);\ |
} else\ |
} else\ |
nbuf = REALLOC(nbuf,nbufsize);\ |
nbuf = REALLOC(nbuf,nbufsize);\ |
} |
} |
|
|
#define REALLOC_TBUF \ |
#define REALLOC_TBUF \ |
if ( i >= tbufsize ) {\ |
if ( i >= tbufsize ) {\ |
tbufsize += TBUFSIZ;\ |
tbufsize += TBUFSIZ;\ |
if ( tbuf == tbuf0 ) {\ |
if ( tbuf == tbuf0 ) {\ |
tbuf = (char *)MALLOC_ATOMIC(tbufsize);\ |
tbuf = (char *)MALLOC_ATOMIC(tbufsize);\ |
bcopy(tbuf0,tbuf,tbufsize-TBUFSIZ);\ |
bcopy(tbuf0,tbuf,tbufsize-TBUFSIZ);\ |
} else\ |
} else\ |
tbuf = REALLOC(tbuf,tbufsize);\ |
tbuf = REALLOC(tbuf,tbufsize);\ |
} |
} |
|
|
#define READ_ALNUM_NBUF \ |
#define READ_ALNUM_NBUF \ |
while ( 1 ) {\ |
while ( 1 ) {\ |
c = Getc();\ |
c = Getc();\ |
if ( isalnum(c) ) {\ |
if ( isalnum(c) ) {\ |
REALLOC_NBUF nbuf[i++] = c;\ |
REALLOC_NBUF nbuf[i++] = c;\ |
} else\ |
} else\ |
break;\ |
break;\ |
} |
} |
|
|
#define READ_DIGIT_NBUF \ |
#define READ_DIGIT_NBUF \ |
while ( 1 ) {\ |
while ( 1 ) {\ |
c = Getc();\ |
c = Getc();\ |
if ( isdigit(c) ) {\ |
if ( isdigit(c) ) {\ |
REALLOC_NBUF nbuf[i++] = c;\ |
REALLOC_NBUF nbuf[i++] = c;\ |
} else\ |
} else\ |
break;\ |
break;\ |
} |
} |
|
|
yylex() |
int yylex() |
{ |
{ |
#define yylvalp (&yylval) |
#define yylvalp (&yylval) |
register int c,c1; |
register int c,c1; |
register int *ptr; |
register int *ptr; |
char *cptr; |
char *cptr; |
int d,i,j; |
int d,i,j; |
char nbuf0[NBUFSIZ],tbuf0[TBUFSIZ]; |
char nbuf0[NBUFSIZ],tbuf0[TBUFSIZ]; |
char *nbuf, *tbuf; |
char *nbuf, *tbuf; |
int nbufsize, tbufsize; |
int nbufsize, tbufsize; |
N n,n1; |
N n,n1; |
Q q; |
Q q; |
Obj r; |
Obj r; |
|
int floatingpoint = 0; |
/* initialize buffer pointers */ |
double dbl; |
nbuf = nbuf0; tbuf = tbuf0; |
Real real; |
nbufsize = NBUFSIZ; tbufsize = TBUFSIZ; |
double atof(); |
|
extern int bigfloat; |
|
|
switch ( c = skipspace() ) { |
|
case EOF : |
/* initialize buffer pointers */ |
asir_terminate(2); break; |
nbuf = nbuf0; tbuf = tbuf0; |
case '0' : |
nbufsize = NBUFSIZ; tbufsize = TBUFSIZ; |
while ( ( c = Getc() ) == '0' ); |
|
if ( c == '.' ) { |
|
Ungetc(c); c = '0'; |
|
} else if ( c == 'x' ) { |
|
for ( i = 0; i < 8; i++ ) |
|
nbuf[i] = '0'; |
|
READ_ALNUM_NBUF |
|
Ungetc(c); REALLOC_NBUF nbuf[i] = 0; |
|
hexton(nbuf,&n1); |
|
NTOQ(n1,1,q); r = (Obj)q; |
|
yylvalp->p = (pointer)r; |
|
return ( FORMULA ); |
|
} else if ( c == 'b' ) { |
|
for ( i = 0; i < 32; i++ ) |
|
nbuf[i] = '0'; |
|
READ_ALNUM_NBUF |
|
Ungetc(c); REALLOC_NBUF nbuf[i] = 0; |
|
binaryton(nbuf,&n1); |
|
NTOQ(n1,1,q); r = (Obj)q; |
|
yylvalp->p = (pointer)r; |
|
return ( FORMULA ); |
|
} else if ( !isdigit(c) ) { |
|
yylvalp->p = 0; Ungetc(c); |
|
return ( FORMULA ); |
|
} |
|
break; |
|
case '\'' : |
|
for ( i = 0; ; i++ ) { |
|
c = Getc(); |
|
if ( c == '\'' ) |
|
break; |
|
if ( c == '\\' ) |
|
c = Getc(); |
|
REALLOC_TBUF tbuf[i] = c; |
|
} |
|
REALLOC_TBUF tbuf[i] = 0; |
|
cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf); |
|
yylvalp->p = (pointer)cptr; |
|
return LCASE; break; |
|
case '"' : |
|
i = 0; |
|
do { |
|
c = Getc(); |
|
if ( c == '\\' ) { |
|
c1 = Getc(); |
|
if ( c1 == 'n' ) |
|
c1 = '\n'; |
|
REALLOC_NBUF nbuf[i++] = c1; |
|
} else { |
|
REALLOC_NBUF nbuf[i++] = c; |
|
} |
|
} while ( c != '"' ); |
|
nbuf[i-1] = 0; /* REALLOC_NBUF is not necessary */ |
|
cptr = (char *)MALLOC(strlen(nbuf)+1); |
|
strcpy(cptr,nbuf); yylvalp->p = (pointer) cptr; |
|
return ( STR ); break; |
|
case '>': case '<': case '=': case '!': |
|
if ( (c1 = Getc()) == '=' ) |
|
switch ( c ) { |
|
case '>': yylvalp->i = (int)C_GE; break; |
|
case '<': yylvalp->i = (int)C_LE; break; |
|
case '=': yylvalp->i = (int)C_EQ; break; |
|
case '!': yylvalp->i = (int)C_NE; break; |
|
default: break; |
|
} |
|
else if ( (c == '<' && c1 == '<') || (c == '>' && c1 == '>') ) |
|
return c; |
|
else { |
|
Ungetc(c1); |
|
switch ( c ) { |
|
case '>': yylvalp->i = (int)C_GT; break; |
|
case '<': yylvalp->i = (int)C_LT; break; |
|
default: return c; break; |
|
} |
|
} |
|
return CMP; break; |
|
case '+': case '-': case '*': case '/': case '%': case '^': |
|
case '|': case '&': |
|
switch ( c ) { |
|
case '+': yylvalp->p = (pointer)addfs; break; |
|
case '-': yylvalp->p = (pointer)subfs; break; |
|
case '*': yylvalp->p = (pointer)mulfs; break; |
|
case '/': yylvalp->p = (pointer)divfs; break; |
|
case '%': yylvalp->p = (pointer)remfs; break; |
|
case '^': yylvalp->p = (pointer)pwrfs; break; |
|
default: break; |
|
} |
|
if ( (c1 = Getc()) == c ) |
|
switch ( c ) { |
|
case '+': case '-': return SELF; break; |
|
case '|': return OR; break; |
|
case '&': return AND; break; |
|
default: Ungetc(c1); return c; break; |
|
} |
|
else if ( c1 == '=' ) |
|
return BOPASS; |
|
else if ( (c == '-') && (c1 == '>') ) |
|
return POINT; |
|
else { |
|
Ungetc(c1); return c; |
|
} |
|
break; |
|
default : |
|
break; |
|
} |
|
if ( isdigit(c) ) { |
|
for ( i = 0; i < DLENGTH; i++ ) |
|
nbuf[i] = '0'; |
|
REALLOC_NBUF nbuf[i++] = c; |
|
READ_DIGIT_NBUF |
|
if ( c == '.' ) { |
|
double dbl; |
|
Real real; |
|
double atof(); |
|
extern int bigfloat; |
|
|
|
REALLOC_NBUF nbuf[i++] = c; |
switch ( c = skipspace() ) { |
READ_DIGIT_NBUF |
case EOF : |
if ( c == 'e' ) { |
asir_terminate(2); break; |
REALLOC_NBUF nbuf[i++] = c; |
case '0' : |
c = Getc(); |
while ( ( c = Getc() ) == '0' ); |
if ( (c == '+') || (c == '-') ) { |
if ( c == '.' ) { |
REALLOC_NBUF nbuf[i++] = c; |
Ungetc(c); c = '0'; |
} else |
} else if ( c == 'x' || c == 'X' ) { |
Ungetc(c); |
for ( i = 0; i < 8; i++ ) |
READ_DIGIT_NBUF |
nbuf[i] = '0'; |
} |
READ_ALNUM_NBUF |
Ungetc(c); REALLOC_NBUF nbuf[i] = 0; |
Ungetc(c); REALLOC_NBUF nbuf[i] = 0; |
#if PARI |
hexton(nbuf,&n1); |
if ( !bigfloat ) { |
NTOQ(n1,1,q); r = (Obj)q; |
dbl = (double)atof(nbuf+DLENGTH); |
yylvalp->p = (pointer)r; |
MKReal(dbl,real); r = (Obj)real; |
return ( FORMULA ); |
} else |
} else if ( c == 'b' || c == 'B' ) { |
strtobf(nbuf,(BF *)&r); |
for ( i = 0; i < 32; i++ ) |
#else |
nbuf[i] = '0'; |
dbl = (double)atof(nbuf+DLENGTH); |
READ_ALNUM_NBUF |
MKReal(dbl,real); r = (Obj)real; |
Ungetc(c); REALLOC_NBUF nbuf[i] = 0; |
#endif |
binaryton(nbuf,&n1); |
} else { |
NTOQ(n1,1,q); r = (Obj)q; |
Ungetc(c); |
yylvalp->p = (pointer)r; |
i -= DLENGTH; d = (i%DLENGTH?i/DLENGTH+1:i/DLENGTH); |
return ( FORMULA ); |
n = NALLOC(d); PL(n) = d; |
} else if ( !isdigit(c) ) { |
for ( j = 0, ptr = BD(n); j < d; j++ ,i -= DLENGTH ) |
yylvalp->p = 0; Ungetc(c); |
ptr[j] = myatoi(nbuf+i); |
return ( FORMULA ); |
bnton(DBASE,n,&n1); |
} |
NTOQ(n1,1,q); r = (Obj)q; |
break; |
/* optobj(&r); */ |
case '\'' : |
} |
for ( i = 0; ; i++ ) { |
yylvalp->p = (pointer)r; |
c = Getc(); |
return ( FORMULA ); |
if ( c == '\'' ) |
} else if ( isalpha(c) ) { |
break; |
i = 0; |
if ( c == '\\' ) |
tbuf[i++] = c; |
c = Getc(); |
while ( 1 ) { |
REALLOC_TBUF tbuf[i] = c; |
c = Getc(); |
} |
if ( isalpha(c)||isdigit(c)||(c=='_') ) { |
REALLOC_TBUF tbuf[i] = 0; |
REALLOC_TBUF tbuf[i++] = c; |
cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf); |
} else |
yylvalp->p = (pointer)cptr; |
break; |
return LCASE; break; |
} |
case '"' : |
REALLOC_TBUF tbuf[i] = 0; Ungetc(c); |
i = 0; |
if ( isupper(tbuf[0]) ) { |
do { |
cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf); |
c = Getc(); |
yylvalp->p = (pointer)cptr; |
if ( c == '\n' ) asir_infile->ln++; |
return UCASE; |
if ( c == '\\' ) { |
} else { |
c1 = Getc(); |
for ( i = 0; kwd[i].name && strcmp(tbuf,kwd[i].name); i++ ); |
if ( c1 == 'n' ) { |
if ( kwd[i].name ) { |
c1 = '\n'; |
yylvalp->i = asir_infile->ln; |
}else if ( c1 == 'r' ) { |
return kwd[i].token; |
c1 = '\r'; |
} else { |
}else if ( c1 == 't' ) { |
cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf); |
c1 = '\t'; |
yylvalp->p = (pointer)cptr; |
}else if ( isdigit(c1) ){ |
return LCASE; |
d = c1 - '0'; |
} |
c1 = Getc(); |
} |
if ( isdigit(c1) ) { |
} else if ( c == '@' ) { |
d = 8*d + (c1 - '0'); |
if ( isdigit(c = Getc()) ) { |
c1 = Getc(); |
i = 0; |
if ( isdigit(c1) ) { |
nbuf[i++] = c; |
d = 8*d + (c1 - '0'); |
READ_DIGIT_NBUF |
}else { |
Ungetc(c); REALLOC_NBUF nbuf[i] = 0; |
Ungetc(c1); |
yylvalp->i = atoi(nbuf); |
} |
return ANS; |
}else { |
} else if ( c == '@' ) { |
Ungetc(c1); |
yylvalp->i = MAX(0,APVS->n-1); |
} |
return ANS; |
c1 = d; |
} else if ( c == '>' || c == '<' || c == '=' || c == '!' ) { |
} |
if ( (c1 = Getc()) == '=' ) |
REALLOC_NBUF nbuf[i++] = c1; |
switch ( c ) { |
} else { |
case '>': yylvalp->i = (int)L_GE; break; |
REALLOC_NBUF nbuf[i++] = c; |
case '<': yylvalp->i = (int)L_LE; break; |
} |
case '=': yylvalp->i = (int)L_EQ; break; |
} while ( c != '"' ); |
case '!': yylvalp->i = (int)L_NE; break; |
nbuf[i-1] = 0; /* REALLOC_NBUF is not necessary */ |
default: break; |
cptr = (char *)MALLOC(strlen(nbuf)+1); |
} |
strcpy(cptr,nbuf); yylvalp->p = (pointer) cptr; |
else { |
return ( STR ); break; |
Ungetc(c1); |
case '>': case '<': case '=': case '!': |
switch ( c ) { |
if ( (c1 = Getc()) == '=' ) |
case '>': yylvalp->i = (int)L_GT; break; |
switch ( c ) { |
case '<': yylvalp->i = (int)L_LT; break; |
case '>': yylvalp->i = (int)C_GE; break; |
case '=': yylvalp->i = (int)L_EQ; break; |
case '<': yylvalp->i = (int)C_LE; break; |
case '!': yylvalp->i = (int)L_NOT; return FOP_NOT; break; |
case '=': yylvalp->i = (int)C_EQ; break; |
default: break; |
case '!': yylvalp->i = (int)C_NE; break; |
} |
default: break; |
} |
} |
return LOP; |
else if ( (c == '<' && c1 == '<') || (c == '>' && c1 == '>') ) |
} else if ( c == '|' || c == '&' ) { |
return c; |
if ( (c1 = Getc()) != c ) |
else { |
Ungetc(c1); |
Ungetc(c1); |
switch ( c ) { |
switch ( c ) { |
case '|': yylvalp->i = (int)L_OR; |
case '>': yylvalp->i = (int)C_GT; break; |
return FOP_OR; break; |
case '<': yylvalp->i = (int)C_LT; break; |
case '&': yylvalp->i = (int)L_AND; |
default: return c; break; |
return FOP_AND; break; |
} |
} |
} |
} else if ( isalpha(c) ) { |
return CMP; break; |
i = 0; |
case '+': case '-': case '*': case '/': case '%': case '^': |
tbuf[i++] = '@'; |
case '|': case '&': |
tbuf[i++] = c; |
switch ( c ) { |
while ( 1 ) { |
case '+': yylvalp->p = (pointer)addfs; break; |
c = Getc(); |
case '-': yylvalp->p = (pointer)subfs; break; |
if ( isalpha(c) ) { |
case '*': yylvalp->p = (pointer)mulfs; break; |
REALLOC_TBUF tbuf[i++] = c; |
case '/': yylvalp->p = (pointer)divfs; break; |
} else |
case '%': yylvalp->p = (pointer)remfs; break; |
break; |
case '^': yylvalp->p = (pointer)pwrfs; break; |
} |
default: break; |
Ungetc(c); REALLOC_TBUF tbuf[i] = 0; |
} |
if ( !strcmp(tbuf,"@p") ) |
if ( (c1 = Getc()) == c ) |
return GFPNGEN; |
switch ( c ) { |
else if ( !strcmp(tbuf,"@i") ) { |
case '+': case '-': return SELF; break; |
extern pointer IU; |
case '|': return OR; break; |
|
case '&': return AND; break; |
|
default: Ungetc(c1); return c; break; |
|
} |
|
else if ( c1 == '=' ) |
|
return BOPASS; |
|
else if ( (c == '-') && (c1 == '>') ) |
|
return POINT; |
|
else { |
|
Ungetc(c1); return c; |
|
} |
|
break; |
|
default : |
|
break; |
|
} |
|
if ( isdigit(c) ) { |
|
for ( i = 0; i < DLENGTH; i++ ) |
|
nbuf[i] = '0'; |
|
REALLOC_NBUF nbuf[i++] = c; |
|
READ_DIGIT_NBUF |
|
if ( c == '.' ) { |
|
floatingpoint = 1; |
|
|
yylvalp->p = IU; |
REALLOC_NBUF nbuf[i++] = c; |
return FORMULA; |
READ_DIGIT_NBUF |
} else if ( !strcmp(tbuf,"@true") ) { |
if ( c == 'e' || c == 'E' ) { |
yylvalp->p = F_TRUE; |
REALLOC_NBUF nbuf[i++] = c; |
return FORMULA; |
c = Getc(); |
} else if ( !strcmp(tbuf,"@false") ) { |
if ( (c == '+') || (c == '-') ) { |
yylvalp->p = F_FALSE; |
REALLOC_NBUF nbuf[i++] = c; |
return FORMULA; |
} else |
} else if ( !strcmp(tbuf,"@impl") ) { |
Ungetc(c); |
yylvalp->i = (int)L_IMPL; |
READ_DIGIT_NBUF |
return FOP_IMPL; |
} |
} else if ( !strcmp(tbuf,"@repl") ) { |
} else if ( c == 'e' || c == 'E' ) { |
yylvalp->i = (int)L_REPL; |
floatingpoint = 1; |
return FOP_REPL; |
REALLOC_NBUF nbuf[i++] = c; |
} else if ( !strcmp(tbuf,"@equiv") ) { |
c = Getc(); |
yylvalp->i = (int)L_EQUIV; |
if ( (c == '+') || (c == '-') ) { |
return FOP_EQUIV; |
REALLOC_NBUF nbuf[i++] = c; |
} else { |
} else |
cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf); |
Ungetc(c); |
yylvalp->p = (pointer)cptr; |
READ_DIGIT_NBUF |
return LCASE; |
} |
} |
if ( floatingpoint ) { |
} else { |
Ungetc(c); REALLOC_NBUF nbuf[i] = 0; |
Ungetc(c); |
if ( !bigfloat ) { |
return GF2NGEN; |
dbl = (double)atof(nbuf+DLENGTH); |
} |
MKReal(dbl,real); r = (Obj)real; |
} else |
} else |
return ( c ); |
strtobf(nbuf,(BF *)&r); |
|
} else { |
|
Ungetc(c); |
|
i -= DLENGTH; d = (i%DLENGTH?i/DLENGTH+1:i/DLENGTH); |
|
n = NALLOC(d); PL(n) = d; |
|
for ( j = 0, ptr = BD(n); j < d; j++ ,i -= DLENGTH ) |
|
ptr[j] = myatoi(nbuf+i); |
|
bnton(DBASE,n,&n1); |
|
NTOQ(n1,1,q); r = (Obj)q; |
|
/* optobj(&r); */ |
|
} |
|
yylvalp->p = (pointer)r; |
|
return ( FORMULA ); |
|
} else if ( isalpha(c) || c == ':' || c == '_' ) { |
|
if ( c == ':' ) { |
|
c1 = Getc(); |
|
if ( c1 != ':' ) { |
|
Ungetc(c1); |
|
return c; |
|
} |
|
c1 = Getc(); |
|
if ( !isalpha(c1) ) { |
|
Ungetc(c1); |
|
return COLONCOLON; |
|
} |
|
i = 0; |
|
tbuf[i++] = ':'; |
|
tbuf[i++] = ':'; |
|
tbuf[i++] = c1; |
|
} else { |
|
i = 0; |
|
tbuf[i++] = c; |
|
} |
|
while ( 1 ) { |
|
c = Getc(); |
|
if ( isalpha(c)||isdigit(c)||(c=='_')||(c=='.') ) { |
|
REALLOC_TBUF tbuf[i++] = c; |
|
} else |
|
break; |
|
} |
|
REALLOC_TBUF tbuf[i] = 0; Ungetc(c); |
|
if ( isupper(tbuf[0]) || (tbuf[0] == '_' && isupper(tbuf[1])) ) { |
|
cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf); |
|
yylvalp->p = (pointer)cptr; |
|
return UCASE; |
|
} else { |
|
for ( i = 0; kwd[i].name && strcmp(tbuf,kwd[i].name); i++ ); |
|
if ( kwd[i].name ) { |
|
yylvalp->i = asir_infile->ln; |
|
return kwd[i].token; |
|
} else { |
|
cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf); |
|
yylvalp->p = (pointer)cptr; |
|
return LCASE; |
|
} |
|
} |
|
} else if ( c == '@' ) { |
|
if ( isdigit(c = Getc()) ) { |
|
i = 0; |
|
nbuf[i++] = c; |
|
READ_DIGIT_NBUF |
|
Ungetc(c); REALLOC_NBUF nbuf[i] = 0; |
|
yylvalp->i = atoi(nbuf); |
|
return ANS; |
|
} else if ( c == '@' ) { |
|
yylvalp->i = MAX(0,APVS->n-1); |
|
return ANS; |
|
} else if ( c == '>' || c == '<' || c == '=' || c == '!' ) { |
|
if ( (c1 = Getc()) == '=' ) |
|
switch ( c ) { |
|
case '>': yylvalp->i = (int)L_GE; break; |
|
case '<': yylvalp->i = (int)L_LE; break; |
|
case '=': yylvalp->i = (int)L_EQ; break; |
|
case '!': yylvalp->i = (int)L_NE; break; |
|
default: break; |
|
} |
|
else { |
|
Ungetc(c1); |
|
switch ( c ) { |
|
case '>': yylvalp->i = (int)L_GT; break; |
|
case '<': yylvalp->i = (int)L_LT; break; |
|
case '=': yylvalp->i = (int)L_EQ; break; |
|
case '!': yylvalp->i = (int)L_NOT; return FOP_NOT; break; |
|
default: break; |
|
} |
|
} |
|
return LOP; |
|
} else if ( c == '|' || c == '&' ) { |
|
if ( (c1 = Getc()) != c ) |
|
Ungetc(c1); |
|
switch ( c ) { |
|
case '|': yylvalp->i = (int)L_OR; |
|
return FOP_OR; break; |
|
case '&': yylvalp->i = (int)L_AND; |
|
return FOP_AND; break; |
|
} |
|
} else if ( isalpha(c) ) { |
|
i = 0; |
|
tbuf[i++] = '@'; |
|
tbuf[i++] = c; |
|
while ( 1 ) { |
|
c = Getc(); |
|
if ( isalpha(c) ) { |
|
REALLOC_TBUF tbuf[i++] = c; |
|
} else |
|
break; |
|
} |
|
Ungetc(c); REALLOC_TBUF tbuf[i] = 0; |
|
if ( !strcmp(tbuf,"@p") ) |
|
return GFPNGEN; |
|
else if ( !strcmp(tbuf,"@s") ) |
|
return GFSNGEN; |
|
else if ( !strcmp(tbuf,"@void") ) { |
|
yylvalp->p = VOIDobj; |
|
return FORMULA; |
|
} else if ( !strcmp(tbuf,"@i") ) { |
|
extern pointer IU; |
|
|
|
yylvalp->p = IU; |
|
return FORMULA; |
|
} else if ( !strcmp(tbuf,"@true") ) { |
|
yylvalp->p = F_TRUE; |
|
return FORMULA; |
|
} else if ( !strcmp(tbuf,"@false") ) { |
|
yylvalp->p = F_FALSE; |
|
return FORMULA; |
|
} else if ( !strcmp(tbuf,"@impl") ) { |
|
yylvalp->i = (int)L_IMPL; |
|
return FOP_IMPL; |
|
} else if ( !strcmp(tbuf,"@repl") ) { |
|
yylvalp->i = (int)L_REPL; |
|
return FOP_REPL; |
|
} else if ( !strcmp(tbuf,"@equiv") ) { |
|
yylvalp->i = (int)L_EQUIV; |
|
return FOP_EQUIV; |
|
} else if ( !strcmp(tbuf,"@grlex") ) { |
|
yylvalp->p = Symbol_grlex; |
|
return FORMULA; |
|
} else if ( !strcmp(tbuf,"@glex") ) { |
|
yylvalp->p = Symbol_glex; |
|
return FORMULA; |
|
} else if ( !strcmp(tbuf,"@lex") ) { |
|
yylvalp->p = Symbol_lex; |
|
return FORMULA; |
|
} else { |
|
cptr = (char *)MALLOC(strlen(tbuf)+1); strcpy(cptr,tbuf); |
|
yylvalp->p = (pointer)cptr; |
|
return LCASE; |
|
} |
|
} else { |
|
Ungetc(c); |
|
return GF2NGEN; |
|
} |
|
} else |
|
return ( c ); |
} |
} |
|
|
void purge_stdin() |
void purge_stdin() |
{ |
{ |
#if defined(VISUAL) |
#if defined(__FreeBSD__) || defined(__DARWIN__) |
#elif defined(__FreeBSD__) |
fpurge(stdin); |
fpurge(stdin); |
|
#elif defined(linux) |
#elif defined(linux) |
stdin->_IO_read_end = stdin->_IO_read_base; |
stdin->_IO_read_end = stdin->_IO_read_base; |
stdin->_IO_read_ptr = stdin->_IO_read_base; |
stdin->_IO_read_ptr = stdin->_IO_read_base; |
#elif defined(sparc) || defined(__alpha) || defined(__SVR4) || defined(mips) |
#elif defined(VISUAL_LIB) |
stdin->_ptr = stdin->_base; stdin->_cnt = 0; |
void w_purge_stdin(); |
#elif defined(VISUAL) |
|
w_purge_stdin(); |
w_purge_stdin(); |
|
#elif defined(VISUAL) && _MSC_VER >= 1900 |
|
rewind(stdin); |
|
#elif defined(sparc) || defined(__alpha) || defined(__SVR4) || defined(mips) || defined(VISUAL) || defined(__MINGW32__) || defined(_IBMR2) |
|
stdin->_ptr = stdin->_base; stdin->_cnt = 0; |
|
#elif (defined(__MACH__) && defined(__ppc__)) || defined(__CYGWIN__) || defined(__FreeBSD__) || defined(__INTERIX) |
|
stdin->_r = 0; stdin->_p = stdin->_bf._base; |
#else |
#else |
--->FIXIT |
--->FIXIT |
#endif |
#endif |
} |
} |
|
|
static int skipspace() { |
static int skipspace() { |
int c,c1; |
int c,c1; |
|
|
for ( c = Getc(); ; ) |
for ( c = Getc(); ; ) |
switch ( c ) { |
switch ( c ) { |
case ' ': case '\t': |
case ' ': case '\t': case '\r': |
c = Getc(); break; |
c = Getc(); break; |
case '\n': |
case '\n': |
c = afternl(); break; |
c = afternl(); break; |
case '/': |
case '/': |
if ( (c1 = Getc()) == '*' ) |
if ( (c1 = Getc()) == '*' ) |
c = aftercomment(); |
c = aftercomment(); |
else { |
else { |
Ungetc(c1); return c; |
Ungetc(c1); return c; |
} |
} |
break; |
break; |
default: |
default: |
return c; break; |
return c; break; |
} |
} |
} |
} |
|
|
int afternl() { |
int afternl() { |
int c,ac,i,quote; |
int c,ac,i,quote; |
char *ptr; |
char *ptr,*buf0; |
char *av[BUFSIZ]; |
char *av[BUFSIZ]; |
static int ilevel = 0; |
static int ilevel = 0; |
char buf[BUFSIZ]; |
char buf[BUFSIZ]; |
|
|
if ( !ilevel ) |
if ( !ilevel ) |
asir_infile->ln++; |
asir_infile->ln++; |
while ( (c = Getc()) == '#' ) { |
while ( (c = Getc()) == '#' ) { |
Gets(buf); |
Gets(buf); |
for ( quote = 0, ptr = buf; *ptr; ptr++ ) |
#define LINE "line" |
if ( *ptr == '"' ) |
if ( !strncmp(buf,LINE,strlen(LINE)) ) buf0 = buf+strlen(LINE); |
quote = quote ? 0 : 1; |
else buf0 = buf; |
else if ( quote && (*ptr == ' ') ) |
for ( quote = 0, ptr = buf0; *ptr; ptr++ ) |
*ptr = '_'; |
if ( *ptr == '"' ) |
stoarg(buf,&ac,av); |
quote = quote ? 0 : 1; |
if ( ac == 3 ) |
else if ( quote && (*ptr == ' ') ) |
if ( (i = atoi(av[2])) == 1 ) |
*ptr = '_'; |
ilevel++; |
stoarg(buf0,&ac,av); |
else if ( i == 2 ) |
if ( ac == 3 ) |
ilevel--; |
if ( (i = atoi(av[2])) == 1 ) |
if ( !ilevel ) |
ilevel++; |
asir_infile->ln = atoi(av[0]); |
else if ( i == 2 ) |
} |
ilevel--; |
return c; |
if ( !ilevel ) |
|
asir_infile->ln = atoi(av[0]); |
|
} |
|
return c; |
} |
} |
|
|
int aftercomment() { |
int aftercomment() { |
int c,c1; |
int c,c1; |
|
|
for ( c = Getc(); ; ) { |
for ( c = Getc(); ; ) { |
c1 = Getc(); |
if ( c == '\n' ) asir_infile->ln++; |
if ( (c == '*') && (c1 == '/') ) |
c1 = Getc(); |
return Getc(); |
if ( (c == '*') && (c1 == '/') ) |
else |
return Getc(); |
c = c1; |
else |
} |
c = c1; |
|
} |
} |
} |
|
|
int myatoi(s) |
int myatoi(char *s) |
char *s; |
|
{ |
{ |
int i,r; |
int i,r; |
for ( i = 0, r = 0; i < DLENGTH; i++ ) r = r * 10 + ( s[i] - '0' ); |
for ( i = 0, r = 0; i < DLENGTH; i++ ) r = r * 10 + ( s[i] - '0' ); |
return ( r ); |
return ( r ); |
} |
} |
|
|
extern int ox_do_copy; |
extern int ox_do_copy; |
|
extern int I_am_server; |
|
extern JMP_BUF main_env; |
|
extern int at_root; |
|
extern LIST LastStackTrace; |
|
extern char *CUR_FUNC; |
|
|
void yyerror(s) |
void yyerror(char *s) |
char *s; |
|
{ |
{ |
if ( main_parser ) |
STRING fname,name,kwd; |
if ( ox_do_copy ) { |
USINT u; |
/* push errors to DebugStack */ |
NODE t; |
} else { |
LIST l,l2; |
if ( asir_infile->fp == stdin ) |
|
fprintf(stderr,"%s\n",s); |
if ( main_parser ) { |
else |
if ( ox_do_copy ) { |
fprintf(stderr,"\"%s\", near line %d: %s\n",asir_infile->name,asir_infile->ln,s); |
/* push errors to DebugStack */ |
} |
} else { |
else |
if ( asir_infile->fp == stdin ) |
fprintf(stderr,"exprparse : %s\n",s); |
fprintf(stderr,"%s\n",s); |
|
else |
|
fprintf(stderr,"\"%s\", near line %d: %s\n",asir_infile->name,asir_infile->ln,s); |
|
} |
|
if ( I_am_server ) { |
|
if ( NEXT(asir_infile) ) { |
|
/* error in a file; record the position */ |
|
MKSTR(fname,asir_infile->name); |
|
if ( CPVS == GPVS ) |
|
MKSTR(name,""); |
|
else |
|
MKSTR(name,CUR_FUNC); |
|
MKUSINT(u,asir_infile->ln); |
|
t = mknode(3,fname,name,u); MKLIST(l,t); |
|
/* line number at the toplevel */ |
|
MKSTR(fname,"toplevel"); MKUSINT(u,at_root); |
|
t = mknode(2,fname,u); MKLIST(l2,t); |
|
t = mknode(2,l2,l); |
|
} else { |
|
MKSTR(fname,"toplevel"); MKUSINT(u,asir_infile->ln); |
|
t = mknode(2,fname,u); MKLIST(l,t); |
|
t = mknode(1,l); |
|
} |
|
MKLIST(l,t); |
|
MKSTR(kwd,"asir_where"); t = mknode(2,kwd,l); |
|
MKLIST(LastStackTrace,t); |
|
set_lasterror(s); |
|
LONGJMP(main_env,1); |
|
} |
|
} else |
|
fprintf(stderr,"exprparse : %s\n",s); |
} |
} |
|
|
int echoback; |
int echoback; |
|
|
extern int read_exec_file, do_fep, do_file; |
extern int do_fep, do_file; |
|
|
int readline_getc(); |
|
void readline_ungetc(); |
|
int Egetc(); |
|
void Eungetc(); |
|
|
|
unsigned char encrypt_char(unsigned char); |
unsigned char encrypt_char(unsigned char); |
unsigned char decrypt_char(unsigned char); |
unsigned char decrypt_char(unsigned char); |
|
|
int Egetc(fp) |
int Egetc(FILE *fp) |
FILE *fp; |
|
{ |
{ |
int c; |
int c; |
|
|
if ( fp ) { |
if ( fp ) { |
c = getc(fp); |
#if FEP |
if ( c == EOF ) |
if ( do_fep && isatty(fileno(fp)) ) |
return c; |
c = readline_getc(); |
if ( asir_infile->encoded ) |
else |
c = decrypt_char((unsigned char)c); |
#endif |
return c; |
c = getc(fp); |
} else if ( read_exec_file ) |
#if defined(VISUAL) || defined(__MINGW32__) |
return EOF; |
check_intr(); |
else { |
#endif |
c = *parse_strp++; |
if ( c == EOF ) |
if ( !c ) |
return c; |
return EOF; |
if ( asir_infile->encoded ) |
else |
c = decrypt_char((unsigned char)c); |
return c; |
return c; |
} |
} else { |
|
c = *parse_strp++; |
|
if ( !c ) |
|
return EOF; |
|
else |
|
return c; |
|
} |
} |
} |
|
|
void Eungetc(c,fp) |
void Eungetc(int c,FILE *fp) |
int c; |
|
FILE *fp; |
|
{ |
{ |
if ( fp ) { |
if ( fp ) { |
if ( asir_infile->encoded ) |
if ( asir_infile->encoded ) |
c = (int)encrypt_char((unsigned char)c); |
c = (int)encrypt_char((unsigned char)c); |
ungetc(c,fp); |
#if FEP |
} else |
if ( do_fep && isatty(fileno(fp)) ) |
*--parse_strp = c; |
readline_ungetc(); |
|
else |
|
#endif |
|
ungetc(c,fp); |
|
} else |
|
*--parse_strp = c; |
} |
} |
|
|
static int Getc() { |
static int Getc() { |
int c; |
int c; |
|
|
if ( main_parser ) { |
if ( main_parser ) { |
while ( 1 ) { |
while ( 1 ) { |
if ((c = Egetc(asir_infile->fp)) == EOF) |
if ((c = Egetc(asir_infile->fp)) == EOF) |
if ( NEXT(asir_infile) ) { |
if ( NEXT(asir_infile) ) { |
closecurrentinput(); |
closecurrentinput(); |
c = Getc(); |
/* if the input is the top level, generate error */ |
break; |
if ( !NEXT(asir_infile) ) |
} else if ( read_exec_file || do_file ) |
error("end-of-file detected during parsing"); |
asir_terminate(2); |
else |
else { |
c = Getc(); |
if ( asir_infile->fp ) |
break; |
clearerr(asir_infile->fp); |
} else if ( asir_infile->fp || do_file ) { |
} |
if ( asir_infile->fp ) |
else |
clearerr(asir_infile->fp); |
break; |
asir_terminate(2); |
} |
} else { |
if ( echoback ) |
error("end-of-line detected during parsing"); |
fputc(c,asir_out); |
} |
} else |
else |
c = *parse_strp++; |
break; |
return ( c ); |
} |
|
if ( echoback ) |
|
fputc(c,asir_out); |
|
} else |
|
c = *parse_strp++; |
|
return ( c ); |
} |
} |
|
|
static void Ungetc(c) { |
static void Ungetc(int c) { |
if ( main_parser ) { |
if ( main_parser ) { |
Eungetc(c,asir_infile->fp); |
Eungetc(c,asir_infile->fp); |
if ( echoback ) |
if ( echoback ) |
fputc('',asir_out); |
fputc('',asir_out); |
} else |
} else |
*--parse_strp = c; |
*--parse_strp = c; |
} |
} |
|
|
static void Gets(s) |
static void Gets(char *s) |
char *s; |
|
{ |
{ |
int c; |
int c; |
|
|
while ( (c = Getc()) != '\n' ) |
while ( (c = Getc()) != '\n' ) |
*s++ = c; |
*s++ = c; |
*s = 0; |
*s = 0; |
} |
} |
|
|
|
#if FEP |
|
|
|
static char *readline_line; |
|
static int readline_nc,readline_index; |
|
char *readline_console(); |
|
|
|
int readline_getc() |
|
{ |
|
char buf[BUFSIZ]; |
|
|
|
if ( !readline_nc ) { |
|
if ( readline_line ) |
|
free(readline_line); |
|
sprompt(buf); |
|
readline_line = readline_console(buf); |
|
readline_nc = strlen(readline_line); |
|
readline_index = 0; |
|
} |
|
readline_nc--; |
|
return readline_line[readline_index++]; |
|
} |
|
|
|
void readline_ungetc() |
|
{ |
|
readline_nc++; readline_index--; |
|
} |
|
|
|
char *readline_console(char *prompt) |
|
{ |
|
char *line; |
|
int exp_result; |
|
char *expansion; |
|
|
|
while ( 1 ) { |
|
line = (char *)readline(prompt); |
|
if ( line && *line ) { |
|
using_history(); |
|
exp_result = history_expand(line,&expansion); |
|
if ( !exp_result ) { |
|
free(expansion); |
|
for ( ; isspace((unsigned char)*line); line++ ); |
|
add_history(line); |
|
break; |
|
} else if ( exp_result > 0 ) { |
|
free(line); |
|
line = expansion; |
|
break; |
|
} |
|
} |
|
} |
|
return line; |
|
} |
|
#endif |