/*-----------------------------------------------------------------------------
* Purpose: Push a new input item onto the stack.
*
* Programmer: Robb Matzke
* Monday, July 10, 2000
*
* Modifications:
*-----------------------------------------------------------------------------
*/
void
lex_push(lex_t *f, lex_t *item)
{
if (f->nstack+1>=NELMTS(f->stack)) {
out_errorn("file inclusion nested too deeply");
} else {
f->stack[f->nstack++] = item;
}
}
/*ARGSUSED*/
static obj_t
ptr_deref (obj_t _self, int argc, obj_t *argv) {
if (0!=argc) {
out_errorn ("ptr_deref: wrong number of arguments");
return NIL;
}
return obj_copy (MYCLASS(_self)->sub, SHALLOW);
}
/*------------------------------------------------------------------------- * Function: lex_open * * Purpose: Open a file for reading. * * Return: Success: Ptr to a lex_t input file. * * Failure: NULL, error printed. * * Programmer: Robb Matzke * [email protected] * Dec 10 1996 * * Modifications: * Robb Matzke, 2000-06-07 * This function fails unless FNAME is a readable _file_. * * Robb Matzke, 2000-07-10 * Sets LEX_STDIN if unset. * * Thomas R. Treadway, Tue Jun 27 13:59:21 PDT 2006 * Added HAVE_STRERROR wrapper *------------------------------------------------------------------------- */ lex_t * lex_open(const char *fname) { lex_t *f=NULL; struct stat sb; FILE *stream; /* Check the file */ if (stat(fname, &sb)<0) { #ifdef HAVE_STRERROR out_errorn("lex_open: cannot open file `%s' (%s)", fname, strerror(errno)); #else out_errorn("lex_open: cannot open file `%s' (errno=%d)", fname, errno); #endif return NULL; } if (!S_ISREG(sb.st_mode)) { out_errorn("lex_open: cannot open file `%s' (Not a regular file)", fname); return NULL; } /* Open the stream */ if (NULL==(stream=fopen(fname, "r"))) { #ifdef HAVE_STRERROR out_errorn("lex_open: cannot open file `%s' (%s)", fname, strerror(errno)); #else out_errorn("lex_open: cannot open file `%s' (errno=%d)", fname, errno); #endif return NULL; } /* Create the lex file pointer */ f = calloc(1, sizeof(lex_t)); assert(f); f->f = stream; f->prompt = LEX_PROMPT; if (!LEX_STDIN) LEX_STDIN = f; return f; }
/*------------------------------------------------------------------------- * Function: parse_range * * Purpose: Tries to parse a range expression of the form `I1:I2' * where I1 and I2 are integer constants. * * Return: Success: A range object. * * Failure: &ErrorCell * * Programmer: Robb Matzke * [email protected] * Jan 3 1997 * * Modifications: * *------------------------------------------------------------------------- */ static obj_t parse_range (lex_t *f, int skipnl) { obj_t lt=NIL, rt=NIL, retval=NIL; int lo, hi; lt = parse_term (f, skipnl); if (&ErrorCell==lt) return &ErrorCell; if (TOK_COLON==lex_token (f, NULL, skipnl)) { lex_consume (f); rt = parse_term (f, skipnl); if (&ErrorCell==rt) { obj_dest (rt); return &ErrorCell; } /* * Both arguments must be integer constants. */ if (!num_isint(lt)) { out_error ("Range: left limit is not an integer constant: ", lt); obj_dest (lt); obj_dest (rt); return &ErrorCell; } if (!num_isint(rt)) { out_error ("Range: right limit is not an integer constant: ", rt); obj_dest (lt); obj_dest (rt); return &ErrorCell; } /* * The constants must be in a reasonable order. */ lo = num_int (lt); hi = num_int (rt); if (hi<lo) { out_errorn ("Range: inverted range %d:%d changed to %d:%d", lo, hi, hi, lo); lo = num_int (rt); hi = num_int (lt); } /* * Create the range object. */ lt = obj_dest (lt); rt = obj_dest (rt); retval = obj_new (C_RANGE, lo, hi); } else { retval = lt; } return retval; }
/*------------------------------------------------------------------------- * Function: lex_stream * * Purpose: Reopens a stream for reading. * * Return: Success: Ptr to a lex_t input file. * * Failure: NULL, error printed. * * Programmer: Robb Matzke * [email protected] * Dec 10 1996 * * Modifications: * Robb Matzke, 2000-07-10 * Sets LEX_STDIN if unset. * * Thomas R. Treadway, Tue Jun 27 13:59:21 PDT 2006 * Added HAVE_STRERROR wrapper *------------------------------------------------------------------------- */ lex_t * lex_stream(FILE *stream) { lex_t *f = calloc(1, sizeof(lex_t)); assert (f); if (NULL==(f->f=fdopen(fileno(stream), "r"))) { #ifdef HAVE_STRERROR out_errorn ("lex_stream: cannot reopen stream (%s)", strerror(errno)); #else out_errorn ("lex_stream: cannot reopen stream (errno=%d)", errno); #endif free(f); return NULL; } f->prompt = LEX_PROMPT; if (!LEX_STDIN) LEX_STDIN = f; return f; }
/*------------------------------------------------------------------------- * Function: out_stream * * Purpose: Duplicates a FILE* for use as an output stream. * * Return: Success: Ptr to the new `out_t' structure. * * Failure: NULL * * Programmer: Robb Matzke * [email protected] * Dec 11 1996 * * Modifications: * * Thomas R. Treadway, Tue Jun 27 14:19:57 PDT 2006 * Added HAVE_STRERROR wrapper * *------------------------------------------------------------------------- */ out_t * out_stream (FILE *stream) { out_t *f = calloc (1, sizeof(out_t)); assert (f); if (NULL==(f->f=fdopen(fileno(stream), "w"))) { #ifdef HAVE_STRERROR out_errorn ("out_stream: cannot reopen stream (%s)", strerror (errno)); #else out_errorn ("out_stream: cannot reopen stream (errno=%d)", errno); #endif free (f); return NULL; } f->paged = isatty(fileno(stream)); f->rtmargin = OUT_RTMAR; return f; }
/*------------------------------------------------------------------------- * Function: sym_eval * * Purpose: Returns the variable value of a symbol if it has one. * * Return: Success: Ptr to a copy of the variable value. * * Failure: NIL * * Programmer: Robb Matzke * [email protected] * Dec 4 1996 * * Modifications: * Robb Matzke, 4 Feb 1997 * Fixed the arguments for the obj_deref() call. * * Robb Matzke, 2000-07-03 * The symbol `$*' evaluates to a list of all $N files for * consecutive N beginning at 1. *------------------------------------------------------------------------- */ static obj_t sym_eval (obj_t _self) { obj_t name_1=NIL, file_1=NIL, retval=NIL; obj_sym_t *self = MYCLASS(_self); /* If the symbol has a variable value then return it. */ if (MYCLASS(_self)->sym->var) { return obj_copy (MYCLASS(_self)->sym->var, SHALLOW); } /* The symbol `$*' evaluates to a list of the first consecutive files * bound to the $N symbols. */ if (!strcmp(self->sym->name, "$*")) { obj_t opands[1024], retval; int nopands, i; for (nopands=0; nopands<NELMTS(opands); nopands++) { obj_t symbol; char tmp[32]; sprintf(tmp, "$%d", nopands+1); symbol = obj_new(C_SYM, tmp); opands[nopands] = sym_vboundp(symbol); obj_dest(symbol); if (!opands[nopands] || C_FILE!=opands[nopands]->pub.cls) { /* We reached the last file or something isn't a file */ obj_dest(opands[nopands]); break; } } retval = V_make_list(nopands, opands); for (i=0; i<nopands; i++) { obj_dest(opands[i]); } return retval; } /* If the symbol exists in the first data file, then return * that SDO. */ name_1 = obj_new (C_SYM, "$1"); file_1 = MYCLASS(name_1)->sym->var; name_1 = obj_dest (name_1); if (file_1 && C_FILE==file_1->pub.cls) { retval = obj_deref (file_1, 1, &_self); return retval; } /* Symbol has no value. */ out_errorn ("eval: variable `%s' has no value", obj_name(_self)); return NIL; }
/*------------------------------------------------------------------------- * Function: ptr_apply * * Purpose: Applying a pointer type to an argument list consisting of * a single SILO database object (SDO) causes the object to * be cast to that type. * * Return: Success: Ptr to a new SDO object with the appropriate * type. * * Failure: NIL * * Programmer: Robb Matzke * [email protected] * Dec 6 1996 * * Modifications: * *------------------------------------------------------------------------- */ static obj_t ptr_apply (obj_t _self, obj_t args) { obj_t sdo=NIL, retval=NIL; if (1!=F_length(args)) { out_errorn ("typecast: wrong number of arguments"); return NIL; } sdo = obj_eval (cons_head (args)); retval = sdo_cast (sdo, _self); obj_dest (sdo); return retval; }
/*------------------------------------------------------------------------- * Function: lex_token * * Purpose: Figures out what token is next on the input stream. If * skipnl is non-zero then the new-line token is skipped. * * Return: Success: Token number, optional lexeme returned * through the LEXEME argument. * * Failure: TOK_INVALID * * Programmer: Robb Matzke * [email protected] * Dec 4 1996 * * Modifications: * * Robb Matzke, 3 Feb 1997 * Cleaned up error messages. * * Robb Matzke, 7 Feb 1997 * Added the `=' token. * * Robb Matzke, 7 Feb 1997 * The `*' and `?'characters are now legal as part of a symbol name * so we can give those pattern matching characters to the `ls' * command. * * Robb Matzke, 12 Mar 1997 * Since we don't have mathematical expressions yet, a numeric * constant is allowed to begin with a `-'. * * Robb Matzke, 2000-06-06 * Symbol names may include `-'. Something that starts with a `-' is * only a number if it's followed by a digit. * * Mark C. Miller, Mon Nov 9 18:08:05 PST 2009 * Added logic to support parsing of '#nnnnnn' dataset names, * but only when in '/.silo' dir. *------------------------------------------------------------------------- */ int lex_token(lex_t *f, char **lexeme, int skipnl) { int c, at, quote, inDotSiloDir=0; static const char *symcharsA = "_$/*?"; static const char *symcharsB = "_$/*?#"; const char *symchars = symcharsA; /* Return the current token if appropriate. */ if (f->tok && (!skipnl || TOK_EOL!=f->tok)) { if (lexeme) *lexeme = f->lexeme; return f->tok; } /* Skip leading space. */ f->prompt = skipnl ? LEX_PROMPT2 : LEX_PROMPT; while (EOF!=(c=lex_getc(f)) && '\n'!=c && isspace(c)) /*void*/; /* handle special case of leading '#' and see if we're in .silo dir */ if ('#'==c) { obj_t f1, val; DBfile *file; char cwd[1024]; f1 = obj_new (C_SYM, "$1"); val = sym_vboundp (f1); f1 = obj_dest (f1); if (NULL!=(file=file_file(val)) && DBGetDir(file, cwd)>=0 && !strncmp(cwd,"/.silo",6)) { inDotSiloDir = 1; symchars = symcharsB; } } /* Store the next token. */ if (EOF==c) { f->lexeme[0] = '\0'; f->tok = EOF; } else if ('\n'==c) { if (skipnl) { f->tok = lex_token(f, NULL, true); } else { f->lexeme[0] = '\n'; f->lexeme[1] = '\0'; f->tok = TOK_EOL; } } else if ('#'==c && !inDotSiloDir) { while (EOF!=(c=lex_getc(f)) && '\n'!=c) /*void*/; lex_ungetc(f, c); return lex_token(f, lexeme, skipnl); } else if ('>'==c) { c = lex_getc(f); if ('>'==c) { strcpy(f->lexeme, ">>"); f->tok = TOK_RTRT; } else { lex_ungetc(f, c); strcpy(f->lexeme, ">"); f->tok = TOK_RT; } } else if (strchr("|.()[]{}:,=", c)) { f->lexeme[0] = c; f->lexeme[1] = '\0'; f->tok = c; } else if (isalpha(c) || strchr(symchars,c)) { /* A symbol. */ f->lexeme[0] = c; f->lexeme[1] = '\0'; at = 1; while (EOF!=(c=lex_getc(f)) && (isalpha(c) || isdigit(c) || strchr(symchars, c))) { if (at+1<sizeof(f->lexeme)) { f->lexeme[at++] = c; f->lexeme[at] = '\0'; } } lex_ungetc(f, c); f->tok = TOK_SYM; } else if ('-'==c) { /* Could be a number or a symbol */ f->lexeme[0] = c; f->lexeme[1] = '\0'; if (EOF!=(c=lex_getc(f)) && ('.'==c || isdigit(c))) { f->lexeme[1] = c; f->lexeme[2] = '\0'; at = 2; while (EOF!=(c=lex_getc(f)) && (isdigit(c) || strchr("+-.eE", c))) { if (at+1<sizeof(f->lexeme)) { f->lexeme[at++] = c; f->lexeme[at] = '\0'; } } lex_ungetc(f, c); f->tok = TOK_NUM; } else { at=1; while (EOF!=c && (isalpha(c) || isdigit(c) || strchr("_$/*?-", c))) { if (at+1<sizeof(f->lexeme)) { f->lexeme[at++] = c; f->lexeme[at] = '\0'; } c = lex_getc(f); } lex_ungetc(f, c); f->tok = TOK_SYM; } } else if ('-'==c || isdigit(c)) { /* A number */ f->lexeme[0] = c; f->lexeme[1] = '\0'; at = 1; while (EOF!=(c=lex_getc(f)) && (isdigit(c) || strchr("+-.eE", c))) { if (at+1<sizeof(f->lexeme)) { f->lexeme[at++] = c; f->lexeme[at] = '\0'; } } lex_ungetc(f, c); f->tok = TOK_NUM; } else if ('"'==c || '\''==c) { /* A string */ quote = c; at = 0; f->lexeme[0] = '\0'; while (EOF!=(c=lex_getc(f)) && quote!=c && '\n'!=c) { if ('\\'==c) { switch ((c=lex_getc(f))) { case 'b': c = '\b'; break; case 'n': c = '\n'; break; case 'r': c = '\r'; break; case 't': c = '\t'; break; case EOF: c = '\\'; break; default: if (c>='0' && c<='7') { int c2 = lex_getc(f); if (c2>='0' && c2<='7') { int c3 = lex_getc(f); if (c3>='0' && c3<='7') { c = ((c-'0')*8+c2-'0')*8+c3-'0'; } else { lex_ungetc(f, c3); c = (c-'0')*8+c2-'0'; } } else { lex_ungetc(f, c2); c -= '0'; } } break; } } if (at+1<sizeof(f->lexeme)) { f->lexeme[at++] = c; f->lexeme[at] = '\0'; } } if ('\n'==c) { out_errorn("linefeed inside string constant (truncated at EOL)"); lex_ungetc(f, c); } else if (c<0) { out_errorn("EOF inside string constant (truncated at EOF)"); } f->tok = TOK_STR; } else { /* Invalid character. Don't print an error message since a * syntax error will result in the parser anyway. */ f->lexeme[0] = c; f->lexeme[1] = '\0'; f->tok = TOK_INVALID; } if (lexeme) *lexeme = f->lexeme; return f->tok; }
/*------------------------------------------------------------------------- * Function: parse_subscripts * * Purpose: Parses a subscripted expression. The subscript is * enclosed in `[' and `]' after the main expression. * * Return: Success: Ptr to the expression. * * Failure: &ErrorCell * * Programmer: Robb Matzke * [email protected] * Jan 3 1997 * * Modifications: * * Robb Matzke, 4 Feb 1997 * The contents of the `[]' can now be a comma-separated list * of expressions. * *------------------------------------------------------------------------- */ static obj_t parse_selection (lex_t *f, int skipnl) { obj_t retval=NIL; /*first argument, left of `[' */ obj_t tmp=NIL; /*a subscript argument */ obj_t operands=NIL; /*operand list */ int septok; /*separator token */ retval = parse_dot (f, skipnl); if (&ErrorCell==retval) return &ErrorCell; /* * Zero or more array selectors. */ while ('['==lex_token (f, NULL, skipnl)) { lex_consume (f); operands = obj_new (C_CONS, retval, NIL); retval = NIL; /* * One or more comma-separated expressions per selection. */ for (;;) { tmp = parse_expr (f, skipnl); if (&ErrorCell==tmp) { obj_dest (retval); return &ErrorCell; } operands = obj_new (C_CONS, tmp, operands); /*push*/ septok = lex_token (f, NULL, skipnl); if (','==septok) { lex_consume (f); } else if (']'==septok) { lex_consume (f); break; } else { out_errorn ("expected ']'"); obj_dest (operands); return &ErrorCell; } } /* * Put the operands in the correct order. */ tmp = F_reverse (operands); obj_dest (operands); operands = tmp; tmp = NIL; /* * Add the function name `Dot' to the beginning of the * list. */ retval = obj_new (C_CONS, obj_new (C_SYM, "Dot"), operands); } return retval; }
/*------------------------------------------------------------------------- * Function: parse_term * * Purpose: Parses a term which is a symbol, a string, or a number. * * Return: Success: Ptr to the term object or NIL * * Failure: &ErrorCell * * Programmer: Robb Matzke * [email protected] * Dec 4 1996 * * Modifications: * * Robb Matzke, 7 Feb 1997 * If the first thing after a parenthesis is a symbol which has a * built in function (BIF) as its f-value, and the BIF has the * lex_special property, then we call lex_special() to prepare the * next token. * * Robb Matzke, 26 Aug 1997 * The term `.' means current working directory. *------------------------------------------------------------------------- */ static obj_t parse_term (lex_t *f, int skipnl) { char *lexeme; obj_t retval=&ErrorCell, opstack=NIL, tmp=NIL, fval=NIL; int tok, nargs; switch ((tok=lex_token(f, &lexeme, skipnl))) { case TOK_DOT: retval = obj_new (C_SYM, lexeme); lex_consume (f); break; case TOK_SYM: if (!strcmp (lexeme, "nil")) { retval = NIL; } else { retval = obj_new (C_SYM, lexeme); } lex_consume (f); break; case TOK_NUM: retval = obj_new (C_NUM, lexeme); lex_consume (f); break; case TOK_STR: retval = obj_new (C_STR, lexeme); lex_consume (f); break; case TOK_LTPAREN: nargs = 0; lex_consume (f); while (TOK_RTPAREN!=(tok=lex_token(f, NULL, true)) && TOK_EOF!=tok) { /* * If the first token after the left paren is a symbol, and * the symbol has a BIF f-value, and the BIF has the lex_special * attribute, then call lex_special(). */ if (0==nargs++ && TOK_SYM==tok) { tmp = obj_new (C_SYM, f->lexeme); lex_consume (f); fval = sym_fboundp (tmp); if (bif_lex_special (fval)) lex_special (f, true); fval = obj_dest (fval); } else { tmp = parse_expr (f, true); } if (&ErrorCell==tmp) { opstack = obj_dest (opstack); goto done; } opstack = obj_new (C_CONS, tmp, opstack); } if (TOK_RTPAREN!=tok) { out_errorn ("right paren expected near end of input"); opstack = obj_dest (opstack); goto done; } lex_consume (f); retval = F_reverse (opstack); opstack = obj_dest (opstack); break; case TOK_LTCURLY: /* * A list of items inside curly braces `{A B ... Z}' is just short for * `(Quote A B ... Z)' and `Quote' is like the LISP `quote' function in * that (Quote X) returns X without trying to evaluate it. People tend * to use commas, so we accept commas between items. */ lex_consume (f); while (TOK_RTCURLY!=(tok=lex_token(f, NULL, true)) && TOK_EOF!=tok) { tmp = parse_expr (f, true); if (&ErrorCell==tmp) { opstack = obj_dest (opstack); goto done; } opstack = obj_new (C_CONS, tmp, opstack); if (TOK_COMMA==lex_token(f, NULL, true)) lex_consume (f); } if (TOK_RTCURLY!=tok) { out_errorn ("right curly brace expected near end of input"); opstack = obj_dest (opstack); goto done; } lex_consume (f); retval = F_reverse (opstack); opstack = obj_dest (opstack); retval = obj_new (C_CONS, obj_new (C_SYM, "Quote"), retval); break; } done: return retval; }
/*------------------------------------------------------------------------- * Function: parse_stmt * * Purpose: Parses a statement which is a function name followed by * zero or more arguments. * * Return: Success: Ptr to parse tree. * * Failure: NIL, input consumed through end of line. * * Programmer: Robb Matzke * [email protected] * Dec 4 1996 * * Modifications: * * Robb Matzke, 11 Dec 1996 * If IMPLIED_PRINT is true then wrap the input in a call to the * `print' function if it isn't already obviously a call to `print'. * * Robb Matzke, 20 Jan 1997 * Turn off handling of SIGINT during parsing. * * Robb Matzke, 7 Feb 1997 * If the first thing on the line is a symbol which has a built in * function (BIF) as its f-value, and the BIF has the lex_special * property, then we call lex_special() to prepare the next token. * * Robb Matzke, 2000-06-28 * Signal handlers are registered with sigaction() since its behavior * is more consistent. * *------------------------------------------------------------------------- */ obj_t parse_stmt (lex_t *f, int implied_print) { char *lexeme, buf[1024], *s, *fmode; int tok, i; obj_t head=NIL, opstack=NIL, b1=NIL, retval=NIL, tmp=NIL; struct sigaction new_action, old_action; /* SIGINT should have the default action while we're parsing */ new_action.sa_handler = SIG_DFL; sigemptyset(&new_action.sa_mask); new_action.sa_flags = SA_RESTART; sigaction(SIGINT, &new_action, &old_action); tok = lex_token (f, &lexeme, false); /* * At the end of the file, return `(exit)'. */ if (TOK_EOF==tok) { lex_consume (f); if (f->f && isatty (fileno (f->f))) { printf ("exit\n"); retval = obj_new (C_CONS, obj_new (C_SYM, "exit"), NIL); goto done; } else { retval = obj_new (C_SYM, "__END__"); goto done; } } /* * For an empty line, eat the linefeed token and try again. */ if (TOK_EOL==tok) { lex_consume (f); retval = parse_stmt (f, implied_print); goto done; } /* * A statement begins with a function name. If the first token * is not a symbol then assume `print'. */ if (implied_print && TOK_SYM==tok) { head = obj_new (C_SYM, lexeme); if ((tmp=sym_fboundp (head))) { tmp = obj_dest (tmp); lex_consume (f); } else { obj_dest (head); head = obj_new (C_SYM, "print"); } } else if (implied_print) { head = obj_new (C_SYM, "print"); } else { head = &ErrorCell ; /*no function yet*/ } /* * Some functions take a weird first argument that isn't really a * normal token. Like `open' which wants the name of a file. We * call lex_special() to try to get such a token if it appears * next. */ if (head && &ErrorCell!=head && (tmp=sym_fboundp(head))) { if (bif_lex_special (tmp)) lex_special (f, false); tmp = obj_dest (tmp); } /* * Read the arguments... */ while (&ErrorCell!=(b1=parse_expr(f, false))) { opstack = obj_new(C_CONS, b1, opstack); } /* * Construct a function call which is the HEAD applied to the * arguments on the operand stack. */ b1 = F_reverse (opstack); opstack = obj_dest (opstack); if (&ErrorCell==head) { head = NIL; if (1==F_length(b1)) { retval = obj_copy (cons_head (b1), SHALLOW); b1 = obj_dest (b1); } else { retval = b1; b1 = NIL; } } else { retval = F_cons (head, b1); head = obj_dest (head); b1 = obj_dest (b1); } /* * A statement can end with `>' or `>>' followed by the name of * a file, or `|' followed by an unquoted shell command. Leading * and trailing white space is stripped from the file or command. */ tok = lex_token (f, &lexeme, false); if (TOK_RT==tok || TOK_RTRT==tok || TOK_PIPE==tok) { lex_consume (f); if (NULL==lex_gets (f, buf, sizeof(buf))) { out_errorn ("file name required after `%s' operator", lexeme); goto error; } lex_set (f, TOK_EOL, "\n"); for (s=buf; isspace(*s); s++) /*void*/; for (i=strlen(s)-1; i>=0 && isspace(s[i]); --i) s[i] = '\0'; if (!*s) { out_errorn ("file name required after `%s' operator", lexeme); goto error; } switch (tok) { case TOK_RT: lexeme = "Redirect"; fmode = "w"; break; case TOK_RTRT: lexeme = "Redirect"; fmode = "a"; break; case TOK_PIPE: lexeme = "Pipe"; fmode = "w"; break; default: abort(); } retval = obj_new (C_CONS, obj_new (C_SYM, lexeme), obj_new (C_CONS, retval, obj_new (C_CONS, obj_new (C_STR, s), obj_new (C_CONS, obj_new (C_STR, fmode), NIL)))); } /* * We should be at the end of a line. */ tok = lex_token (f, &lexeme, false); if (TOK_EOL!=tok && TOK_EOF!=tok) { s = lex_gets (f, buf, sizeof(buf)); if (s && strlen(s)>0 && '\n'==s[strlen(s)-1]) s[strlen(s)-1] = '\0'; out_errorn ("syntax error before: %s%s", lexeme, s?s:""); lex_consume(f); goto error; } else { lex_consume(f); } done: sigaction(SIGINT, &old_action, NULL); return retval; error: if (head) head = obj_dest (head); if (opstack) opstack = obj_dest (opstack); if (retval) retval = obj_dest (retval); sigaction(SIGINT, &old_action, NULL); return NIL; }
