extern int yylex() { static bool dollar = FALSE; bool saw_meta = FALSE; int c; size_t i; /* The purpose of all these local assignments is to */ const char *meta; /* allow optimizing compilers like gcc to load these */ char *buf = realbuf; /* values into registers. On a sparc this is a */ YYSTYPE *y = &yylval; /* win, in code size *and* execution time */ if (errset) { errset = FALSE; return '\n'; } /* rc variable-names may contain only alnum, '*' and '_', so use dnw if we are scanning one. */ meta = (dollar ? dnw : nw); if (newline) { --lineno; /* slight space optimization; nextline() always increments lineno */ nextline(); newline = FALSE; } top: while ((c = gchar()) == ' ' || c == '\t') w = NW; if (c != '(') dollar = FALSE; if (c == EOF) return END; if (!meta[(unsigned char) c]) { /* it's a word or keyword. */ checkfreecaret; w = RW; i = 0; read: do { buf[i++] = c; if (c == '?' || c == '[' || c == '*') saw_meta = TRUE; if (i >= bufsize) buf = realbuf = erenew_arr(char, buf, bufsize *= 2); } while ((c = gchar()) != EOF && !meta[(unsigned char) c]); while (c == '\\') { if ((c = gchar()) == '\n') { nextline(); c = ' '; /* Pretend a space was read */ break; } else { bs: if (meta != dnw) { /* all words but varnames may have a bslash */ buf[i++] = '\\'; if (i >= bufsize) buf = realbuf = erenew_arr(char, buf, bufsize *= 2); if (!meta[(unsigned char) c]) goto read; } else { ugchar(c); c = '\\'; break; } }
static void getpair(int c) { int n; fd_left = fd_right = UNSET; if (c != '[') { ugchar(c); return; } if ((unsigned int) (n = gchar() - '0') > 9) { scanerror("expected digit after '['"); return; } while ((unsigned int) (c = gchar() - '0') <= 9) n = n * 10 + c; fd_left = n; c += '0'; switch (c) { default: scanerror("expected '=' or ']' after digit"); return; case ']': return; case '=': if ((unsigned int) (n = gchar() - '0') > 9) { if (n != ']' - '0') { scanerror("expected digit or ']' after '='"); return; } fd_right = CLOSED; } else { while ((unsigned int) (c = gchar() - '0') <= 9) n = n * 10 + c; if (c != ']' - '0') { scanerror("expected ']' after digit"); return; } fd_right = n; } } }
extern int yylex() { static bool dollar = FALSE; bool saw_meta = FALSE; int c; SIZE_T i; /* The purpose of all these local assignments is to */ char *meta; /* allow optimizing compilers like gcc to load these */ char *buf = realbuf; /* values into registers. On a sparc this is a */ YYSTYPE *y = &yylval; /* win, in code size *and* execution time */ if (errset) { errset = FALSE; return '\n'; } /* rc variable-names may contain only alnum, '*' and '_', so use dnw if we are scanning one. */ meta = (dollar ? dnw : nw); dollar = FALSE; if (newline) { --lineno; /* slight space optimization; print_prompt2() always increments lineno */ print_prompt2(); newline = FALSE; } top: while ((c = gchar()) == ' ' || c == '\t') w = NW; if (c == EOF) return END; if (!meta[(unsigned char) c]) { /* it's a word or keyword. */ checkfreecaret; w = RW; i = 0; read: do { buf[i++] = c; if (c == '?' || c == '[' || c == '*') saw_meta = TRUE; if (i >= bufsize) buf = realbuf = erealloc(buf, bufsize *= 2); } while ((c = gchar()) != EOF && !meta[(unsigned char) c]); while (c == '\\') { if ((c = gchar()) == '\n') { print_prompt2(); c = ' '; /* Pretend a space was read */ break; } else { bs: if (meta != dnw) { /* all words but varnames may have a bslash */ buf[i++] = '\\'; if (i >= bufsize) buf = realbuf = erealloc(buf, bufsize *= 2); if (!meta[(unsigned char) c]) goto read; } else { ugchar(c); c = '\\'; break; } } } ugchar(c); buf[i] = '\0'; w = KW; if (i == 2) { if (*buf == 'i' && buf[1] == 'f') return IF; if (*buf == 'f' && buf[1] == 'n') return FN; if (*buf == 'i' && buf[1] == 'n') return IN; } if (streq(buf, "for")) return FOR; if (streq(buf, "else")) return ELSE; if (streq(buf, "switch")) return SWITCH; if (streq(buf, "while")) return WHILE; if (streq(buf, "case")) return CASE; w = RW; y->word.w = ncpy(buf); if (saw_meta) { char *r, *s; y->word.m = nalloc(strlen(buf) + 1); for (r = buf, s = y->word.m; *r != '\0'; r++, s++) *s = (*r == '?' || *r == '[' || *r == '*'); } else { y->word.m = NULL; } return WORD; } if (c == '`' || c == '!' || c == '@' || c == '~' || c == '$' || c == '\'') { checkfreecaret; if (c == '!' || c == '@' || c == '~') w = KW; } switch (c) { case '!': return BANG; case '@': return SUBSHELL; case '~': return TWIDDLE; case '`': c = gchar(); if (c == '`') return BACKBACK; ugchar(c); return '`'; case '$': dollar = TRUE; c = gchar(); if (c == '#') return COUNT; if (c == '^') return FLAT; ugchar(c); return '$'; case '\'': w = RW; i = 0; do { buf[i++] = c; if (c == '\n') print_prompt2(); if (c == EOF) { w = NW; scanerror("eof in quoted string"); return HUH; } if (i >= bufsize) buf = realbuf = erealloc(buf, bufsize *= 2); } while ((c = gchar()) != '\'' || (c = gchar()) == '\''); /* quote "'" thus: 'how''s it going?' */ ugchar(c); buf[i] = '\0'; y->word.w = ncpy(buf); y->word.m = NULL; return WORD; case '\\': if ((c = gchar()) == '\n') { print_prompt2(); goto top; /* Pretend it was just another space. */ } ugchar(c); c = '\\'; checkfreecaret; c = gchar(); i = 0; goto bs; case '(': if (w == RW) /* SUB's happen only after real words, not keyowrds, so if () and while () work */ c = SUB; w = NW; return c; case '#': while ((c = gchar()) != '\n') /* skip comment until newline */ if (c == EOF) return END; /* FALLTHROUGH */ case '\n': lineno++; newline = TRUE; /* FALLTHROUGH */ case ';': case '^': case ')': case '=': case '{': case '}': w = NW; return c; case '&': w = NW; c = gchar(); if (c == '&') return ANDAND; ugchar(c); return '&'; case '|': w = NW; c = gchar(); if (c == '|') return OROR; getpair(c); if (errset) return HUH; if ((y->pipe.left = fd_left) == UNSET) y->pipe.left = 1; /* default to fd 1 */ if ((y->pipe.right = fd_right) == UNSET) y->pipe.right = 0; /* default to fd 0 */ if (y->pipe.right == CLOSED) { scanerror("expected digit after '='"); /* can't close a pipe */ return HUH; } return PIPE; case '>': c = gchar(); if (c == '>') { c = gchar(); y->redir.type = rAppend; } else y->redir.type = rCreate; y->redir.fd = 1; goto common; case '<': c = gchar(); if (c == '<') { c = gchar(); if (c == '<') { c = gchar(); y->redir.type = rHerestring; } else { y->redir.type = rHeredoc; } } else y->redir.type = rFrom; y->redir.fd = 0; common: w = NW; getpair(c); if (errset) return HUH; if (fd_right == UNSET) { /* redirection, not dup */ if (fd_left != UNSET) { y->redir.fd = fd_left; return SREDIR; } return (y->redir.type == rFrom || y->redir.type == rCreate) ? REDIR : SREDIR; } else { /* dup; recast yylval */ y->dup.type = y->redir.type; y->dup.left = fd_left; y->dup.right = fd_right; return DUP; } default: w = NW; return c; /* don't know what it is, let yacc barf on it */ } }
/* Read an S-expression */ long l_read(void) { long s, v, t; char token[32]; char ch, i; /* skip spaces */ if ((ch = skip_space()) < 0){ /* eof */ return TAG_EOF; } else if (ch == ';'){ /* comment */ while (gchar() != '\n') ; return -1; } #ifdef ZX81 else if (ch == '\"'){ /* quote macro */ #else else if (ch == '\''){ /* quote macro */ #endif if ((t = l_read()) < 0) return -1; if (t == TAG_EOF) return err_msg(errmsg_eof, 0, 0); t = l_cons(t, TAG_NIL); s = l_cons((TAG_SYMB|KW_QUOTE), t); } else if (ch != '('){ /* t, nil, symbol, or integer */ token[0] = ch; for (i = 1; ; i++){ ch = gchar(); if (isspace(ch) || iscntrl(ch) || (ch < 0) || (ch == ';') || (ch == '(') || (ch == ')')){ ugchar(ch); token[i] = '\0'; /* Changed to permint the definition of "1+" and "1-" */ if ((isdigit((char)token[0]) && (token[1] != '+') && (token[1] != '-')) /* if (isdigit((char)token[0]) */ || ((token[0] == '-') && isdigit((char)token[1])) || ((token[0] == '+') && isdigit((char)token[1]))){ /* integer */ s = int_make_l(atol(token)); #ifdef SCHEME } else if (strcmp(token, "#f") == 0){ /* nil */ s = TAG_NIL; } else if (strcmp(token, "#t") == 0){ /* t */ s = TAG_T; #else } else if (strcmp(token, "nil") == 0){ /* nil */ s = TAG_NIL; } else if (strcmp(token, "t") == 0){ /* t */ s = TAG_T; #endif } else { /* symbol */ s = TAG_SYMB | symb_make(token); } break; } token[i] = ch; } } else /* ch == '(' */ { /* list */ if ((ch = skip_space()) < 0){ return err_msg(errmsg_eof, 0, 0); } else if (ch == ')'){ s = TAG_NIL; /* "()" = nil */ } else { ugchar(ch); if ((t = l_read()) < 0) return err_msg(errmsg_eof, 0, 0); if (t == TAG_EOF) return -1; if ((s = v = l_cons(t, TAG_NIL)) < 0) return -1; if (gc_protect(s) < 0) return -1; for (;;){ if ((ch = skip_space()) < 0) /* look ahead next char */ return err_msg(errmsg_eof, 0, 0); if (ch == ')') break; ugchar(ch); if ((t = l_read()) < 0) return -1; if (t == TAG_EOF) return err_msg(errmsg_eof, 0, 0); if ((t = l_cons(t, TAG_NIL)) < 0) return -1; rplacd(v, t); v = l_cdr(v); } gc_unprotect(s); } } return s; } char skip_space(void) { char ch; for (;;){ if ((ch = gchar()) < 0) return -1; /* end-of-file */ if (!isspace(ch) && !iscntrl(ch)) break; } return ch; }