4.4BSD/usr/src/contrib/perl-4.036/toke.c
/* $RCSfile: toke.c,v $$Revision: 4.0.1.9 $$Date: 1993/02/05 19:48:43 $
*
* Copyright (c) 1991, Larry Wall
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
*
* $Log: toke.c,v $
* Revision 4.0.1.9 1993/02/05 19:48:43 lwall
* patch36: now detects ambiguous use of filetest operators as well as unary
* patch36: fixed ambiguity on - within tr///
*
* Revision 4.0.1.8 92/06/23 12:33:45 lwall
* patch35: bad interaction between backslash and hyphen in tr///
*
* Revision 4.0.1.7 92/06/11 21:16:30 lwall
* patch34: expectterm incorrectly set to indicate start of program or block
*
* Revision 4.0.1.6 92/06/08 16:03:49 lwall
* patch20: an EXPR may now start with a bareword
* patch20: print $fh EXPR can now expect term rather than operator in EXPR
* patch20: added ... as variant on ..
* patch20: new warning on spurious backslash
* patch20: new warning on missing $ for foreach variable
* patch20: "foo"x1024 now legal without space after x
* patch20: new warning on print accidentally used as function
* patch20: tr/stuff// wasn't working right
* patch20: 2. now eats the dot
* patch20: <@ARGV> now notices @ARGV
* patch20: tr/// now lets you say \-
*
* Revision 4.0.1.5 91/11/11 16:45:51 lwall
* patch19: default arg for shift was wrong after first subroutine definition
*
* Revision 4.0.1.4 91/11/05 19:02:48 lwall
* patch11: \x and \c were subject to double interpretation in regexps
* patch11: prepared for ctype implementations that don't define isascii()
* patch11: nested list operators could miscount parens
* patch11: once-thru blocks didn't display right in the debugger
* patch11: sort eval "whatever" didn't work
* patch11: underscore is now allowed within literal octal and hex numbers
*
* Revision 4.0.1.3 91/06/10 01:32:26 lwall
* patch10: m'$foo' now treats string as single quoted
* patch10: certain pattern optimizations were botched
*
* Revision 4.0.1.2 91/06/07 12:05:56 lwall
* patch4: new copyright notice
* patch4: debugger lost track of lines in eval
* patch4: //o and s///o now optimize themselves fully at runtime
* patch4: added global modifier for pattern matches
*
* Revision 4.0.1.1 91/04/12 09:18:18 lwall
* patch1: perl -de "print" wouldn't stop at the first statement
*
* Revision 4.0 91/03/20 01:42:14 lwall
* 4.0 baseline.
*
*/
#include "EXTERN.h"
#include "perl.h"
#include "perly.h"
static void set_csh();
#ifdef I_FCNTL
#include <fcntl.h>
#endif
#ifdef I_SYS_FILE
#include <sys/file.h>
#endif
#ifdef f_next
#undef f_next
#endif
/* which backslash sequences to keep in m// or s// */
static char *patleave = "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}";
char *reparse; /* if non-null, scanident found ${foo[$bar]} */
void checkcomma();
#ifdef CLINE
#undef CLINE
#endif
#define CLINE (cmdline = (curcmd->c_line < cmdline ? curcmd->c_line : cmdline))
#ifdef atarist
#define PERL_META(c) ((c) | 128)
#else
#define META(c) ((c) | 128)
#endif
#define RETURN(retval) return (bufptr = s,(int)retval)
#define OPERATOR(retval) return (expectterm = TRUE,bufptr = s,(int)retval)
#define TERM(retval) return (CLINE, expectterm = FALSE,bufptr = s,(int)retval)
#define LOOPX(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)LOOPEX)
#define FTST(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)FILETEST)
#define FUN0(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC0)
#define FUN1(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC1)
#define FUN2(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2)
#define FUN2x(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2x)
#define FUN3(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC3)
#define FUN4(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC4)
#define FUN5(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC5)
#define FL(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST)
#define FL2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST2)
#define HFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)HSHFUN)
#define HFUN3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)HSHFUN3)
#define LFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LVALFUN)
#define AOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)ADDOP)
#define MOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)MULOP)
#define EOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)EQOP)
#define ROP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)RELOP)
#define FOP(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP)
#define FOP2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP2)
#define FOP3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP3)
#define FOP4(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP4)
#define FOP22(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP22)
#define FOP25(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP25)
static char *last_uni;
/* This bit of chicanery makes a unary function followed by
* a parenthesis into a function with one argument, highest precedence.
*/
#define UNI(f) return(yylval.ival = f, \
expectterm = TRUE, \
bufptr = s, \
last_uni = oldbufptr, \
(*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
/* This does similarly for list operators, merely by pretending that the
* paren came before the listop rather than after.
*/
#ifdef atarist
#define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
(*s = (char) PERL_META('('), bufptr = oldbufptr, '(') : \
(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
#else
#define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \
(*s = (char) META('('), bufptr = oldbufptr, '(') : \
(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
#endif
/* grandfather return to old style */
#define OLDLOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP)
char *
skipspace(s)
register char *s;
{
while (s < bufend && isSPACE(*s))
s++;
return s;
}
void
check_uni() {
char *s;
char ch;
if (oldoldbufptr != last_uni)
return;
while (isSPACE(*last_uni))
last_uni++;
for (s = last_uni; isALNUM(*s) || *s == '-'; s++) ;
ch = *s;
*s = '\0';
warn("Warning: Use of \"%s\" without parens is ambiguous", last_uni);
*s = ch;
}
#ifdef CRIPPLED_CC
#undef UNI
#undef LOP
#define UNI(f) return uni(f,s)
#define LOP(f) return lop(f,s)
int
uni(f,s)
int f;
char *s;
{
yylval.ival = f;
expectterm = TRUE;
bufptr = s;
last_uni = oldbufptr;
if (*s == '(')
return FUNC1;
s = skipspace(s);
if (*s == '(')
return FUNC1;
else
return UNIOP;
}
int
lop(f,s)
int f;
char *s;
{
CLINE;
if (*s != '(')
s = skipspace(s);
if (*s == '(') {
#ifdef atarist
*s = PERL_META('(');
#else
*s = META('(');
#endif
bufptr = oldbufptr;
return '(';
}
else {
yylval.ival=f;
expectterm = TRUE;
bufptr = s;
return LISTOP;
}
}
#endif /* CRIPPLED_CC */
int
yylex()
{
register char *s = bufptr;
register char *d;
register int tmp;
static bool in_format = FALSE;
static bool firstline = TRUE;
extern int yychar; /* last token */
oldoldbufptr = oldbufptr;
oldbufptr = s;
retry:
#ifdef YYDEBUG
if (debug & 1)
if (index(s,'\n'))
fprintf(stderr,"Tokener at %s",s);
else
fprintf(stderr,"Tokener at %s\n",s);
#endif
#ifdef BADSWITCH
if (*s & 128) {
if ((*s & 127) == '(') {
*s++ = '(';
oldbufptr = s;
}
else if ((*s & 127) == '}') {
*s++ = '}';
RETURN('}');
}
else
warn("Unrecognized character \\%03o ignored", *s++ & 255);
goto retry;
}
#endif
switch (*s) {
default:
if ((*s & 127) == '(') {
*s++ = '(';
oldbufptr = s;
}
else if ((*s & 127) == '}') {
*s++ = '}';
RETURN('}');
}
else
warn("Unrecognized character \\%03o ignored", *s++ & 255);
goto retry;
case 4:
case 26:
goto fake_eof; /* emulate EOF on ^D or ^Z */
case 0:
if (!rsfp)
RETURN(0);
if (s++ < bufend)
goto retry; /* ignore stray nulls */
last_uni = 0;
if (firstline) {
firstline = FALSE;
if (minus_n || minus_p || perldb) {
str_set(linestr,"");
if (perldb) {
char *getenv();
char *pdb = getenv("PERLDB");
str_cat(linestr, pdb ? pdb : "require 'perldb.pl'");
str_cat(linestr, ";");
}
if (minus_n || minus_p) {
str_cat(linestr,"line: while (<>) {");
if (minus_l)
str_cat(linestr,"chop;");
if (minus_a)
str_cat(linestr,"@F=split(' ');");
}
oldoldbufptr = oldbufptr = s = str_get(linestr);
bufend = linestr->str_ptr + linestr->str_cur;
goto retry;
}
}
if (in_format) {
bufptr = bufend;
yylval.formval = load_format();
in_format = FALSE;
oldoldbufptr = oldbufptr = s = str_get(linestr) + 1;
bufend = linestr->str_ptr + linestr->str_cur;
OPERATOR(FORMLIST);
}
curcmd->c_line++;
#ifdef CRYPTSCRIPT
cryptswitch();
#endif /* CRYPTSCRIPT */
do {
if ((s = str_gets(linestr, rsfp, 0)) == Nullch) {
fake_eof:
if (rsfp) {
if (preprocess)
(void)mypclose(rsfp);
else if ((FILE*)rsfp == stdin)
clearerr(stdin);
else
(void)fclose(rsfp);
rsfp = Nullfp;
}
if (minus_n || minus_p) {
str_set(linestr,minus_p ? ";}continue{print" : "");
str_cat(linestr,";}");
oldoldbufptr = oldbufptr = s = str_get(linestr);
bufend = linestr->str_ptr + linestr->str_cur;
minus_n = minus_p = 0;
goto retry;
}
oldoldbufptr = oldbufptr = s = str_get(linestr);
str_set(linestr,"");
RETURN(';'); /* not infinite loop because rsfp is NULL now */
}
if (doextract && *linestr->str_ptr == '#')
doextract = FALSE;
} while (doextract);
oldoldbufptr = oldbufptr = bufptr = s;
if (perldb) {
STR *str = Str_new(85,0);
str_sset(str,linestr);
astore(stab_xarray(curcmd->c_filestab),(int)curcmd->c_line,str);
}
#ifdef DEBUG
if (firstline) {
char *showinput();
s = showinput();
}
#endif
bufend = linestr->str_ptr + linestr->str_cur;
if (curcmd->c_line == 1) {
if (*s == '#' && s[1] == '!') {
if (!in_eval && !instr(s,"perl") && instr(origargv[0],"perl")) {
char **newargv;
char *cmd;
s += 2;
if (*s == ' ')
s++;
cmd = s;
while (s < bufend && !isSPACE(*s))
s++;
*s++ = '\0';
while (s < bufend && isSPACE(*s))
s++;
if (s < bufend) {
Newz(899,newargv,origargc+3,char*);
newargv[1] = s;
while (s < bufend && !isSPACE(*s))
s++;
*s = '\0';
Copy(origargv+1, newargv+2, origargc+1, char*);
}
else
newargv = origargv;
newargv[0] = cmd;
execv(cmd,newargv);
fatal("Can't exec %s", cmd);
}
}
else {
while (s < bufend && isSPACE(*s))
s++;
if (*s == ':') /* for csh's that have to exec sh scripts */
s++;
}
}
goto retry;
case ' ': case '\t': case '\f': case '\r': case 013:
s++;
goto retry;
case '#':
if (preprocess && s == str_get(linestr) &&
s[1] == ' ' && (isDIGIT(s[2]) || strnEQ(s+2,"line ",5)) ) {
while (*s && !isDIGIT(*s))
s++;
curcmd->c_line = atoi(s)-1;
while (isDIGIT(*s))
s++;
d = bufend;
while (s < d && isSPACE(*s)) s++;
s[strlen(s)-1] = '\0'; /* wipe out newline */
if (*s == '"') {
s++;
s[strlen(s)-1] = '\0'; /* wipe out trailing quote */
}
if (*s)
curcmd->c_filestab = fstab(s);
else
curcmd->c_filestab = fstab(origfilename);
oldoldbufptr = oldbufptr = s = str_get(linestr);
}
/* FALL THROUGH */
case '\n':
if (in_eval && !rsfp) {
d = bufend;
while (s < d && *s != '\n')
s++;
if (s < d)
s++;
if (in_format) {
bufptr = s;
yylval.formval = load_format();
in_format = FALSE;
oldoldbufptr = oldbufptr = s = bufptr + 1;
TERM(FORMLIST);
}
curcmd->c_line++;
}
else {
*s = '\0';
bufend = s;
}
goto retry;
case '-':
if (s[1] && isALPHA(s[1]) && !isALPHA(s[2])) {
s++;
last_uni = oldbufptr;
switch (*s++) {
case 'r': FTST(O_FTEREAD);
case 'w': FTST(O_FTEWRITE);
case 'x': FTST(O_FTEEXEC);
case 'o': FTST(O_FTEOWNED);
case 'R': FTST(O_FTRREAD);
case 'W': FTST(O_FTRWRITE);
case 'X': FTST(O_FTREXEC);
case 'O': FTST(O_FTROWNED);
case 'e': FTST(O_FTIS);
case 'z': FTST(O_FTZERO);
case 's': FTST(O_FTSIZE);
case 'f': FTST(O_FTFILE);
case 'd': FTST(O_FTDIR);
case 'l': FTST(O_FTLINK);
case 'p': FTST(O_FTPIPE);
case 'S': FTST(O_FTSOCK);
case 'u': FTST(O_FTSUID);
case 'g': FTST(O_FTSGID);
case 'k': FTST(O_FTSVTX);
case 'b': FTST(O_FTBLK);
case 'c': FTST(O_FTCHR);
case 't': FTST(O_FTTTY);
case 'T': FTST(O_FTTEXT);
case 'B': FTST(O_FTBINARY);
case 'M': stabent("\024",TRUE); FTST(O_FTMTIME);
case 'A': stabent("\024",TRUE); FTST(O_FTATIME);
case 'C': stabent("\024",TRUE); FTST(O_FTCTIME);
default:
s -= 2;
break;
}
}
tmp = *s++;
if (*s == tmp) {
s++;
RETURN(DEC);
}
if (expectterm) {
if (isSPACE(*s) || !isSPACE(*bufptr))
check_uni();
OPERATOR('-');
}
else
AOP(O_SUBTRACT);
case '+':
tmp = *s++;
if (*s == tmp) {
s++;
RETURN(INC);
}
if (expectterm) {
if (isSPACE(*s) || !isSPACE(*bufptr))
check_uni();
OPERATOR('+');
}
else
AOP(O_ADD);
case '*':
if (expectterm) {
check_uni();
s = scanident(s,bufend,tokenbuf);
yylval.stabval = stabent(tokenbuf,TRUE);
TERM(STAR);
}
tmp = *s++;
if (*s == tmp) {
s++;
OPERATOR(POW);
}
MOP(O_MULTIPLY);
case '%':
if (expectterm) {
if (!isALPHA(s[1]))
check_uni();
s = scanident(s,bufend,tokenbuf);
yylval.stabval = hadd(stabent(tokenbuf,TRUE));
TERM(HSH);
}
s++;
MOP(O_MODULO);
case '^':
case '~':
case '(':
case ',':
case ':':
case '[':
tmp = *s++;
OPERATOR(tmp);
case '{':
tmp = *s++;
yylval.ival = curcmd->c_line;
if (isSPACE(*s) || *s == '#')
cmdline = NOLINE; /* invalidate current command line number */
expectterm = 2;
RETURN(tmp);
case ';':
if (curcmd->c_line < cmdline)
cmdline = curcmd->c_line;
tmp = *s++;
OPERATOR(tmp);
case ')':
case ']':
tmp = *s++;
TERM(tmp);
case '}':
*s |= 128;
RETURN(';');
case '&':
s++;
tmp = *s++;
if (tmp == '&')
OPERATOR(ANDAND);
s--;
if (expectterm) {
d = bufend;
while (s < d && isSPACE(*s))
s++;
if (isALPHA(*s) || *s == '_' || *s == '\'')
*(--s) = '\\'; /* force next ident to WORD */
else
check_uni();
OPERATOR(AMPER);
}
OPERATOR('&');
case '|':
s++;
tmp = *s++;
if (tmp == '|')
OPERATOR(OROR);
s--;
OPERATOR('|');
case '=':
s++;
tmp = *s++;
if (tmp == '=')
EOP(O_EQ);
if (tmp == '~')
OPERATOR(MATCH);
s--;
OPERATOR('=');
case '!':
s++;
tmp = *s++;
if (tmp == '=')
EOP(O_NE);
if (tmp == '~')
OPERATOR(NMATCH);
s--;
OPERATOR('!');
case '<':
if (expectterm) {
if (s[1] != '<' && !index(s,'>'))
check_uni();
s = scanstr(s, SCAN_DEF);
TERM(RSTRING);
}
s++;
tmp = *s++;
if (tmp == '<')
OPERATOR(LS);
if (tmp == '=') {
tmp = *s++;
if (tmp == '>')
EOP(O_NCMP);
s--;
ROP(O_LE);
}
s--;
ROP(O_LT);
case '>':
s++;
tmp = *s++;
if (tmp == '>')
OPERATOR(RS);
if (tmp == '=')
ROP(O_GE);
s--;
ROP(O_GT);
#define SNARFWORD \
d = tokenbuf; \
while (isALNUM(*s) || *s == '\'') \
*d++ = *s++; \
while (d[-1] == '\'') \
d--,s--; \
*d = '\0'; \
d = tokenbuf;
case '$':
if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_')) {
s++;
s = scanident(s,bufend,tokenbuf);
yylval.stabval = aadd(stabent(tokenbuf,TRUE));
TERM(ARYLEN);
}
d = s;
s = scanident(s,bufend,tokenbuf);
if (reparse) { /* turn ${foo[bar]} into ($foo[bar]) */
do_reparse:
s[-1] = ')';
s = d;
s[1] = s[0];
s[0] = '(';
goto retry;
}
yylval.stabval = stabent(tokenbuf,TRUE);
expectterm = FALSE;
if (isSPACE(*s) && oldoldbufptr && oldoldbufptr < bufptr) {
s++;
while (isSPACE(*oldoldbufptr))
oldoldbufptr++;
if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5)) {
if (index("&*<%", *s) && isALPHA(s[1]))
expectterm = TRUE; /* e.g. print $fh &sub */
else if (*s == '.' && isDIGIT(s[1]))
expectterm = TRUE; /* e.g. print $fh .3 */
else if (index("/?-+", *s) && !isSPACE(s[1]))
expectterm = TRUE; /* e.g. print $fh -1 */
}
}
RETURN(REG);
case '@':
d = s;
s = scanident(s,bufend,tokenbuf);
if (reparse)
goto do_reparse;
yylval.stabval = aadd(stabent(tokenbuf,TRUE));
TERM(ARY);
case '/': /* may either be division or pattern */
case '?': /* may either be conditional or pattern */
if (expectterm) {
check_uni();
s = scanpat(s);
TERM(PATTERN);
}
tmp = *s++;
if (tmp == '/')
MOP(O_DIVIDE);
OPERATOR(tmp);
case '.':
if (!expectterm || !isDIGIT(s[1])) {
tmp = *s++;
if (*s == tmp) {
s++;
if (*s == tmp) {
s++;
yylval.ival = 0;
}
else
yylval.ival = AF_COMMON;
OPERATOR(DOTDOT);
}
if (expectterm)
check_uni();
AOP(O_CONCAT);
}
/* FALL THROUGH */
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7': case '8': case '9':
case '\'': case '"': case '`':
s = scanstr(s, SCAN_DEF);
TERM(RSTRING);
case '\\': /* some magic to force next word to be a WORD */
s++; /* used by do and sub to force a separate namespace */
if (!isALPHA(*s) && *s != '_' && *s != '\'') {
warn("Spurious backslash ignored");
goto retry;
}
/* FALL THROUGH */
case '_':
SNARFWORD;
if (d[1] == '_') {
if (strEQ(d,"__LINE__") || strEQ(d,"__FILE__")) {
ARG *arg = op_new(1);
yylval.arg = arg;
arg->arg_type = O_ITEM;
if (d[2] == 'L')
(void)sprintf(tokenbuf,"%ld",(long)curcmd->c_line);
else
strcpy(tokenbuf, stab_val(curcmd->c_filestab)->str_ptr);
arg[1].arg_type = A_SINGLE;
arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf));
TERM(RSTRING);
}
else if (strEQ(d,"__END__")) {
STAB *stab;
int fd;
/*SUPPRESS 560*/
if (!in_eval && (stab = stabent("DATA",FALSE))) {
stab->str_pok |= SP_MULTI;
if (!stab_io(stab))
stab_io(stab) = stio_new();
stab_io(stab)->ifp = rsfp;
#if defined(HAS_FCNTL) && defined(F_SETFD)
fd = fileno(rsfp);
fcntl(fd,F_SETFD,fd >= 3);
#endif
if (preprocess)
stab_io(stab)->type = '|';
else if ((FILE*)rsfp == stdin)
stab_io(stab)->type = '-';
else
stab_io(stab)->type = '<';
rsfp = Nullfp;
}
goto fake_eof;
}
}
break;
case 'a': case 'A':
SNARFWORD;
if (strEQ(d,"alarm"))
UNI(O_ALARM);
if (strEQ(d,"accept"))
FOP22(O_ACCEPT);
if (strEQ(d,"atan2"))
FUN2(O_ATAN2);
break;
case 'b': case 'B':
SNARFWORD;
if (strEQ(d,"bind"))
FOP2(O_BIND);
if (strEQ(d,"binmode"))
FOP(O_BINMODE);
break;
case 'c': case 'C':
SNARFWORD;
if (strEQ(d,"chop"))
LFUN(O_CHOP);
if (strEQ(d,"continue"))
OPERATOR(CONTINUE);
if (strEQ(d,"chdir")) {
(void)stabent("ENV",TRUE); /* may use HOME */
UNI(O_CHDIR);
}
if (strEQ(d,"close"))
FOP(O_CLOSE);
if (strEQ(d,"closedir"))
FOP(O_CLOSEDIR);
if (strEQ(d,"cmp"))
EOP(O_SCMP);
if (strEQ(d,"caller"))
UNI(O_CALLER);
if (strEQ(d,"crypt")) {
#ifdef FCRYPT
static int cryptseen = 0;
if (!cryptseen++)
init_des();
#endif
FUN2(O_CRYPT);
}
if (strEQ(d,"chmod"))
LOP(O_CHMOD);
if (strEQ(d,"chown"))
LOP(O_CHOWN);
if (strEQ(d,"connect"))
FOP2(O_CONNECT);
if (strEQ(d,"cos"))
UNI(O_COS);
if (strEQ(d,"chroot"))
UNI(O_CHROOT);
break;
case 'd': case 'D':
SNARFWORD;
if (strEQ(d,"do")) {
d = bufend;
while (s < d && isSPACE(*s))
s++;
if (isALPHA(*s) || *s == '_')
*(--s) = '\\'; /* force next ident to WORD */
OPERATOR(DO);
}
if (strEQ(d,"die"))
LOP(O_DIE);
if (strEQ(d,"defined"))
LFUN(O_DEFINED);
if (strEQ(d,"delete"))
OPERATOR(DELETE);
if (strEQ(d,"dbmopen"))
HFUN3(O_DBMOPEN);
if (strEQ(d,"dbmclose"))
HFUN(O_DBMCLOSE);
if (strEQ(d,"dump"))
LOOPX(O_DUMP);
break;
case 'e': case 'E':
SNARFWORD;
if (strEQ(d,"else"))
OPERATOR(ELSE);
if (strEQ(d,"elsif")) {
yylval.ival = curcmd->c_line;
OPERATOR(ELSIF);
}
if (strEQ(d,"eq") || strEQ(d,"EQ"))
EOP(O_SEQ);
if (strEQ(d,"exit"))
UNI(O_EXIT);
if (strEQ(d,"eval")) {
allstabs = TRUE; /* must initialize everything since */
UNI(O_EVAL); /* we don't know what will be used */
}
if (strEQ(d,"eof"))
FOP(O_EOF);
if (strEQ(d,"exp"))
UNI(O_EXP);
if (strEQ(d,"each"))
HFUN(O_EACH);
if (strEQ(d,"exec")) {
set_csh();
LOP(O_EXEC_OP);
}
if (strEQ(d,"endhostent"))
FUN0(O_EHOSTENT);
if (strEQ(d,"endnetent"))
FUN0(O_ENETENT);
if (strEQ(d,"endservent"))
FUN0(O_ESERVENT);
if (strEQ(d,"endprotoent"))
FUN0(O_EPROTOENT);
if (strEQ(d,"endpwent"))
FUN0(O_EPWENT);
if (strEQ(d,"endgrent"))
FUN0(O_EGRENT);
break;
case 'f': case 'F':
SNARFWORD;
if (strEQ(d,"for") || strEQ(d,"foreach")) {
yylval.ival = curcmd->c_line;
while (s < bufend && isSPACE(*s))
s++;
if (isALPHA(*s))
fatal("Missing $ on loop variable");
OPERATOR(FOR);
}
if (strEQ(d,"format")) {
d = bufend;
while (s < d && isSPACE(*s))
s++;
if (isALPHA(*s) || *s == '_')
*(--s) = '\\'; /* force next ident to WORD */
in_format = TRUE;
allstabs = TRUE; /* must initialize everything since */
OPERATOR(FORMAT); /* we don't know what will be used */
}
if (strEQ(d,"fork"))
FUN0(O_FORK);
if (strEQ(d,"fcntl"))
FOP3(O_FCNTL);
if (strEQ(d,"fileno"))
FOP(O_FILENO);
if (strEQ(d,"flock"))
FOP2(O_FLOCK);
break;
case 'g': case 'G':
SNARFWORD;
if (strEQ(d,"gt") || strEQ(d,"GT"))
ROP(O_SGT);
if (strEQ(d,"ge") || strEQ(d,"GE"))
ROP(O_SGE);
if (strEQ(d,"grep"))
FL2(O_GREP);
if (strEQ(d,"goto"))
LOOPX(O_GOTO);
if (strEQ(d,"gmtime"))
UNI(O_GMTIME);
if (strEQ(d,"getc"))
FOP(O_GETC);
if (strnEQ(d,"get",3)) {
d += 3;
if (*d == 'p') {
if (strEQ(d,"ppid"))
FUN0(O_GETPPID);
if (strEQ(d,"pgrp"))
UNI(O_GETPGRP);
if (strEQ(d,"priority"))
FUN2(O_GETPRIORITY);
if (strEQ(d,"protobyname"))
UNI(O_GPBYNAME);
if (strEQ(d,"protobynumber"))
FUN1(O_GPBYNUMBER);
if (strEQ(d,"protoent"))
FUN0(O_GPROTOENT);
if (strEQ(d,"pwent"))
FUN0(O_GPWENT);
if (strEQ(d,"pwnam"))
FUN1(O_GPWNAM);
if (strEQ(d,"pwuid"))
FUN1(O_GPWUID);
if (strEQ(d,"peername"))
FOP(O_GETPEERNAME);
}
else if (*d == 'h') {
if (strEQ(d,"hostbyname"))
UNI(O_GHBYNAME);
if (strEQ(d,"hostbyaddr"))
FUN2(O_GHBYADDR);
if (strEQ(d,"hostent"))
FUN0(O_GHOSTENT);
}
else if (*d == 'n') {
if (strEQ(d,"netbyname"))
UNI(O_GNBYNAME);
if (strEQ(d,"netbyaddr"))
FUN2(O_GNBYADDR);
if (strEQ(d,"netent"))
FUN0(O_GNETENT);
}
else if (*d == 's') {
if (strEQ(d,"servbyname"))
FUN2(O_GSBYNAME);
if (strEQ(d,"servbyport"))
FUN2(O_GSBYPORT);
if (strEQ(d,"servent"))
FUN0(O_GSERVENT);
if (strEQ(d,"sockname"))
FOP(O_GETSOCKNAME);
if (strEQ(d,"sockopt"))
FOP3(O_GSOCKOPT);
}
else if (*d == 'g') {
if (strEQ(d,"grent"))
FUN0(O_GGRENT);
if (strEQ(d,"grnam"))
FUN1(O_GGRNAM);
if (strEQ(d,"grgid"))
FUN1(O_GGRGID);
}
else if (*d == 'l') {
if (strEQ(d,"login"))
FUN0(O_GETLOGIN);
}
d -= 3;
}
break;
case 'h': case 'H':
SNARFWORD;
if (strEQ(d,"hex"))
UNI(O_HEX);
break;
case 'i': case 'I':
SNARFWORD;
if (strEQ(d,"if")) {
yylval.ival = curcmd->c_line;
OPERATOR(IF);
}
if (strEQ(d,"index"))
FUN2x(O_INDEX);
if (strEQ(d,"int"))
UNI(O_INT);
if (strEQ(d,"ioctl"))
FOP3(O_IOCTL);
break;
case 'j': case 'J':
SNARFWORD;
if (strEQ(d,"join"))
FL2(O_JOIN);
break;
case 'k': case 'K':
SNARFWORD;
if (strEQ(d,"keys"))
HFUN(O_KEYS);
if (strEQ(d,"kill"))
LOP(O_KILL);
break;
case 'l': case 'L':
SNARFWORD;
if (strEQ(d,"last"))
LOOPX(O_LAST);
if (strEQ(d,"local"))
OPERATOR(LOCAL);
if (strEQ(d,"length"))
UNI(O_LENGTH);
if (strEQ(d,"lt") || strEQ(d,"LT"))
ROP(O_SLT);
if (strEQ(d,"le") || strEQ(d,"LE"))
ROP(O_SLE);
if (strEQ(d,"localtime"))
UNI(O_LOCALTIME);
if (strEQ(d,"log"))
UNI(O_LOG);
if (strEQ(d,"link"))
FUN2(O_LINK);
if (strEQ(d,"listen"))
FOP2(O_LISTEN);
if (strEQ(d,"lstat"))
FOP(O_LSTAT);
break;
case 'm': case 'M':
if (s[1] == '\'') {
d = "m";
s++;
}
else {
SNARFWORD;
}
if (strEQ(d,"m")) {
s = scanpat(s-1);
if (yylval.arg)
TERM(PATTERN);
else
RETURN(1); /* force error */
}
switch (d[1]) {
case 'k':
if (strEQ(d,"mkdir"))
FUN2(O_MKDIR);
break;
case 's':
if (strEQ(d,"msgctl"))
FUN3(O_MSGCTL);
if (strEQ(d,"msgget"))
FUN2(O_MSGGET);
if (strEQ(d,"msgrcv"))
FUN5(O_MSGRCV);
if (strEQ(d,"msgsnd"))
FUN3(O_MSGSND);
break;
}
break;
case 'n': case 'N':
SNARFWORD;
if (strEQ(d,"next"))
LOOPX(O_NEXT);
if (strEQ(d,"ne") || strEQ(d,"NE"))
EOP(O_SNE);
break;
case 'o': case 'O':
SNARFWORD;
if (strEQ(d,"open"))
OPERATOR(OPEN);
if (strEQ(d,"ord"))
UNI(O_ORD);
if (strEQ(d,"oct"))
UNI(O_OCT);
if (strEQ(d,"opendir"))
FOP2(O_OPEN_DIR);
break;
case 'p': case 'P':
SNARFWORD;
if (strEQ(d,"print")) {
checkcomma(s,d,"filehandle");
LOP(O_PRINT);
}
if (strEQ(d,"printf")) {
checkcomma(s,d,"filehandle");
LOP(O_PRTF);
}
if (strEQ(d,"push")) {
yylval.ival = O_PUSH;
OPERATOR(PUSH);
}
if (strEQ(d,"pop"))
OPERATOR(POP);
if (strEQ(d,"pack"))
FL2(O_PACK);
if (strEQ(d,"package"))
OPERATOR(PACKAGE);
if (strEQ(d,"pipe"))
FOP22(O_PIPE_OP);
break;
case 'q': case 'Q':
SNARFWORD;
if (strEQ(d,"q")) {
s = scanstr(s-1, SCAN_DEF);
TERM(RSTRING);
}
if (strEQ(d,"qq")) {
s = scanstr(s-2, SCAN_DEF);
TERM(RSTRING);
}
if (strEQ(d,"qx")) {
s = scanstr(s-2, SCAN_DEF);
TERM(RSTRING);
}
break;
case 'r': case 'R':
SNARFWORD;
if (strEQ(d,"return"))
OLDLOP(O_RETURN);
if (strEQ(d,"require")) {
allstabs = TRUE; /* must initialize everything since */
UNI(O_REQUIRE); /* we don't know what will be used */
}
if (strEQ(d,"reset"))
UNI(O_RESET);
if (strEQ(d,"redo"))
LOOPX(O_REDO);
if (strEQ(d,"rename"))
FUN2(O_RENAME);
if (strEQ(d,"rand"))
UNI(O_RAND);
if (strEQ(d,"rmdir"))
UNI(O_RMDIR);
if (strEQ(d,"rindex"))
FUN2x(O_RINDEX);
if (strEQ(d,"read"))
FOP3(O_READ);
if (strEQ(d,"readdir"))
FOP(O_READDIR);
if (strEQ(d,"rewinddir"))
FOP(O_REWINDDIR);
if (strEQ(d,"recv"))
FOP4(O_RECV);
if (strEQ(d,"reverse"))
LOP(O_REVERSE);
if (strEQ(d,"readlink"))
UNI(O_READLINK);
break;
case 's': case 'S':
if (s[1] == '\'') {
d = "s";
s++;
}
else {
SNARFWORD;
}
if (strEQ(d,"s")) {
s = scansubst(s);
if (yylval.arg)
TERM(SUBST);
else
RETURN(1); /* force error */
}
switch (d[1]) {
case 'a':
case 'b':
break;
case 'c':
if (strEQ(d,"scalar"))
UNI(O_SCALAR);
break;
case 'd':
break;
case 'e':
if (strEQ(d,"select"))
OPERATOR(SSELECT);
if (strEQ(d,"seek"))
FOP3(O_SEEK);
if (strEQ(d,"semctl"))
FUN4(O_SEMCTL);
if (strEQ(d,"semget"))
FUN3(O_SEMGET);
if (strEQ(d,"semop"))
FUN2(O_SEMOP);
if (strEQ(d,"send"))
FOP3(O_SEND);
if (strEQ(d,"setpgrp"))
FUN2(O_SETPGRP);
if (strEQ(d,"setpriority"))
FUN3(O_SETPRIORITY);
if (strEQ(d,"sethostent"))
FUN1(O_SHOSTENT);
if (strEQ(d,"setnetent"))
FUN1(O_SNETENT);
if (strEQ(d,"setservent"))
FUN1(O_SSERVENT);
if (strEQ(d,"setprotoent"))
FUN1(O_SPROTOENT);
if (strEQ(d,"setpwent"))
FUN0(O_SPWENT);
if (strEQ(d,"setgrent"))
FUN0(O_SGRENT);
if (strEQ(d,"seekdir"))
FOP2(O_SEEKDIR);
if (strEQ(d,"setsockopt"))
FOP4(O_SSOCKOPT);
break;
case 'f':
case 'g':
break;
case 'h':
if (strEQ(d,"shift"))
TERM(SHIFT);
if (strEQ(d,"shmctl"))
FUN3(O_SHMCTL);
if (strEQ(d,"shmget"))
FUN3(O_SHMGET);
if (strEQ(d,"shmread"))
FUN4(O_SHMREAD);
if (strEQ(d,"shmwrite"))
FUN4(O_SHMWRITE);
if (strEQ(d,"shutdown"))
FOP2(O_SHUTDOWN);
break;
case 'i':
if (strEQ(d,"sin"))
UNI(O_SIN);
break;
case 'j':
case 'k':
break;
case 'l':
if (strEQ(d,"sleep"))
UNI(O_SLEEP);
break;
case 'm':
case 'n':
break;
case 'o':
if (strEQ(d,"socket"))
FOP4(O_SOCKET);
if (strEQ(d,"socketpair"))
FOP25(O_SOCKPAIR);
if (strEQ(d,"sort")) {
checkcomma(s,d,"subroutine name");
d = bufend;
while (s < d && isSPACE(*s)) s++;
if (*s == ';' || *s == ')') /* probably a close */
fatal("sort is now a reserved word");
if (isALPHA(*s) || *s == '_') {
/*SUPPRESS 530*/
for (d = s; isALNUM(*d); d++) ;
strncpy(tokenbuf,s,d-s);
tokenbuf[d-s] = '\0';
if (strNE(tokenbuf,"keys") &&
strNE(tokenbuf,"values") &&
strNE(tokenbuf,"split") &&
strNE(tokenbuf,"grep") &&
strNE(tokenbuf,"readdir") &&
strNE(tokenbuf,"unpack") &&
strNE(tokenbuf,"do") &&
strNE(tokenbuf,"eval") &&
(d >= bufend || isSPACE(*d)) )
*(--s) = '\\'; /* force next ident to WORD */
}
LOP(O_SORT);
}
break;
case 'p':
if (strEQ(d,"split"))
TERM(SPLIT);
if (strEQ(d,"sprintf"))
FL(O_SPRINTF);
if (strEQ(d,"splice")) {
yylval.ival = O_SPLICE;
OPERATOR(PUSH);
}
break;
case 'q':
if (strEQ(d,"sqrt"))
UNI(O_SQRT);
break;
case 'r':
if (strEQ(d,"srand"))
UNI(O_SRAND);
break;
case 's':
break;
case 't':
if (strEQ(d,"stat"))
FOP(O_STAT);
if (strEQ(d,"study")) {
sawstudy++;
LFUN(O_STUDY);
}
break;
case 'u':
if (strEQ(d,"substr"))
FUN2x(O_SUBSTR);
if (strEQ(d,"sub")) {
yylval.ival = savestack->ary_fill; /* restore stuff on reduce */
savelong(&subline);
saveitem(subname);
subline = curcmd->c_line;
d = bufend;
while (s < d && isSPACE(*s))
s++;
if (isALPHA(*s) || *s == '_' || *s == '\'') {
str_sset(subname,curstname);
str_ncat(subname,"'",1);
for (d = s+1; isALNUM(*d) || *d == '\''; d++)
/*SUPPRESS 530*/
;
if (d[-1] == '\'')
d--;
str_ncat(subname,s,d-s);
*(--s) = '\\'; /* force next ident to WORD */
}
else
str_set(subname,"?");
OPERATOR(SUB);
}
break;
case 'v':
case 'w':
case 'x':
break;
case 'y':
if (strEQ(d,"system")) {
set_csh();
LOP(O_SYSTEM);
}
if (strEQ(d,"symlink"))
FUN2(O_SYMLINK);
if (strEQ(d,"syscall"))
LOP(O_SYSCALL);
if (strEQ(d,"sysread"))
FOP3(O_SYSREAD);
if (strEQ(d,"syswrite"))
FOP3(O_SYSWRITE);
break;
case 'z':
break;
}
break;
case 't': case 'T':
SNARFWORD;
if (strEQ(d,"tr")) {
s = scantrans(s);
if (yylval.arg)
TERM(TRANS);
else
RETURN(1); /* force error */
}
if (strEQ(d,"tell"))
FOP(O_TELL);
if (strEQ(d,"telldir"))
FOP(O_TELLDIR);
if (strEQ(d,"time"))
FUN0(O_TIME);
if (strEQ(d,"times"))
FUN0(O_TMS);
if (strEQ(d,"truncate"))
FOP2(O_TRUNCATE);
break;
case 'u': case 'U':
SNARFWORD;
if (strEQ(d,"using"))
OPERATOR(USING);
if (strEQ(d,"until")) {
yylval.ival = curcmd->c_line;
OPERATOR(UNTIL);
}
if (strEQ(d,"unless")) {
yylval.ival = curcmd->c_line;
OPERATOR(UNLESS);
}
if (strEQ(d,"unlink"))
LOP(O_UNLINK);
if (strEQ(d,"undef"))
LFUN(O_UNDEF);
if (strEQ(d,"unpack"))
FUN2(O_UNPACK);
if (strEQ(d,"utime"))
LOP(O_UTIME);
if (strEQ(d,"umask"))
UNI(O_UMASK);
if (strEQ(d,"unshift")) {
yylval.ival = O_UNSHIFT;
OPERATOR(PUSH);
}
break;
case 'v': case 'V':
SNARFWORD;
if (strEQ(d,"values"))
HFUN(O_VALUES);
if (strEQ(d,"vec")) {
sawvec = TRUE;
FUN3(O_VEC);
}
break;
case 'w': case 'W':
SNARFWORD;
if (strEQ(d,"while")) {
yylval.ival = curcmd->c_line;
OPERATOR(WHILE);
}
if (strEQ(d,"warn"))
LOP(O_WARN);
if (strEQ(d,"wait"))
FUN0(O_WAIT);
if (strEQ(d,"waitpid"))
FUN2(O_WAITPID);
if (strEQ(d,"wantarray")) {
yylval.arg = op_new(1);
yylval.arg->arg_type = O_ITEM;
yylval.arg[1].arg_type = A_WANTARRAY;
TERM(RSTRING);
}
if (strEQ(d,"write"))
FOP(O_WRITE);
break;
case 'x': case 'X':
if (*s == 'x' && isDIGIT(s[1]) && !expectterm) {
s++;
MOP(O_REPEAT);
}
SNARFWORD;
if (strEQ(d,"x")) {
if (!expectterm)
MOP(O_REPEAT);
check_uni();
}
break;
case 'y': case 'Y':
if (s[1] == '\'') {
d = "y";
s++;
}
else {
SNARFWORD;
}
if (strEQ(d,"y")) {
s = scantrans(s);
TERM(TRANS);
}
break;
case 'z': case 'Z':
SNARFWORD;
break;
}
yylval.cval = savestr(d);
if (expectterm == 2) { /* special case: start of statement */
while (isSPACE(*s)) s++;
if (*s == ':') {
s++;
CLINE;
OPERATOR(LABEL);
}
TERM(WORD);
}
expectterm = FALSE;
if (oldoldbufptr && oldoldbufptr < bufptr) {
while (isSPACE(*oldoldbufptr))
oldoldbufptr++;
if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5))
expectterm = TRUE;
else if (*oldoldbufptr == 's' && strnEQ(oldoldbufptr,"sort",4))
expectterm = TRUE;
}
return (CLINE, bufptr = s, (int)WORD);
}
void
checkcomma(s,name,what)
register char *s;
char *name;
char *what;
{
char *w;
if (dowarn && *s == ' ' && s[1] == '(') {
w = index(s,')');
if (w)
for (w++; *w && isSPACE(*w); w++) ;
if (!w || !*w || !index(";|}", *w)) /* an advisory hack only... */
warn("%s (...) interpreted as function",name);
}
while (s < bufend && isSPACE(*s))
s++;
if (*s == '(')
s++;
while (s < bufend && isSPACE(*s))
s++;
if (isALPHA(*s) || *s == '_') {
w = s++;
while (isALNUM(*s))
s++;
while (s < bufend && isSPACE(*s))
s++;
if (*s == ',') {
*s = '\0';
w = instr(
"tell eof times getlogin wait length shift umask getppid \
cos exp int log rand sin sqrt ord wantarray",
w);
*s = ',';
if (w)
return;
fatal("No comma allowed after %s", what);
}
}
}
char *
scanident(s,send,dest)
register char *s;
register char *send;
char *dest;
{
register char *d;
int brackets = 0;
reparse = Nullch;
s++;
d = dest;
if (isDIGIT(*s)) {
while (isDIGIT(*s))
*d++ = *s++;
}
else {
while (isALNUM(*s) || *s == '\'')
*d++ = *s++;
}
while (d > dest+1 && d[-1] == '\'')
d--,s--;
*d = '\0';
d = dest;
if (!*d) {
*d = *s++;
if (*d == '{' /* } */ ) {
d = dest;
brackets++;
while (s < send && brackets) {
if (!reparse && (d == dest || (*s && isALNUM(*s) ))) {
*d++ = *s++;
continue;
}
else if (!reparse)
reparse = s;
switch (*s++) {
/* { */
case '}':
brackets--;
if (reparse && reparse == s - 1)
reparse = Nullch;
break;
case '{': /* } */
brackets++;
break;
}
}
*d = '\0';
d = dest;
}
else
d[1] = '\0';
}
if (*d == '^' && (isUPPER(*s) || index("[\\]^_?", *s))) {
#ifdef DEBUGGING
if (*s == 'D')
debug |= 32768;
#endif
*d = *s++ ^ 64;
}
return s;
}
void
scanconst(spat,string,len)
SPAT *spat;
char *string;
int len;
{
register STR *tmpstr;
register char *t;
register char *d;
register char *e;
char *origstring = string;
static char *vert = "|";
if (ninstr(string, string+len, vert, vert+1))
return;
if (*string == '^')
string++, len--;
tmpstr = Str_new(86,len);
str_nset(tmpstr,string,len);
t = str_get(tmpstr);
e = t + len;
tmpstr->str_u.str_useful = 100;
for (d=t; d < e; ) {
switch (*d) {
case '{':
if (isDIGIT(d[1]))
e = d;
else
goto defchar;
break;
case '.': case '[': case '$': case '(': case ')': case '|': case '+':
case '^':
e = d;
break;
case '\\':
if (d[1] && index("wWbB0123456789sSdDlLuUExc",d[1])) {
e = d;
break;
}
Move(d+1,d,e-d,char);
e--;
switch(*d) {
case 'n':
*d = '\n';
break;
case 't':
*d = '\t';
break;
case 'f':
*d = '\f';
break;
case 'r':
*d = '\r';
break;
case 'e':
*d = '\033';
break;
case 'a':
*d = '\007';
break;
}
/* FALL THROUGH */
default:
defchar:
if (d[1] == '*' || (d[1] == '{' && d[2] == '0') || d[1] == '?') {
e = d;
break;
}
d++;
}
}
if (d == t) {
str_free(tmpstr);
return;
}
*d = '\0';
tmpstr->str_cur = d - t;
if (d == t+len)
spat->spat_flags |= SPAT_ALL;
if (*origstring != '^')
spat->spat_flags |= SPAT_SCANFIRST;
spat->spat_short = tmpstr;
spat->spat_slen = d - t;
}
char *
scanpat(s)
register char *s;
{
register SPAT *spat;
register char *d;
register char *e;
int len;
SPAT savespat;
STR *str = Str_new(93,0);
char delim;
Newz(801,spat,1,SPAT);
spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
curstash->tbl_spatroot = spat;
switch (*s++) {
case 'm':
s++;
break;
case '/':
break;
case '?':
spat->spat_flags |= SPAT_ONCE;
break;
default:
fatal("panic: scanpat");
}
s = str_append_till(str,s,bufend,s[-1],patleave);
if (s >= bufend) {
str_free(str);
yyerror("Search pattern not terminated");
yylval.arg = Nullarg;
return s;
}
delim = *s++;
while (*s == 'i' || *s == 'o' || *s == 'g') {
if (*s == 'i') {
s++;
sawi = TRUE;
spat->spat_flags |= SPAT_FOLD;
}
if (*s == 'o') {
s++;
spat->spat_flags |= SPAT_KEEP;
}
if (*s == 'g') {
s++;
spat->spat_flags |= SPAT_GLOBAL;
}
}
len = str->str_cur;
e = str->str_ptr + len;
if (delim == '\'')
d = e;
else
d = str->str_ptr;
for (; d < e; d++) {
if (*d == '\\')
d++;
else if ((*d == '$' && d[1] && d[1] != '|' && d[1] != ')') ||
(*d == '@')) {
register ARG *arg;
spat->spat_runtime = arg = op_new(1);
arg->arg_type = O_ITEM;
arg[1].arg_type = A_DOUBLE;
arg[1].arg_ptr.arg_str = str_smake(str);
d = scanident(d,bufend,buf);
(void)stabent(buf,TRUE); /* make sure it's created */
for (; d < e; d++) {
if (*d == '\\')
d++;
else if (*d == '$' && d[1] && d[1] != '|' && d[1] != ')') {
d = scanident(d,bufend,buf);
(void)stabent(buf,TRUE);
}
else if (*d == '@') {
d = scanident(d,bufend,buf);
if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
strEQ(buf,"SIG") || strEQ(buf,"INC"))
(void)stabent(buf,TRUE);
}
}
goto got_pat; /* skip compiling for now */
}
}
if (spat->spat_flags & SPAT_FOLD)
StructCopy(spat, &savespat, SPAT);
scanconst(spat,str->str_ptr,len);
if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) {
fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
spat->spat_flags & SPAT_FOLD);
/* Note that this regexp can still be used if someone says
* something like /a/ && s//b/; so we can't delete it.
*/
}
else {
if (spat->spat_flags & SPAT_FOLD)
StructCopy(&savespat, spat, SPAT);
if (spat->spat_short)
fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
spat->spat_flags & SPAT_FOLD);
hoistmust(spat);
}
got_pat:
str_free(str);
yylval.arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
return s;
}
char *
scansubst(start)
char *start;
{
register char *s = start;
register SPAT *spat;
register char *d;
register char *e;
int len;
STR *str = Str_new(93,0);
char term = *s;
if (term && (d = index("([{< )]}> )]}>",term)))
term = d[5];
Newz(802,spat,1,SPAT);
spat->spat_next = curstash->tbl_spatroot; /* link into spat list */
curstash->tbl_spatroot = spat;
s = str_append_till(str,s+1,bufend,term,patleave);
if (s >= bufend) {
str_free(str);
yyerror("Substitution pattern not terminated");
yylval.arg = Nullarg;
return s;
}
len = str->str_cur;
e = str->str_ptr + len;
for (d = str->str_ptr; d < e; d++) {
if (*d == '\\')
d++;
else if ((*d == '$' && d[1] && d[1] != '|' && /*(*/ d[1] != ')') ||
*d == '@' ) {
register ARG *arg;
spat->spat_runtime = arg = op_new(1);
arg->arg_type = O_ITEM;
arg[1].arg_type = A_DOUBLE;
arg[1].arg_ptr.arg_str = str_smake(str);
d = scanident(d,e,buf);
(void)stabent(buf,TRUE); /* make sure it's created */
for (; *d; d++) {
if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
d = scanident(d,e,buf);
(void)stabent(buf,TRUE);
}
else if (*d == '@' && d[-1] != '\\') {
d = scanident(d,e,buf);
if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
strEQ(buf,"SIG") || strEQ(buf,"INC"))
(void)stabent(buf,TRUE);
}
}
goto get_repl; /* skip compiling for now */
}
}
scanconst(spat,str->str_ptr,len);
get_repl:
if (term != *start)
s++;
s = scanstr(s, SCAN_REPL);
if (s >= bufend) {
str_free(str);
yyerror("Substitution replacement not terminated");
yylval.arg = Nullarg;
return s;
}
spat->spat_repl = yylval.arg;
if ((spat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
spat->spat_flags |= SPAT_CONST;
else if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE) {
STR *tmpstr;
register char *t;
spat->spat_flags |= SPAT_CONST;
tmpstr = spat->spat_repl[1].arg_ptr.arg_str;
e = tmpstr->str_ptr + tmpstr->str_cur;
for (t = tmpstr->str_ptr; t < e; t++) {
if (*t == '$' && t[1] && (index("`'&+0123456789",t[1]) ||
(t[1] == '{' /*}*/ && isDIGIT(t[2])) ))
spat->spat_flags &= ~SPAT_CONST;
}
}
while (*s == 'g' || *s == 'i' || *s == 'e' || *s == 'o') {
int es = 0;
if (*s == 'e') {
s++;
es++;
if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE)
spat->spat_repl[1].arg_type = A_SINGLE;
spat->spat_repl = make_op(
(!es && spat->spat_repl[1].arg_type == A_SINGLE
? O_EVALONCE
: O_EVAL),
2,
spat->spat_repl,
Nullarg,
Nullarg);
spat->spat_flags &= ~SPAT_CONST;
}
if (*s == 'g') {
s++;
spat->spat_flags |= SPAT_GLOBAL;
}
if (*s == 'i') {
s++;
sawi = TRUE;
spat->spat_flags |= SPAT_FOLD;
if (!(spat->spat_flags & SPAT_SCANFIRST)) {
str_free(spat->spat_short); /* anchored opt doesn't do */
spat->spat_short = Nullstr; /* case insensitive match */
spat->spat_slen = 0;
}
}
if (*s == 'o') {
s++;
spat->spat_flags |= SPAT_KEEP;
}
}
if (spat->spat_short && (spat->spat_flags & SPAT_SCANFIRST))
fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
if (!spat->spat_runtime) {
spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
spat->spat_flags & SPAT_FOLD);
hoistmust(spat);
}
yylval.arg = make_match(O_SUBST,stab2arg(A_STAB,defstab),spat);
str_free(str);
return s;
}
void
hoistmust(spat)
register SPAT *spat;
{
if (!spat->spat_short && spat->spat_regexp->regstart &&
(!spat->spat_regexp->regmust || spat->spat_regexp->reganch & ROPT_ANCH)
) {
if (!(spat->spat_regexp->reganch & ROPT_ANCH))
spat->spat_flags |= SPAT_SCANFIRST;
else if (spat->spat_flags & SPAT_FOLD)
return;
spat->spat_short = str_smake(spat->spat_regexp->regstart);
}
else if (spat->spat_regexp->regmust) {/* is there a better short-circuit? */
if (spat->spat_short &&
str_eq(spat->spat_short,spat->spat_regexp->regmust))
{
if (spat->spat_flags & SPAT_SCANFIRST) {
str_free(spat->spat_short);
spat->spat_short = Nullstr;
}
else {
str_free(spat->spat_regexp->regmust);
spat->spat_regexp->regmust = Nullstr;
return;
}
}
if (!spat->spat_short || /* promote the better string */
((spat->spat_flags & SPAT_SCANFIRST) &&
(spat->spat_short->str_cur < spat->spat_regexp->regmust->str_cur) )){
str_free(spat->spat_short); /* ok if null */
spat->spat_short = spat->spat_regexp->regmust;
spat->spat_regexp->regmust = Nullstr;
spat->spat_flags |= SPAT_SCANFIRST;
}
}
}
char *
scantrans(start)
char *start;
{
register char *s = start;
ARG *arg =
l(make_op(O_TRANS,2,stab2arg(A_STAB,defstab),Nullarg,Nullarg));
STR *tstr;
STR *rstr;
register char *t;
register char *r;
register short *tbl;
register int i;
register int j;
int tlen, rlen;
int squash;
int delete;
int complement;
New(803,tbl,256,short);
arg[2].arg_type = A_NULL;
arg[2].arg_ptr.arg_cval = (char*) tbl;
s = scanstr(s, SCAN_TR);
if (s >= bufend) {
yyerror("Translation pattern not terminated");
yylval.arg = Nullarg;
return s;
}
tstr = yylval.arg[1].arg_ptr.arg_str;
yylval.arg[1].arg_ptr.arg_str = Nullstr;
arg_free(yylval.arg);
t = tstr->str_ptr;
tlen = tstr->str_cur;
if (s[-1] == *start)
s--;
s = scanstr(s, SCAN_TR|SCAN_REPL);
if (s >= bufend) {
yyerror("Translation replacement not terminated");
yylval.arg = Nullarg;
return s;
}
rstr = yylval.arg[1].arg_ptr.arg_str;
yylval.arg[1].arg_ptr.arg_str = Nullstr;
arg_free(yylval.arg);
r = rstr->str_ptr;
rlen = rstr->str_cur;
complement = delete = squash = 0;
while (*s == 'c' || *s == 'd' || *s == 's') {
if (*s == 'c')
complement = 1;
else if (*s == 'd')
delete = 2;
else
squash = 1;
s++;
}
arg[2].arg_len = delete|squash;
yylval.arg = arg;
if (complement) {
Zero(tbl, 256, short);
for (i = 0; i < tlen; i++)
tbl[t[i] & 0377] = -1;
for (i = 0, j = 0; i < 256; i++) {
if (!tbl[i]) {
if (j >= rlen) {
if (delete)
tbl[i] = -2;
else if (rlen)
tbl[i] = r[j-1] & 0377;
else
tbl[i] = i;
}
else
tbl[i] = r[j++] & 0377;
}
}
}
else {
if (!rlen && !delete) {
r = t; rlen = tlen;
}
for (i = 0; i < 256; i++)
tbl[i] = -1;
for (i = 0, j = 0; i < tlen; i++,j++) {
if (j >= rlen) {
if (delete) {
if (tbl[t[i] & 0377] == -1)
tbl[t[i] & 0377] = -2;
continue;
}
--j;
}
if (tbl[t[i] & 0377] == -1)
tbl[t[i] & 0377] = r[j] & 0377;
}
}
str_free(tstr);
str_free(rstr);
return s;
}
char *
scanstr(start, in_what)
char *start;
int in_what;
{
register char *s = start;
register char term;
register char *d;
register ARG *arg;
register char *send;
register bool makesingle = FALSE;
register STAB *stab;
bool alwaysdollar = FALSE;
bool hereis = FALSE;
STR *herewas;
STR *str;
/* which backslash sequences to keep */
char *leave = (in_what & SCAN_TR)
? "\\$@nrtfbeacx0123456789-"
: "\\$@nrtfbeacx0123456789[{]}lLuUE";
int len;
arg = op_new(1);
yylval.arg = arg;
arg->arg_type = O_ITEM;
switch (*s) {
default: /* a substitution replacement */
arg[1].arg_type = A_DOUBLE;
makesingle = TRUE; /* maybe disable runtime scanning */
term = *s;
if (term == '\'')
leave = Nullch;
goto snarf_it;
case '0':
{
unsigned long i;
int shift;
arg[1].arg_type = A_SINGLE;
if (s[1] == 'x') {
shift = 4;
s += 2;
}
else if (s[1] == '.')
goto decimal;
else
shift = 3;
i = 0;
for (;;) {
switch (*s) {
default:
goto out;
case '_':
s++;
break;
case '8': case '9':
if (shift != 4)
yyerror("Illegal octal digit");
/* FALL THROUGH */
case '0': case '1': case '2': case '3': case '4':
case '5': case '6': case '7':
i <<= shift;
i += *s++ & 15;
break;
case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
if (shift != 4)
goto out;
i <<= 4;
i += (*s++ & 7) + 9;
break;
}
}
out:
str = Str_new(92,0);
str_numset(str,(double)i);
if (str->str_ptr) {
Safefree(str->str_ptr);
str->str_ptr = Nullch;
str->str_len = str->str_cur = 0;
}
arg[1].arg_ptr.arg_str = str;
}
break;
case '1': case '2': case '3': case '4': case '5':
case '6': case '7': case '8': case '9': case '.':
decimal:
arg[1].arg_type = A_SINGLE;
d = tokenbuf;
while (isDIGIT(*s) || *s == '_') {
if (*s == '_')
s++;
else
*d++ = *s++;
}
if (*s == '.' && s[1] != '.') {
*d++ = *s++;
while (isDIGIT(*s) || *s == '_') {
if (*s == '_')
s++;
else
*d++ = *s++;
}
}
if (*s && index("eE",*s) && index("+-0123456789",s[1])) {
*d++ = *s++;
if (*s == '+' || *s == '-')
*d++ = *s++;
while (isDIGIT(*s))
*d++ = *s++;
}
*d = '\0';
str = Str_new(92,0);
str_numset(str,atof(tokenbuf));
if (str->str_ptr) {
Safefree(str->str_ptr);
str->str_ptr = Nullch;
str->str_len = str->str_cur = 0;
}
arg[1].arg_ptr.arg_str = str;
break;
case '<':
if (in_what & (SCAN_REPL|SCAN_TR))
goto do_double;
if (*++s == '<') {
hereis = TRUE;
d = tokenbuf;
if (!rsfp)
*d++ = '\n';
if (*++s && index("`'\"",*s)) {
term = *s++;
s = cpytill(d,s,bufend,term,&len);
if (s < bufend)
s++;
d += len;
}
else {
if (*s == '\\')
s++, term = '\'';
else
term = '"';
while (isALNUM(*s))
*d++ = *s++;
} /* assuming tokenbuf won't clobber */
*d++ = '\n';
*d = '\0';
len = d - tokenbuf;
d = "\n";
if (rsfp || !(d=ninstr(s,bufend,d,d+1)))
herewas = str_make(s,bufend-s);
else
s--, herewas = str_make(s,d-s);
s += herewas->str_cur;
if (term == '\'')
goto do_single;
if (term == '`')
goto do_back;
goto do_double;
}
d = tokenbuf;
s = cpytill(d,s,bufend,'>',&len);
if (s < bufend)
s++;
else
fatal("Unterminated <> operator");
if (*d == '$') d++;
while (*d && (isALNUM(*d) || *d == '\''))
d++;
if (d - tokenbuf != len) {
s = start;
term = *s;
arg[1].arg_type = A_GLOB;
set_csh();
alwaysdollar = TRUE; /* treat $) and $| as variables */
goto snarf_it;
}
else {
d = tokenbuf;
if (!len)
(void)strcpy(d,"ARGV");
if (*d == '$') {
arg[1].arg_type = A_INDREAD;
arg[1].arg_ptr.arg_stab = stabent(d+1,TRUE);
}
else {
arg[1].arg_type = A_READ;
arg[1].arg_ptr.arg_stab = stabent(d,TRUE);
if (!stab_io(arg[1].arg_ptr.arg_stab))
stab_io(arg[1].arg_ptr.arg_stab) = stio_new();
if (strEQ(d,"ARGV")) {
(void)aadd(arg[1].arg_ptr.arg_stab);
stab_io(arg[1].arg_ptr.arg_stab)->flags |=
IOF_ARGV|IOF_START;
}
}
}
break;
case 'q':
s++;
if (*s == 'q') {
s++;
goto do_double;
}
if (*s == 'x') {
s++;
goto do_back;
}
/* FALL THROUGH */
case '\'':
do_single:
term = *s;
arg[1].arg_type = A_SINGLE;
leave = Nullch;
goto snarf_it;
case '"':
do_double:
term = *s;
arg[1].arg_type = A_DOUBLE;
makesingle = TRUE; /* maybe disable runtime scanning */
alwaysdollar = TRUE; /* treat $) and $| as variables */
goto snarf_it;
case '`':
do_back:
term = *s;
arg[1].arg_type = A_BACKTICK;
set_csh();
alwaysdollar = TRUE; /* treat $) and $| as variables */
snarf_it:
{
STR *tmpstr;
STR *tmpstr2 = Nullstr;
char *tmps;
char *start;
bool dorange = FALSE;
CLINE;
multi_start = curcmd->c_line;
if (hereis)
multi_open = multi_close = '<';
else {
multi_open = term;
if (term && (tmps = index("([{< )]}> )]}>",term)))
term = tmps[5];
multi_close = term;
}
tmpstr = Str_new(87,80);
if (hereis) {
term = *tokenbuf;
if (!rsfp) {
d = s;
while (s < bufend &&
(*s != term || bcmp(s,tokenbuf,len) != 0) ) {
if (*s++ == '\n')
curcmd->c_line++;
}
if (s >= bufend) {
curcmd->c_line = multi_start;
fatal("EOF in string");
}
str_nset(tmpstr,d+1,s-d);
s += len - 1;
str_ncat(herewas,s,bufend-s);
str_replace(linestr,herewas);
oldoldbufptr = oldbufptr = bufptr = s = str_get(linestr);
bufend = linestr->str_ptr + linestr->str_cur;
hereis = FALSE;
}
else
str_nset(tmpstr,"",0); /* avoid "uninitialized" warning */
}
else
s = str_append_till(tmpstr,s+1,bufend,term,leave);
while (s >= bufend) { /* multiple line string? */
if (!rsfp ||
!(oldoldbufptr = oldbufptr = s = str_gets(linestr, rsfp, 0))) {
curcmd->c_line = multi_start;
fatal("EOF in string");
}
curcmd->c_line++;
if (perldb) {
STR *str = Str_new(88,0);
str_sset(str,linestr);
astore(stab_xarray(curcmd->c_filestab),
(int)curcmd->c_line,str);
}
bufend = linestr->str_ptr + linestr->str_cur;
if (hereis) {
if (*s == term && bcmp(s,tokenbuf,len) == 0) {
s = bufend - 1;
*s = ' ';
str_scat(linestr,herewas);
bufend = linestr->str_ptr + linestr->str_cur;
}
else {
s = bufend;
str_scat(tmpstr,linestr);
}
}
else
s = str_append_till(tmpstr,s,bufend,term,leave);
}
multi_end = curcmd->c_line;
s++;
if (tmpstr->str_cur + 5 < tmpstr->str_len) {
tmpstr->str_len = tmpstr->str_cur + 1;
Renew(tmpstr->str_ptr, tmpstr->str_len, char);
}
if (arg[1].arg_type == A_SINGLE) {
arg[1].arg_ptr.arg_str = tmpstr;
break;
}
tmps = s;
s = tmpstr->str_ptr;
send = s + tmpstr->str_cur;
while (s < send) { /* see if we can make SINGLE */
if (*s == '\\' && s[1] && isDIGIT(s[1]) && !isDIGIT(s[2]) &&
!alwaysdollar && s[1] != '0')
*s = '$'; /* grandfather \digit in subst */
if ((*s == '$' || *s == '@') && s+1 < send &&
(alwaysdollar || (s[1] != ')' && s[1] != '|'))) {
makesingle = FALSE; /* force interpretation */
}
else if (*s == '\\' && s+1 < send) {
if (index("lLuUE",s[1]))
makesingle = FALSE;
s++;
}
s++;
}
s = d = start = tmpstr->str_ptr; /* assuming shrinkage only */
while (s < send || dorange) {
if (in_what & SCAN_TR) {
if (dorange) {
int i;
int max;
if (!tmpstr2) { /* oops, have to grow */
tmpstr2 = str_smake(tmpstr);
s = tmpstr2->str_ptr + (s - tmpstr->str_ptr);
send = tmpstr2->str_ptr + (send - tmpstr->str_ptr);
}
i = d - tmpstr->str_ptr;
STR_GROW(tmpstr, tmpstr->str_len + 256);
d = tmpstr->str_ptr + i;
d -= 2;
max = d[1] & 0377;
for (i = (*d & 0377); i <= max; i++)
*d++ = i;
start = s;
dorange = FALSE;
continue;
}
else if (*s == '-' && s+1 < send && s != start) {
dorange = TRUE;
s++;
}
}
else {
if ((*s == '$' && s+1 < send &&
(alwaysdollar || /*(*/(s[1] != ')' && s[1] != '|')) ) ||
(*s == '@' && s+1 < send) ) {
if (s[1] == '#' && (isALPHA(s[2]) || s[2] == '_'))
*d++ = *s++;
len = scanident(s,send,tokenbuf) - s;
if (*s == '$' || strEQ(tokenbuf,"ARGV")
|| strEQ(tokenbuf,"ENV")
|| strEQ(tokenbuf,"SIG")
|| strEQ(tokenbuf,"INC") )
(void)stabent(tokenbuf,TRUE); /* add symbol */
while (len--)
*d++ = *s++;
continue;
}
}
if (*s == '\\' && s+1 < send) {
s++;
switch (*s) {
case '-':
if (in_what & SCAN_TR) {
*d++ = *s++;
continue;
}
/* FALL THROUGH */
default:
if (!makesingle && (!leave || (*s && index(leave,*s))))
*d++ = '\\';
*d++ = *s++;
continue;
case '0': case '1': case '2': case '3':
case '4': case '5': case '6': case '7':
*d++ = scanoct(s, 3, &len);
s += len;
continue;
case 'x':
*d++ = scanhex(++s, 2, &len);
s += len;
continue;
case 'c':
s++;
*d = *s++;
if (isLOWER(*d))
*d = toupper(*d);
*d++ ^= 64;
continue;
case 'b':
*d++ = '\b';
break;
case 'n':
*d++ = '\n';
break;
case 'r':
*d++ = '\r';
break;
case 'f':
*d++ = '\f';
break;
case 't':
*d++ = '\t';
break;
case 'e':
*d++ = '\033';
break;
case 'a':
*d++ = '\007';
break;
}
s++;
continue;
}
*d++ = *s++;
}
*d = '\0';
if (arg[1].arg_type == A_DOUBLE && makesingle)
arg[1].arg_type = A_SINGLE; /* now we can optimize on it */
tmpstr->str_cur = d - tmpstr->str_ptr;
if (arg[1].arg_type == A_GLOB) {
arg[1].arg_ptr.arg_stab = stab = genstab();
stab_io(stab) = stio_new();
str_sset(stab_val(stab), tmpstr);
}
else
arg[1].arg_ptr.arg_str = tmpstr;
s = tmps;
if (tmpstr2)
str_free(tmpstr2);
break;
}
}
if (hereis)
str_free(herewas);
return s;
}
FCMD *
load_format()
{
FCMD froot;
FCMD *flinebeg;
char *eol;
register FCMD *fprev = &froot;
register FCMD *fcmd;
register char *s;
register char *t;
register STR *str;
bool noblank;
bool repeater;
Zero(&froot, 1, FCMD);
s = bufptr;
while (s < bufend || (rsfp && (s = str_gets(linestr,rsfp, 0)) != Nullch)) {
curcmd->c_line++;
if (in_eval && !rsfp) {
eol = index(s,'\n');
if (!eol++)
eol = bufend;
}
else
eol = bufend = linestr->str_ptr + linestr->str_cur;
if (perldb) {
STR *tmpstr = Str_new(89,0);
str_nset(tmpstr, s, eol-s);
astore(stab_xarray(curcmd->c_filestab), (int)curcmd->c_line,tmpstr);
}
if (*s == '.') {
/*SUPPRESS 530*/
for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
if (*t == '\n') {
bufptr = s;
return froot.f_next;
}
}
if (*s == '#') {
s = eol;
continue;
}
flinebeg = Nullfcmd;
noblank = FALSE;
repeater = FALSE;
while (s < eol) {
Newz(804,fcmd,1,FCMD);
fprev->f_next = fcmd;
fprev = fcmd;
for (t=s; t < eol && *t != '@' && *t != '^'; t++) {
if (*t == '~') {
noblank = TRUE;
*t = ' ';
if (t[1] == '~') {
repeater = TRUE;
t[1] = ' ';
}
}
}
fcmd->f_pre = nsavestr(s, t-s);
fcmd->f_presize = t-s;
s = t;
if (s >= eol) {
if (noblank)
fcmd->f_flags |= FC_NOBLANK;
if (repeater)
fcmd->f_flags |= FC_REPEAT;
break;
}
if (!flinebeg)
flinebeg = fcmd; /* start values here */
if (*s++ == '^')
fcmd->f_flags |= FC_CHOP; /* for doing text filling */
switch (*s) {
case '*':
fcmd->f_type = F_LINES;
*s = '\0';
break;
case '<':
fcmd->f_type = F_LEFT;
while (*s == '<')
s++;
break;
case '>':
fcmd->f_type = F_RIGHT;
while (*s == '>')
s++;
break;
case '|':
fcmd->f_type = F_CENTER;
while (*s == '|')
s++;
break;
case '#':
case '.':
/* Catch the special case @... and handle it as a string
field. */
if (*s == '.' && s[1] == '.') {
goto default_format;
}
fcmd->f_type = F_DECIMAL;
{
char *p;
/* Read a format in the form @####.####, where either group
of ### may be empty, or the final .### may be missing. */
while (*s == '#')
s++;
if (*s == '.') {
s++;
p = s;
while (*s == '#')
s++;
fcmd->f_decimals = s-p;
fcmd->f_flags |= FC_DP;
} else {
fcmd->f_decimals = 0;
}
}
break;
default:
default_format:
fcmd->f_type = F_LEFT;
break;
}
if (fcmd->f_flags & FC_CHOP && *s == '.') {
fcmd->f_flags |= FC_MORE;
while (*s == '.')
s++;
}
fcmd->f_size = s-t;
}
if (flinebeg) {
again:
if (s >= bufend &&
(!rsfp || (s = str_gets(linestr, rsfp, 0)) == Nullch) )
goto badform;
curcmd->c_line++;
if (in_eval && !rsfp) {
eol = index(s,'\n');
if (!eol++)
eol = bufend;
}
else
eol = bufend = linestr->str_ptr + linestr->str_cur;
if (perldb) {
STR *tmpstr = Str_new(90,0);
str_nset(tmpstr, s, eol-s);
astore(stab_xarray(curcmd->c_filestab),
(int)curcmd->c_line,tmpstr);
}
if (strnEQ(s,".\n",2)) {
bufptr = s;
yyerror("Missing values line");
return froot.f_next;
}
if (*s == '#') {
s = eol;
goto again;
}
str = flinebeg->f_unparsed = Str_new(91,eol - s);
str->str_u.str_hash = curstash;
str_nset(str,"(",1);
flinebeg->f_line = curcmd->c_line;
eol[-1] = '\0';
if (!flinebeg->f_next->f_type || index(s, ',')) {
eol[-1] = '\n';
str_ncat(str, s, eol - s - 1);
str_ncat(str,",$$);",5);
s = eol;
}
else {
eol[-1] = '\n';
while (s < eol && isSPACE(*s))
s++;
t = s;
while (s < eol) {
switch (*s) {
case ' ': case '\t': case '\n': case ';':
str_ncat(str, t, s - t);
str_ncat(str, "," ,1);
while (s < eol && (isSPACE(*s) || *s == ';'))
s++;
t = s;
break;
case '$':
str_ncat(str, t, s - t);
t = s;
s = scanident(s,eol,tokenbuf);
str_ncat(str, t, s - t);
t = s;
if (s < eol && *s && index("$'\"",*s))
str_ncat(str, ",", 1);
break;
case '"': case '\'':
str_ncat(str, t, s - t);
t = s;
s++;
while (s < eol && (*s != *t || s[-1] == '\\'))
s++;
if (s < eol)
s++;
str_ncat(str, t, s - t);
t = s;
if (s < eol && *s && index("$'\"",*s))
str_ncat(str, ",", 1);
break;
default:
yyerror("Please use commas to separate fields");
}
}
str_ncat(str,"$$);",4);
}
}
}
badform:
bufptr = str_get(linestr);
yyerror("Format not terminated");
return froot.f_next;
}
static void
set_csh()
{
#ifdef CSH
if (!cshlen)
cshlen = strlen(cshname);
#endif
}