int getc_skipws(Obj stream){
int c;
while( 1 ){
c = readchar(stream);
switch(c){
case ';':
while( c!= '\n' && c!=EOF )
c = readchar(stream);
/* fall thru' */
case '\n':
inc_lineno();
case ' ':
case '\t':
case '\r':
continue;
/* this could hust as easily be done in lisp ... */
case '#':
c = readchar(stream);
if(c!='|'){
unreadchar(stream, c);
return '#';
}
eatcomment(stream);
continue;
}
break;
}
return c;
}
/*===========================
* lowyylex -- Lexer function
*=========================*/
static int
lowyylex (PACTX pactx, YYSTYPE * lvalp)
{
INT c=0, t=0;
/* skip over whitespace or comments up to start of token */
while (TRUE) {
while ((t = chartype(c = inchar(pactx))) == WHITE)
;
if (c != '/') break;
if ((c = inchar(pactx)) != '*') {
unreadchar(pactx, c);
return '/';
}
/* inside a comment -- advance til end */
while (TRUE) {
while ((c = inchar(pactx)) != '*' && c != EOF)
;
if (c == EOF) return 0;
while ((c = inchar(pactx)) == '*')
;
if (c == '/') break;
if (c == EOF) return 0;
}
}
/* now read token */
c = lextok(pactx, lvalp, c, t);
return c;
}
int special_char(Obj stream){
/* handle special \escaped characters */
int c;
int val=0, base;
c = readchar(stream);
switch( c ){
case 'a': c = '\a'; break; /* yes, I know that this is the ANSI C alert char... */
case 'n': c = '\n'; break;
case 'r': c = '\r'; break;
case 'b': c = '\b'; break;
case 't': c = '\t'; break;
case 's': c = ' '; break;
case 'f': c = '\f'; break;
case 'v': c = '\v'; break;
case 'e': c = '\033'; break;
case '\\': c = '\\'; break;
case '"': c = '"'; break;
case '0':
base = 8; goto rnum;
case 'x':
case 'X':
c = readchar(stream);
base = 16; goto rnum;
case '1': case '2': case '3':
case '4': case '5': case '6':
case '7': case '8': case '9':
base = 10; goto rnum;
rnum:
while( isvalid(c, base)){
val *= base;
val += vallof(c, base);
c = readchar(stream);
}
unreadchar(stream, c);
c = val;
break;
case EOF:
got_eof();
return EOF;
case '\n':
inc_lineno();
default:
c = c; break;
}
return c;
}
/*===========================
* lextok -- lex the next token
*=========================*/
static int
lextok (PACTX pactx, YYSTYPE * lvalp, INT c, INT t)
{
INT retval, mul;
extern INT Yival;
extern FLOAT Yfval;
static char tokbuf[512]; /* token buffer */
STRING p = tokbuf;
if (t == LETTER) {
p = tokbuf;
while (is_iden_char(c, t)) {
if (p-tokbuf < (int)sizeof(tokbuf) - 3) {
*p++ = c;
} else {
/* token overlong -- ignore end of it */
/* TODO: How can we force a parse error from here ? */
}
t = chartype(c = inchar(pactx));
}
*p = 0;
unreadchar(pactx, c);
if (reserved(tokbuf, &retval)) return retval;
/* IDEN values have to be passed from yacc.y to free_iden */
*lvalp = (PNODE) strsave(tokbuf);
return IDEN;
}
if (t == '-' || t == DIGIT || t == '.') {
BOOLEAN whole = FALSE;
BOOLEAN frac = FALSE;
FLOAT fdiv;
mul = 1;
if (t == '-') {
t = chartype(c = inchar(pactx));
if (t != '.' && t != DIGIT) {
unreadchar(pactx, c);
return '-';
}
mul = -1;
}
Yival = 0;
while (t == DIGIT) {
whole = TRUE;
Yival = Yival*10 + c - '0';
t = chartype(c = inchar(pactx));
}
if (t != '.') {
unreadchar(pactx, c);
Yival *= mul;
*lvalp = NULL;
return ICONS;
}
t = chartype(c = inchar(pactx));
Yfval = 0.0;
fdiv = 1.0;
while (t == DIGIT) {
frac = TRUE;
Yfval = Yfval*10 + c - '0';
fdiv *= 10.;
t = chartype(c = inchar(pactx));
}
unreadchar(pactx, c);
if (!whole && !frac) {
unreadchar(pactx, c);
if (mul == -1) {
unreadchar(pactx, '.');
return '-';
} else
return '.';
}
Yfval = mul*(Yival + Yfval/fdiv);
*lvalp = NULL;
return FCONS;
}
if (c == '"') {
INT start_line = pactx->lineno;
p = tokbuf;
while (TRUE) {
while ((c = inchar(pactx)) != EOF && c != '"' && c != '\\') {
if (p-tokbuf > sizeof(tokbuf)/sizeof(tokbuf[0]) - 3) {
/* Overflowing tokbuf buffer */
/* TODO: (Perry, 2006-06-30) I don't know how to fail gracefully from here inside parser */
char msg[512];
snprintf(msg, sizeof(msg)/sizeof(msg[0])
, _("String constant overflowing internal buffer tokbuf len=%d, file: %s, start line: %ld")
, sizeof(tokbuf)/sizeof(tokbuf[0])
, pactx->fullpath
, start_line + 1
);
FATAL2(msg);
*p = c = 0;
}
*p++ = c;
}
if (c == 0 || c == '"') {
*p = 0;
*lvalp = make_internal_string_node(pactx, tokbuf);
return SCONS;
}
switch (c = inchar(pactx)) {
case 'n': *p++ = '\n'; break;
case 't': *p++ = '\t'; break;
case 'v': *p++ = '\v'; break;
case 'r': *p++ = '\r'; break;
case 'b': *p++ = '\b'; break;
case 'f': *p++ = '\f'; break;
case '"': *p++ = '"'; break;
case '\\': *p++ = '\\'; break;
case EOF:
*p = 0;
*lvalp = make_internal_string_node(pactx, tokbuf);
return SCONS;
default:
*p++ = c; break;
}
}
}
if (c == EOF) return 0;
return c;
}