/* $RCSfile: toke.c,v $$Revision: 4.0.1.4 $$Date: 91/11/05 19:02:48 $ * * 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.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" #ifdef I_FCNTL #include #endif #ifdef I_SYS_FILE #include #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)) #define META(c) ((c) | 128) #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) /* 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, \ (*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. */ #define LOP(f) return(CLINE, *s == '(' || (s = skipspace(s), *s == '(') ? \ (*s = (char) META('('), bufptr = oldbufptr, '(') : \ (yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP)) /* 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; } #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; 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 == '(') { *s = META('('); bufptr = oldbufptr; return '('; } else { yylval.ival=f; expectterm = TRUE; bufptr = s; return LISTOP; } } #endif /* CRIPPLED_CC */ 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 warn("Unrecognized character \\%03o ignored", *s++ & 255); goto retry; } #endif switch (*s) { default: if ((*s & 127) == '(') { *s++ = '('; oldbufptr = s; } 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 */ 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++; 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) OPERATOR('-'); else AOP(O_SUBTRACT); case '+': tmp = *s++; if (*s == tmp) { s++; RETURN(INC); } if (expectterm) OPERATOR('+'); else AOP(O_ADD); case '*': if (expectterm) { 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) { 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 */ OPERATOR(tmp); case ';': if (curcmd->c_line < cmdline) cmdline = curcmd->c_line; tmp = *s++; OPERATOR(tmp); case ')': case ']': tmp = *s++; TERM(tmp); case '}': tmp = *s++; RETURN(tmp); 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 */ 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) { s = scanstr(s); 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); TERM(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) { 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++; OPERATOR(DOTDOT); } 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); TERM(RSTRING); case '\\': /* some magic to force next word to be a WORD */ s++; /* used by do and sub to force a separate namespace */ /* 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__")) { #ifndef TAINT STAB *stab; int fd; /*SUPPRESS 560*/ if (stab = stabent("DATA",FALSE)) { stab->str_pok |= SP_MULTI; 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; } #endif 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; 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,"filehandle"); LOP(O_PRINT); } if (strEQ(d,"printf")) { checkcomma(s,"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); break; case 'q': case 'Q': SNARFWORD; if (strEQ(d,"q")) { s = scanstr(s-1); TERM(RSTRING); } if (strEQ(d,"qq")) { s = scanstr(s-2); TERM(RSTRING); } if (strEQ(d,"qx")) { s = scanstr(s-2); 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,"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); 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 */ if (perldb) { savelong(&subline); saveitem(subname); } subline = curcmd->c_line; d = bufend; while (s < d && isSPACE(*s)) s++; if (isALPHA(*s) || *s == '_' || *s == '\'') { if (perldb) { 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 if (perldb) 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': SNARFWORD; if (!expectterm && strEQ(d,"x")) MOP(O_REPEAT); 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); 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,what) register char *s; char *what; { char *someword; if (*s == '(') s++; while (s < bufend && isSPACE(*s)) s++; if (isALPHA(*s) || *s == '_') { someword = s++; while (isALNUM(*s)) s++; while (s < bufend && isSPACE(*s)) s++; if (*s == ',') { *s = '\0'; someword = instr( "tell eof times getlogin wait length shift umask getppid \ cos exp int log rand sin sqrt ord wantarray", someword); *s = ','; if (someword) 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; } (void)bcopy(d+1,d,e-d); 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) #ifdef STRUCTCOPY savespat = *spat; #else (void)bcopy((char *)spat, (char *)&savespat, sizeof(SPAT)); #endif 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) #ifdef STRUCTCOPY *spat = savespat; #else (void)bcopy((char *)&savespat, (char *)spat, sizeof(SPAT)); #endif 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(s) register char *s; { register SPAT *spat; register char *d; register char *e; int len; STR *str = Str_new(93,0); 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,*s,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: s = scanstr(s); 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') { if (*s == 'e') { s++; if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE) spat->spat_repl[1].arg_type = A_SINGLE; spat->spat_repl = make_op( (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 * expand_charset(s,len,retlen) register char *s; int len; int *retlen; { char t[520]; register char *d = t; register int i; register char *send = s + len; while (s < send && d - t <= 256) { if (s[1] == '-' && s+2 < send) { for (i = (s[0] & 0377); i <= (s[2] & 0377); i++) *d++ = i; s += 3; } else *d++ = *s++; } *d = '\0'; *retlen = d - t; return nsavestr(t,d-t); } char * scantrans(s) register char *s; { ARG *arg = l(make_op(O_TRANS,2,stab2arg(A_STAB,defstab),Nullarg,Nullarg)); 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); if (s >= bufend) { yyerror("Translation pattern not terminated"); yylval.arg = Nullarg; return s; } t = expand_charset(yylval.arg[1].arg_ptr.arg_str->str_ptr, yylval.arg[1].arg_ptr.arg_str->str_cur,&tlen); arg_free(yylval.arg); s = scanstr(s-1); if (s >= bufend) { yyerror("Translation replacement not terminated"); yylval.arg = Nullarg; return s; } 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++; } r = expand_charset(yylval.arg[1].arg_ptr.arg_str->str_ptr, yylval.arg[1].arg_ptr.arg_str->str_cur,&rlen); arg_free(yylval.arg); arg[2].arg_len = delete|squash; yylval.arg = arg; if (!rlen && !delete) { Safefree(r); r = t; rlen = tlen; } 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 tbl[i] = r[j-1]; } else tbl[i] = r[j++]; } } } else { 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; } } if (r != t) Safefree(r); Safefree(t); return s; } char * scanstr(s) register char *s; { 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; char *leave = "\\$@nrtfbeacx0123456789[{]}lLuUE"; /* which backslash sequences to keep */ 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] && index("0123456789eE ;",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 (*++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++; if (*d == '$') d++; while (*d && (isALNUM(*d) || *d == '\'')) d++; if (d - tokenbuf != len) { d = tokenbuf; arg[1].arg_type = A_GLOB; d = nsavestr(d,len); arg[1].arg_ptr.arg_stab = stab = genstab(); stab_io(stab) = stio_new(); stab_val(stab) = str_make(d,len); Safefree(d); set_csh(); } 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; char *tmps; 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_MASK) == 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 = tmpstr->str_ptr; /* assuming shrinkage only */ while (s < send) { 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); /* make sure it exists */ while (len--) *d++ = *s++; continue; } else if (*s == '\\' && s+1 < send) { s++; switch (*s) { 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_MASK) == A_DOUBLE && makesingle) arg[1].arg_type = A_SINGLE; /* now we can optimize on it */ tmpstr->str_cur = d - tmpstr->str_ptr; arg[1].arg_ptr.arg_str = tmpstr; s = tmps; 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; } set_csh() { #ifdef CSH if (!cshlen) cshlen = strlen(cshname); #endif }