toke.c

   1 /* $Header: toke.c,v 3.0.1.10 90/10/16 11:20:46 lwall Locked $
   2  *
   3  *    Copyright (c) 1989, Larry Wall
   4  *
   5  *    You may distribute under the terms of the GNU General Public License
   6  *    as specified in the README file that comes with the perl 3.0 kit.
   7  *
   8  * $Log:        toke.c,v $
   9  * Revision 3.0.1.10  90/10/16  11:20:46  lwall
  10  * patch29: the length of a search pattern was limited
  11  * patch29: added DATA filehandle to read stuff after __END__
  12  * patch29: added -M, -A and -C
  13  * patch29: added cmp and <=>
  14  * patch29: added caller
  15  * patch29: added scalar
  16  * patch29: added sysread and syswrite
  17  * patch29: added SysV IPC
  18  * patch29: added waitpid
  19  * patch29: tr/// now understands c, d and s options, and handles nulls right
  20  * patch29: 0x80000000 now makes unsigned value
  21  * patch29: Null could not be used as a delimiter
  22  * patch29: added @###.## fields to format
  23  *
  24  * Revision 3.0.1.9  90/08/13  22:37:25  lwall
  25  * patch28: defined(@array) and defined(%array) didn't work right
  26  *
  27  * Revision 3.0.1.8  90/08/09  05:39:58  lwall
  28  * patch19: added require operator
  29  * patch19: added -x switch to extract script from input trash
  30  * patch19: bare @name didn't add array to symbol table
  31  * patch19: Added __LINE__ and __FILE__ tokens
  32  * patch19: Added __END__ token
  33  * patch19: Numeric literals are now stored only in floating point
  34  * patch19: some support for FPS compiler misfunction
  35  * patch19: "\\$foo" not handled right
  36  * patch19: program and data can now both come from STDIN
  37  * patch19: "here" strings caused warnings about uninitialized variables
  38  *
  39  * Revision 3.0.1.7  90/03/27  16:32:37  lwall
  40  * patch16: MSDOS support
  41  * patch16: formats didn't work inside eval
  42  * patch16: final semicolon in program wasn't optional with -p or -n
  43  *
  44  * Revision 3.0.1.6  90/03/12  17:06:36  lwall
  45  * patch13: last semicolon of program is now optional, just for Randal
  46  * patch13: added splice operator: @oldelems = splice(@array,$offset,$len,LIST)
  47  *
  48  * Revision 3.0.1.5  90/02/28  18:47:06  lwall
  49  * patch9: return grandfathered to never be function call
  50  * patch9: non-existent perldb.pl now gives reasonable error message
  51  * patch9: perl can now start up other interpreters scripts
  52  * patch9: line numbers were bogus during certain portions of foreach evaluation
  53  * patch9: null hereis core dumped
  54  *
  55  * Revision 3.0.1.4  89/12/21  20:26:56  lwall
  56  * patch7: -d switch incompatible with -p or -n
  57  * patch7: " ''$foo'' " didn't parse right
  58  * patch7: grandfathered m'pat' and s'pat'repl' to not be package qualifiers
  59  *
  60  * Revision 3.0.1.3  89/11/17  15:43:15  lwall
  61  * patch5: IBM PC/RT compiler can't deal with UNI() and LOP() macros
  62  * patch5: } misadjusted expection of subsequent term or operator
  63  * patch5: y/abcde// didn't work
  64  *
  65  * Revision 3.0.1.2  89/11/11  05:04:42  lwall
  66  * patch2: fixed a CLINE macro conflict
  67  *
  68  * Revision 3.0.1.1  89/10/26  23:26:21  lwall
  69  * patch1: disambiguated word after "sort" better
  70  *
  71  * Revision 3.0  89/10/18  15:32:33  lwall
  72  * 3.0 baseline
  73  *
  74  */
  75
  76 #include "EXTERN.h"
  77 #include "perl.h"
  78 #include "perly.h"
  79
  80 #ifdef I_FCNTL
  81 #include <fcntl.h>
  82 #endif
  83
  84 /* which backslash sequences to keep in m// or s// */
  85
  86 static char *patleave = "\\.^$@dDwWsSbB+*?|()-nrtf0123456789[{]}";
  87
  88 char *reparse;          /* if non-null, scanreg found ${foo[$bar]} */
  89
  90 #ifdef CLINE
  91 #undef CLINE
  92 #endif
  93 #define CLINE (cmdline = (curcmd->c_line < cmdline ? curcmd->c_line : cmdline))
  94
  95 #define META(c) ((c) | 128)
  96
  97 #define RETURN(retval) return (bufptr = s,(int)retval)
  98 #define OPERATOR(retval) return (expectterm = TRUE,bufptr = s,(int)retval)
  99 #define TERM(retval) return (CLINE, expectterm = FALSE,bufptr = s,(int)retval)
 100 #define LOOPX(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)LOOPEX)
 101 #define FTST(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)FILETEST)
 102 #define FUN0(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC0)
 103 #define FUN1(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC1)
 104 #define FUN2(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2)
 105 #define FUN2x(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC2x)
 106 #define FUN3(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC3)
 107 #define FUN4(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC4)
 108 #define FUN5(f) return(yylval.ival = f,expectterm = FALSE,bufptr = s,(int)FUNC5)
 109 #define FL(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST)
 110 #define FL2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FLIST2)
 111 #define HFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)HSHFUN)
 112 #define HFUN3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)HSHFUN3)
 113 #define LFUN(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LVALFUN)
 114 #define AOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)ADDOP)
 115 #define MOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)MULOP)
 116 #define EOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)EQOP)
 117 #define ROP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)RELOP)
 118 #define FOP(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP)
 119 #define FOP2(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP2)
 120 #define FOP3(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP3)
 121 #define FOP4(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP4)
 122 #define FOP22(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP22)
 123 #define FOP25(f) return(yylval.ival=f,expectterm = FALSE,bufptr = s,(int)FILOP25)
 124
 125 /* This bit of chicanery makes a unary function followed by
 126  * a parenthesis into a function with one argument, highest precedence.
 127  */
 128 #define UNI(f) return(yylval.ival = f,expectterm = TRUE,bufptr = s, \
 129         (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
 130
 131 /* This does similarly for list operators, merely by pretending that the
 132  * paren came before the listop rather than after.
 133  */
 134 #define LOP(f) return(*s == '(' || (s = skipspace(s), *s == '(') ? \
 135         (*s = META('('), bufptr = oldbufptr, '(') : \
 136         (yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP))
 137 /* grandfather return to old style */
 138 #define OLDLOP(f) return(yylval.ival=f,expectterm = TRUE,bufptr = s,(int)LISTOP)
 139
 140 char *
 141 skipspace(s)
 142 register char *s;
 143 {
 144     while (s < bufend && isascii(*s) && isspace(*s))
 145         s++;
 146     return s;
 147 }
 148
 149 #ifdef CRIPPLED_CC
 150
 151 #undef UNI
 152 #undef LOP
 153 #define UNI(f) return uni(f,s)
 154 #define LOP(f) return lop(f,s)
 155
 156 int
 157 uni(f,s)
 158 int f;
 159 char *s;
 160 {
 161     yylval.ival = f;
 162     expectterm = TRUE;
 163     bufptr = s;
 164     if (*s == '(')
 165         return FUNC1;
 166     s = skipspace(s);
 167     if (*s == '(')
 168         return FUNC1;
 169     else
 170         return UNIOP;
 171 }
 172
 173 int
 174 lop(f,s)
 175 int f;
 176 char *s;
 177 {
 178     if (*s != '(')
 179         s = skipspace(s);
 180     if (*s == '(') {
 181         *s = META('(');
 182         bufptr = oldbufptr;
 183         return '(';
 184     }
 185     else {
 186         yylval.ival=f;
 187         expectterm = TRUE;
 188         bufptr = s;
 189         return LISTOP;
 190     }
 191 }
 192
 193 #endif /* CRIPPLED_CC */
 194
 195 yylex()
 196 {
 197     register char *s = bufptr;
 198     register char *d;
 199     register int tmp;
 200     static bool in_format = FALSE;
 201     static bool firstline = TRUE;
 202     extern int yychar;          /* last token */
 203
 204     oldoldbufptr = oldbufptr;
 205     oldbufptr = s;
 206
 207   retry:
 208 #ifdef YYDEBUG
 209     if (debug & 1)
 210         if (index(s,'\n'))
 211             fprintf(stderr,"Tokener at %s",s);
 212         else
 213             fprintf(stderr,"Tokener at %s\n",s);
 214 #endif
 215 #ifdef BADSWITCH
 216     if (*s & 128) {
 217         if ((*s & 127) == '(')
 218             *s++ = '(';
 219         else
 220             warn("Unrecognized character \\%03o ignored", *s++);
 221         goto retry;
 222     }
 223 #endif
 224     switch (*s) {
 225     default:
 226         if ((*s & 127) == '(')
 227             *s++ = '(';
 228         else
 229             warn("Unrecognized character \\%03o ignored", *s++);
 230         goto retry;
 231     case 4:
 232     case 26:
 233         goto fake_eof;                  /* emulate EOF on ^D or ^Z */
 234     case 0:
 235         if (!rsfp)
 236             RETURN(0);
 237         if (s++ < bufend)
 238             goto retry;                 /* ignore stray nulls */
 239         if (firstline) {
 240             firstline = FALSE;
 241             if (minus_n || minus_p || perldb) {
 242                 str_set(linestr,"");
 243                 if (perldb) {
 244                     char *getenv();
 245                     char *pdb = getenv("PERLDB");
 246
 247                     str_cat(linestr, pdb ? pdb : "require 'perldb.pl'");
 248                     str_cat(linestr, ";");
 249                 }
 250                 if (minus_n || minus_p) {
 251                     str_cat(linestr,"line: while (<>) {");
 252                     if (minus_a)
 253                         str_cat(linestr,"@F=split(' ');");
 254                 }
 255                 oldoldbufptr = oldbufptr = s = str_get(linestr);
 256                 bufend = linestr->str_ptr + linestr->str_cur;
 257                 goto retry;
 258             }
 259         }
 260         if (in_format) {
 261             bufptr = bufend;
 262             yylval.formval = load_format();
 263             in_format = FALSE;
 264             oldoldbufptr = oldbufptr = s = str_get(linestr) + 1;
 265             bufend = linestr->str_ptr + linestr->str_cur;
 266             OPERATOR(FORMLIST);
 267         }
 268         curcmd->c_line++;
 269 #ifdef CRYPTSCRIPT
 270         cryptswitch();
 271 #endif /* CRYPTSCRIPT */
 272         do {
 273             if ((s = str_gets(linestr, rsfp, 0)) == Nullch) {
 274               fake_eof:
 275                 if (rsfp) {
 276                     if (preprocess)
 277                         (void)mypclose(rsfp);
 278                     else if (rsfp == stdin)
 279                         clearerr(stdin);
 280                     else
 281                         (void)fclose(rsfp);
 282                     rsfp = Nullfp;
 283                 }
 284                 if (minus_n || minus_p) {
 285                     str_set(linestr,minus_p ? ";}continue{print" : "");
 286                     str_cat(linestr,";}");
 287                     oldoldbufptr = oldbufptr = s = str_get(linestr);
 288                     bufend = linestr->str_ptr + linestr->str_cur;
 289                     minus_n = minus_p = 0;
 290                     goto retry;
 291                 }
 292                 oldoldbufptr = oldbufptr = s = str_get(linestr);
 293                 str_set(linestr,"");
 294                 RETURN(';');    /* not infinite loop because rsfp is NULL now */
 295             }
 296             if (doextract && *linestr->str_ptr == '#')
 297                 doextract = FALSE;
 298         } while (doextract);
 299         oldoldbufptr = oldbufptr = bufptr = s;
 300         if (perldb) {
 301             STR *str = Str_new(85,0);
 302
 303             str_sset(str,linestr);
 304             astore(stab_xarray(curcmd->c_filestab),(int)curcmd->c_line,str);
 305         }
 306 #ifdef DEBUG
 307         if (firstline) {
 308             char *showinput();
 309             s = showinput();
 310         }
 311 #endif
 312         bufend = linestr->str_ptr + linestr->str_cur;
 313         if (curcmd->c_line == 1) {
 314             if (*s == '#' && s[1] == '!') {
 315                 if (!in_eval && !instr(s,"perl") && instr(origargv[0],"perl")) {
 316                     char **newargv;
 317                     char *cmd;
 318
 319                     s += 2;
 320                     if (*s == ' ')
 321                         s++;
 322                     cmd = s;
 323                     while (s < bufend && !isspace(*s))
 324                         s++;
 325                     *s++ = '\0';
 326                     while (s < bufend && isspace(*s))
 327                         s++;
 328                     if (s < bufend) {
 329                         Newz(899,newargv,origargc+3,char*);
 330                         newargv[1] = s;
 331                         while (s < bufend && !isspace(*s))
 332                             s++;
 333                         *s = '\0';
 334                         Copy(origargv+1, newargv+2, origargc+1, char*);
 335                     }
 336                     else
 337                         newargv = origargv;
 338                     newargv[0] = cmd;
 339                     execv(cmd,newargv);
 340                     fatal("Can't exec %s", cmd);
 341                 }
 342             }
 343             else {
 344                 while (s < bufend && isspace(*s))
 345                     s++;
 346                 if (*s == ':')  /* for csh's that have to exec sh scripts */
 347                     s++;
 348             }
 349         }
 350         goto retry;
 351     case ' ': case '\t': case '\f':
 352         s++;
 353         goto retry;
 354     case '#':
 355         if (preprocess && s == str_get(linestr) &&
 356                s[1] == ' ' && isdigit(s[2])) {
 357             curcmd->c_line = atoi(s+2)-1;
 358             for (s += 2; isdigit(*s); s++) ;
 359             d = bufend;
 360             while (s < d && isspace(*s)) s++;
 361             s[strlen(s)-1] = '\0';      /* wipe out newline */
 362             if (*s == '"') {
 363                 s++;
 364                 s[strlen(s)-1] = '\0';  /* wipe out trailing quote */
 365             }
 366             if (*s)
 367                 curcmd->c_filestab = fstab(s);
 368             else
 369                 curcmd->c_filestab = fstab(origfilename);
 370             oldoldbufptr = oldbufptr = s = str_get(linestr);
 371         }
 372         /* FALL THROUGH */
 373     case '\n':
 374         if (in_eval && !rsfp) {
 375             d = bufend;
 376             while (s < d && *s != '\n')
 377                 s++;
 378             if (s < d)
 379                 s++;
 380             if (perldb) {
 381                 STR *str = Str_new(85,0);
 382
 383                 str_nset(str,linestr->str_ptr, s - linestr->str_ptr);
 384                 astore(stab_xarray(curcmd->c_filestab),(int)curcmd->c_line,str);
 385                 str_chop(linestr, s);
 386             }
 387             if (in_format) {
 388                 bufptr = s;
 389                 yylval.formval = load_format();
 390                 in_format = FALSE;
 391                 oldoldbufptr = oldbufptr = s = bufptr + 1;
 392                 TERM(FORMLIST);
 393             }
 394             curcmd->c_line++;
 395         }
 396         else {
 397             *s = '\0';
 398             bufend = s;
 399         }
 400         goto retry;
 401     case '-':
 402         if (s[1] && isalpha(s[1]) && !isalpha(s[2])) {
 403             s++;
 404             switch (*s++) {
 405             case 'r': FTST(O_FTEREAD);
 406             case 'w': FTST(O_FTEWRITE);
 407             case 'x': FTST(O_FTEEXEC);
 408             case 'o': FTST(O_FTEOWNED);
 409             case 'R': FTST(O_FTRREAD);
 410             case 'W': FTST(O_FTRWRITE);
 411             case 'X': FTST(O_FTREXEC);
 412             case 'O': FTST(O_FTROWNED);
 413             case 'e': FTST(O_FTIS);
 414             case 'z': FTST(O_FTZERO);
 415             case 's': FTST(O_FTSIZE);
 416             case 'f': FTST(O_FTFILE);
 417             case 'd': FTST(O_FTDIR);
 418             case 'l': FTST(O_FTLINK);
 419             case 'p': FTST(O_FTPIPE);
 420             case 'S': FTST(O_FTSOCK);
 421             case 'u': FTST(O_FTSUID);
 422             case 'g': FTST(O_FTSGID);
 423             case 'k': FTST(O_FTSVTX);
 424             case 'b': FTST(O_FTBLK);
 425             case 'c': FTST(O_FTCHR);
 426             case 't': FTST(O_FTTTY);
 427             case 'T': FTST(O_FTTEXT);
 428             case 'B': FTST(O_FTBINARY);
 429             case 'M': stabent("\024",TRUE); FTST(O_FTMTIME);
 430             case 'A': stabent("\024",TRUE); FTST(O_FTATIME);
 431             case 'C': stabent("\024",TRUE); FTST(O_FTCTIME);
 432             default:
 433                 s -= 2;
 434                 break;
 435             }
 436         }
 437         tmp = *s++;
 438         if (*s == tmp) {
 439             s++;
 440             RETURN(DEC);
 441         }
 442         if (expectterm)
 443             OPERATOR('-');
 444         else
 445             AOP(O_SUBTRACT);
 446     case '+':
 447         tmp = *s++;
 448         if (*s == tmp) {
 449             s++;
 450             RETURN(INC);
 451         }
 452         if (expectterm)
 453             OPERATOR('+');
 454         else
 455             AOP(O_ADD);
 456
 457     case '*':
 458         if (expectterm) {
 459             s = scanreg(s,bufend,tokenbuf);
 460             yylval.stabval = stabent(tokenbuf,TRUE);
 461             TERM(STAR);
 462         }
 463         tmp = *s++;
 464         if (*s == tmp) {
 465             s++;
 466             OPERATOR(POW);
 467         }
 468         MOP(O_MULTIPLY);
 469     case '%':
 470         if (expectterm) {
 471             s = scanreg(s,bufend,tokenbuf);
 472             yylval.stabval = hadd(stabent(tokenbuf,TRUE));
 473             TERM(HSH);
 474         }
 475         s++;
 476         MOP(O_MODULO);
 477
 478     case '^':
 479     case '~':
 480     case '(':
 481     case ',':
 482     case ':':
 483     case '[':
 484         tmp = *s++;
 485         OPERATOR(tmp);
 486     case '{':
 487         tmp = *s++;
 488         if (isspace(*s) || *s == '#')
 489             cmdline = NOLINE;   /* invalidate current command line number */
 490         OPERATOR(tmp);
 491     case ';':
 492         if (curcmd->c_line < cmdline)
 493             cmdline = curcmd->c_line;
 494         tmp = *s++;
 495         OPERATOR(tmp);
 496     case ')':
 497     case ']':
 498         tmp = *s++;
 499         TERM(tmp);
 500     case '}':
 501         tmp = *s++;
 502         RETURN(tmp);
 503     case '&':
 504         s++;
 505         tmp = *s++;
 506         if (tmp == '&')
 507             OPERATOR(ANDAND);
 508         s--;
 509         if (expectterm) {
 510             d = bufend;
 511             while (s < d && isspace(*s))
 512                 s++;
 513             if (isalpha(*s) || *s == '_' || *s == '\'')
 514                 *(--s) = '\\';  /* force next ident to WORD */
 515             OPERATOR(AMPER);
 516         }
 517         OPERATOR('&');
 518     case '|':
 519         s++;
 520         tmp = *s++;
 521         if (tmp == '|')
 522             OPERATOR(OROR);
 523         s--;
 524         OPERATOR('|');
 525     case '=':
 526         s++;
 527         tmp = *s++;
 528         if (tmp == '=')
 529             EOP(O_EQ);
 530         if (tmp == '~')
 531             OPERATOR(MATCH);
 532         s--;
 533         OPERATOR('=');
 534     case '!':
 535         s++;
 536         tmp = *s++;
 537         if (tmp == '=')
 538             EOP(O_NE);
 539         if (tmp == '~')
 540             OPERATOR(NMATCH);
 541         s--;
 542         OPERATOR('!');
 543     case '<':
 544         if (expectterm) {
 545             s = scanstr(s);
 546             TERM(RSTRING);
 547         }
 548         s++;
 549         tmp = *s++;
 550         if (tmp == '<')
 551             OPERATOR(LS);
 552         if (tmp == '=') {
 553             tmp = *s++;
 554             if (tmp == '>')
 555                 EOP(O_NCMP);
 556             s--;
 557             ROP(O_LE);
 558         }
 559         s--;
 560         ROP(O_LT);
 561     case '>':
 562         s++;
 563         tmp = *s++;
 564         if (tmp == '>')
 565             OPERATOR(RS);
 566         if (tmp == '=')
 567             ROP(O_GE);
 568         s--;
 569         ROP(O_GT);
 570
 571 #define SNARFWORD \
 572         d = tokenbuf; \
 573         while (isascii(*s) && \
 574           (isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')) \
 575             *d++ = *s++; \
 576         while (d[-1] == '\'') \
 577             d--,s--; \
 578         *d = '\0'; \
 579         d = tokenbuf;
 580
 581     case '$':
 582         if (s[1] == '#' && (isalpha(s[2]) || s[2] == '_')) {
 583             s++;
 584             s = scanreg(s,bufend,tokenbuf);
 585             yylval.stabval = aadd(stabent(tokenbuf,TRUE));
 586             TERM(ARYLEN);
 587         }
 588         d = s;
 589         s = scanreg(s,bufend,tokenbuf);
 590         if (reparse) {          /* turn ${foo[bar]} into ($foo[bar]) */
 591           do_reparse:
 592             s[-1] = ')';
 593             s = d;
 594             s[1] = s[0];
 595             s[0] = '(';
 596             goto retry;
 597         }
 598         yylval.stabval = stabent(tokenbuf,TRUE);
 599         TERM(REG);
 600
 601     case '@':
 602         d = s;
 603         s = scanreg(s,bufend,tokenbuf);
 604         if (reparse)
 605             goto do_reparse;
 606         yylval.stabval = aadd(stabent(tokenbuf,TRUE));
 607         TERM(ARY);
 608
 609     case '/':                   /* may either be division or pattern */
 610     case '?':                   /* may either be conditional or pattern */
 611         if (expectterm) {
 612             s = scanpat(s);
 613             TERM(PATTERN);
 614         }
 615         tmp = *s++;
 616         if (tmp == '/')
 617             MOP(O_DIVIDE);
 618         OPERATOR(tmp);
 619
 620     case '.':
 621         if (!expectterm || !isdigit(s[1])) {
 622             tmp = *s++;
 623             if (*s == tmp) {
 624                 s++;
 625                 OPERATOR(DOTDOT);
 626             }
 627             AOP(O_CONCAT);
 628         }
 629         /* FALL THROUGH */
 630     case '0': case '1': case '2': case '3': case '4':
 631     case '5': case '6': case '7': case '8': case '9':
 632     case '\'': case '"': case '`':
 633         s = scanstr(s);
 634         TERM(RSTRING);
 635
 636     case '\\':  /* some magic to force next word to be a WORD */
 637         s++;    /* used by do and sub to force a separate namespace */
 638         /* FALL THROUGH */
 639     case '_':
 640         SNARFWORD;
 641         if (d[1] == '_') {
 642             if (strEQ(d,"__LINE__") || strEQ(d,"__FILE__")) {
 643                 ARG *arg = op_new(1);
 644
 645                 yylval.arg = arg;
 646                 arg->arg_type = O_ITEM;
 647                 if (d[2] == 'L')
 648                     (void)sprintf(tokenbuf,"%ld",(long)curcmd->c_line);
 649                 else
 650                     strcpy(tokenbuf, stab_val(curcmd->c_filestab)->str_ptr);
 651                 arg[1].arg_type = A_SINGLE;
 652                 arg[1].arg_ptr.arg_str = str_make(tokenbuf,strlen(tokenbuf));
 653                 TERM(RSTRING);
 654             }
 655             else if (strEQ(d,"__END__")) {
 656 #ifndef TAINT
 657                 STAB *stab;
 658                 int fd;
 659
 660                 if (stab = stabent("DATA",FALSE)) {
 661                     stab->str_pok |= SP_MULTI;
 662                     stab_io(stab) = stio_new();
 663                     stab_io(stab)->ifp = rsfp;
 664 #if defined(FCNTL) && defined(F_SETFD)
 665                     fd = fileno(rsfp);
 666                     fcntl(fd,F_SETFD,fd >= 3);
 667 #endif
 668                     if (preprocess)
 669                         stab_io(stab)->type = '|';
 670                     else if (rsfp == stdin)
 671                         stab_io(stab)->type = '-';
 672                     else
 673                         stab_io(stab)->type = '<';
 674                     rsfp = Nullfp;
 675                 }
 676 #endif
 677                 goto fake_eof;
 678             }
 679         }
 680         break;
 681     case 'a': case 'A':
 682         SNARFWORD;
 683         if (strEQ(d,"accept"))
 684             FOP22(O_ACCEPT);
 685         if (strEQ(d,"atan2"))
 686             FUN2(O_ATAN2);
 687         break;
 688     case 'b': case 'B':
 689         SNARFWORD;
 690         if (strEQ(d,"bind"))
 691             FOP2(O_BIND);
 692         if (strEQ(d,"binmode"))
 693             FOP(O_BINMODE);
 694         break;
 695     case 'c': case 'C':
 696         SNARFWORD;
 697         if (strEQ(d,"chop"))
 698             LFUN(O_CHOP);
 699         if (strEQ(d,"continue"))
 700             OPERATOR(CONTINUE);
 701         if (strEQ(d,"chdir")) {
 702             (void)stabent("ENV",TRUE);  /* may use HOME */
 703             UNI(O_CHDIR);
 704         }
 705         if (strEQ(d,"close"))
 706             FOP(O_CLOSE);
 707         if (strEQ(d,"closedir"))
 708             FOP(O_CLOSEDIR);
 709         if (strEQ(d,"cmp"))
 710             EOP(O_SCMP);
 711         if (strEQ(d,"caller"))
 712             UNI(O_CALLER);
 713         if (strEQ(d,"crypt")) {
 714 #ifdef FCRYPT
 715             init_des();
 716 #endif
 717             FUN2(O_CRYPT);
 718         }
 719         if (strEQ(d,"chmod"))
 720             LOP(O_CHMOD);
 721         if (strEQ(d,"chown"))
 722             LOP(O_CHOWN);
 723         if (strEQ(d,"connect"))
 724             FOP2(O_CONNECT);
 725         if (strEQ(d,"cos"))
 726             UNI(O_COS);
 727         if (strEQ(d,"chroot"))
 728             UNI(O_CHROOT);
 729         break;
 730     case 'd': case 'D':
 731         SNARFWORD;
 732         if (strEQ(d,"do")) {
 733             d = bufend;
 734             while (s < d && isspace(*s))
 735                 s++;
 736             if (isalpha(*s) || *s == '_')
 737                 *(--s) = '\\';  /* force next ident to WORD */
 738             OPERATOR(DO);
 739         }
 740         if (strEQ(d,"die"))
 741             LOP(O_DIE);
 742         if (strEQ(d,"defined"))
 743             LFUN(O_DEFINED);
 744         if (strEQ(d,"delete"))
 745             OPERATOR(DELETE);
 746         if (strEQ(d,"dbmopen"))
 747             HFUN3(O_DBMOPEN);
 748         if (strEQ(d,"dbmclose"))
 749             HFUN(O_DBMCLOSE);
 750         if (strEQ(d,"dump"))
 751             LOOPX(O_DUMP);
 752         break;
 753     case 'e': case 'E':
 754         SNARFWORD;
 755         if (strEQ(d,"else"))
 756             OPERATOR(ELSE);
 757         if (strEQ(d,"elsif")) {
 758             yylval.ival = curcmd->c_line;
 759             OPERATOR(ELSIF);
 760         }
 761         if (strEQ(d,"eq") || strEQ(d,"EQ"))
 762             EOP(O_SEQ);
 763         if (strEQ(d,"exit"))
 764             UNI(O_EXIT);
 765         if (strEQ(d,"eval")) {
 766             allstabs = TRUE;            /* must initialize everything since */
 767             UNI(O_EVAL);                /* we don't know what will be used */
 768         }
 769         if (strEQ(d,"eof"))
 770             FOP(O_EOF);
 771         if (strEQ(d,"exp"))
 772             UNI(O_EXP);
 773         if (strEQ(d,"each"))
 774             HFUN(O_EACH);
 775         if (strEQ(d,"exec")) {
 776             set_csh();
 777             LOP(O_EXEC_OP);
 778         }
 779         if (strEQ(d,"endhostent"))
 780             FUN0(O_EHOSTENT);
 781         if (strEQ(d,"endnetent"))
 782             FUN0(O_ENETENT);
 783         if (strEQ(d,"endservent"))
 784             FUN0(O_ESERVENT);
 785         if (strEQ(d,"endprotoent"))
 786             FUN0(O_EPROTOENT);
 787         if (strEQ(d,"endpwent"))
 788             FUN0(O_EPWENT);
 789         if (strEQ(d,"endgrent"))
 790             FUN0(O_EGRENT);
 791         break;
 792     case 'f': case 'F':
 793         SNARFWORD;
 794         if (strEQ(d,"for") || strEQ(d,"foreach")) {
 795             yylval.ival = curcmd->c_line;
 796             OPERATOR(FOR);
 797         }
 798         if (strEQ(d,"format")) {
 799             d = bufend;
 800             while (s < d && isspace(*s))
 801                 s++;
 802             if (isalpha(*s) || *s == '_')
 803                 *(--s) = '\\';  /* force next ident to WORD */
 804             in_format = TRUE;
 805             allstabs = TRUE;            /* must initialize everything since */
 806             OPERATOR(FORMAT);           /* we don't know what will be used */
 807         }
 808         if (strEQ(d,"fork"))
 809             FUN0(O_FORK);
 810         if (strEQ(d,"fcntl"))
 811             FOP3(O_FCNTL);
 812         if (strEQ(d,"fileno"))
 813             FOP(O_FILENO);
 814         if (strEQ(d,"flock"))
 815             FOP2(O_FLOCK);
 816         break;
 817     case 'g': case 'G':
 818         SNARFWORD;
 819         if (strEQ(d,"gt") || strEQ(d,"GT"))
 820             ROP(O_SGT);
 821         if (strEQ(d,"ge") || strEQ(d,"GE"))
 822             ROP(O_SGE);
 823         if (strEQ(d,"grep"))
 824             FL2(O_GREP);
 825         if (strEQ(d,"goto"))
 826             LOOPX(O_GOTO);
 827         if (strEQ(d,"gmtime"))
 828             UNI(O_GMTIME);
 829         if (strEQ(d,"getc"))
 830             FOP(O_GETC);
 831         if (strnEQ(d,"get",3)) {
 832             d += 3;
 833             if (*d == 'p') {
 834                 if (strEQ(d,"ppid"))
 835                     FUN0(O_GETPPID);
 836                 if (strEQ(d,"pgrp"))
 837                     UNI(O_GETPGRP);
 838                 if (strEQ(d,"priority"))
 839                     FUN2(O_GETPRIORITY);
 840                 if (strEQ(d,"protobyname"))
 841                     UNI(O_GPBYNAME);
 842                 if (strEQ(d,"protobynumber"))
 843                     FUN1(O_GPBYNUMBER);
 844                 if (strEQ(d,"protoent"))
 845                     FUN0(O_GPROTOENT);
 846                 if (strEQ(d,"pwent"))
 847                     FUN0(O_GPWENT);
 848                 if (strEQ(d,"pwnam"))
 849                     FUN1(O_GPWNAM);
 850                 if (strEQ(d,"pwuid"))
 851                     FUN1(O_GPWUID);
 852                 if (strEQ(d,"peername"))
 853                     FOP(O_GETPEERNAME);
 854             }
 855             else if (*d == 'h') {
 856                 if (strEQ(d,"hostbyname"))
 857                     UNI(O_GHBYNAME);
 858                 if (strEQ(d,"hostbyaddr"))
 859                     FUN2(O_GHBYADDR);
 860                 if (strEQ(d,"hostent"))
 861                     FUN0(O_GHOSTENT);
 862             }
 863             else if (*d == 'n') {
 864                 if (strEQ(d,"netbyname"))
 865                     UNI(O_GNBYNAME);
 866                 if (strEQ(d,"netbyaddr"))
 867                     FUN2(O_GNBYADDR);
 868                 if (strEQ(d,"netent"))
 869                     FUN0(O_GNETENT);
 870             }
 871             else if (*d == 's') {
 872                 if (strEQ(d,"servbyname"))
 873                     FUN2(O_GSBYNAME);
 874                 if (strEQ(d,"servbyport"))
 875                     FUN2(O_GSBYPORT);
 876                 if (strEQ(d,"servent"))
 877                     FUN0(O_GSERVENT);
 878                 if (strEQ(d,"sockname"))
 879                     FOP(O_GETSOCKNAME);
 880                 if (strEQ(d,"sockopt"))
 881                     FOP3(O_GSOCKOPT);
 882             }
 883             else if (*d == 'g') {
 884                 if (strEQ(d,"grent"))
 885                     FUN0(O_GGRENT);
 886                 if (strEQ(d,"grnam"))
 887                     FUN1(O_GGRNAM);
 888                 if (strEQ(d,"grgid"))
 889                     FUN1(O_GGRGID);
 890             }
 891             else if (*d == 'l') {
 892                 if (strEQ(d,"login"))
 893                     FUN0(O_GETLOGIN);
 894             }
 895             d -= 3;
 896         }
 897         break;
 898     case 'h': case 'H':
 899         SNARFWORD;
 900         if (strEQ(d,"hex"))
 901             UNI(O_HEX);
 902         break;
 903     case 'i': case 'I':
 904         SNARFWORD;
 905         if (strEQ(d,"if")) {
 906             yylval.ival = curcmd->c_line;
 907             OPERATOR(IF);
 908         }
 909         if (strEQ(d,"index"))
 910             FUN2x(O_INDEX);
 911         if (strEQ(d,"int"))
 912             UNI(O_INT);
 913         if (strEQ(d,"ioctl"))
 914             FOP3(O_IOCTL);
 915         break;
 916     case 'j': case 'J':
 917         SNARFWORD;
 918         if (strEQ(d,"join"))
 919             FL2(O_JOIN);
 920         break;
 921     case 'k': case 'K':
 922         SNARFWORD;
 923         if (strEQ(d,"keys"))
 924             HFUN(O_KEYS);
 925         if (strEQ(d,"kill"))
 926             LOP(O_KILL);
 927         break;
 928     case 'l': case 'L':
 929         SNARFWORD;
 930         if (strEQ(d,"last"))
 931             LOOPX(O_LAST);
 932         if (strEQ(d,"local"))
 933             OPERATOR(LOCAL);
 934         if (strEQ(d,"length"))
 935             UNI(O_LENGTH);
 936         if (strEQ(d,"lt") || strEQ(d,"LT"))
 937             ROP(O_SLT);
 938         if (strEQ(d,"le") || strEQ(d,"LE"))
 939             ROP(O_SLE);
 940         if (strEQ(d,"localtime"))
 941             UNI(O_LOCALTIME);
 942         if (strEQ(d,"log"))
 943             UNI(O_LOG);
 944         if (strEQ(d,"link"))
 945             FUN2(O_LINK);
 946         if (strEQ(d,"listen"))
 947             FOP2(O_LISTEN);
 948         if (strEQ(d,"lstat"))
 949             FOP(O_LSTAT);
 950         break;
 951     case 'm': case 'M':
 952         if (s[1] == '\'') {
 953             d = "m";
 954             s++;
 955         }
 956         else {
 957             SNARFWORD;
 958         }
 959         if (strEQ(d,"m")) {
 960             s = scanpat(s-1);
 961             if (yylval.arg)
 962                 TERM(PATTERN);
 963             else
 964                 RETURN(1);      /* force error */
 965         }
 966         switch (d[1]) {
 967         case 'k':
 968             if (strEQ(d,"mkdir"))
 969                 FUN2(O_MKDIR);
 970             break;
 971         case 's':
 972             if (strEQ(d,"msgctl"))
 973                 FUN3(O_MSGCTL);
 974             if (strEQ(d,"msgget"))
 975                 FUN2(O_MSGGET);
 976             if (strEQ(d,"msgrcv"))
 977                 FUN5(O_MSGRCV);
 978             if (strEQ(d,"msgsnd"))
 979                 FUN3(O_MSGSND);
 980             break;
 981         }
 982         break;
 983     case 'n': case 'N':
 984         SNARFWORD;
 985         if (strEQ(d,"next"))
 986             LOOPX(O_NEXT);
 987         if (strEQ(d,"ne") || strEQ(d,"NE"))
 988             EOP(O_SNE);
 989         break;
 990     case 'o': case 'O':
 991         SNARFWORD;
 992         if (strEQ(d,"open"))
 993             OPERATOR(OPEN);
 994         if (strEQ(d,"ord"))
 995             UNI(O_ORD);
 996         if (strEQ(d,"oct"))
 997             UNI(O_OCT);
 998         if (strEQ(d,"opendir"))
 999             FOP2(O_OPENDIR);
1000         break;
1001     case 'p': case 'P':
1002         SNARFWORD;
1003         if (strEQ(d,"print")) {
1004             checkcomma(s,"filehandle");
1005             LOP(O_PRINT);
1006         }
1007         if (strEQ(d,"printf")) {
1008             checkcomma(s,"filehandle");
1009             LOP(O_PRTF);
1010         }
1011         if (strEQ(d,"push")) {
1012             yylval.ival = O_PUSH;
1013             OPERATOR(PUSH);
1014         }
1015         if (strEQ(d,"pop"))
1016             OPERATOR(POP);
1017         if (strEQ(d,"pack"))
1018             FL2(O_PACK);
1019         if (strEQ(d,"package"))
1020             OPERATOR(PACKAGE);
1021         if (strEQ(d,"pipe"))
1022             FOP22(O_PIPE);
1023         break;
1024     case 'q': case 'Q':
1025         SNARFWORD;
1026         if (strEQ(d,"q")) {
1027             s = scanstr(s-1);
1028             TERM(RSTRING);
1029         }
1030         if (strEQ(d,"qq")) {
1031             s = scanstr(s-2);
1032             TERM(RSTRING);
1033         }
1034         break;
1035     case 'r': case 'R':
1036         SNARFWORD;
1037         if (strEQ(d,"return"))
1038             OLDLOP(O_RETURN);
1039         if (strEQ(d,"require")) {
1040             allstabs = TRUE;            /* must initialize everything since */
1041             UNI(O_REQUIRE);             /* we don't know what will be used */
1042         }
1043         if (strEQ(d,"reset"))
1044             UNI(O_RESET);
1045         if (strEQ(d,"redo"))
1046             LOOPX(O_REDO);
1047         if (strEQ(d,"rename"))
1048             FUN2(O_RENAME);
1049         if (strEQ(d,"rand"))
1050             UNI(O_RAND);
1051         if (strEQ(d,"rmdir"))
1052             UNI(O_RMDIR);
1053         if (strEQ(d,"rindex"))
1054             FUN2x(O_RINDEX);
1055         if (strEQ(d,"read"))
1056             FOP3(O_READ);
1057         if (strEQ(d,"readdir"))
1058             FOP(O_READDIR);
1059         if (strEQ(d,"rewinddir"))
1060             FOP(O_REWINDDIR);
1061         if (strEQ(d,"recv"))
1062             FOP4(O_RECV);
1063         if (strEQ(d,"reverse"))
1064             LOP(O_REVERSE);
1065         if (strEQ(d,"readlink"))
1066             UNI(O_READLINK);
1067         break;
1068     case 's': case 'S':
1069         if (s[1] == '\'') {
1070             d = "s";
1071             s++;
1072         }
1073         else {
1074             SNARFWORD;
1075         }
1076         if (strEQ(d,"s")) {
1077             s = scansubst(s);
1078             if (yylval.arg)
1079                 TERM(SUBST);
1080             else
1081                 RETURN(1);      /* force error */
1082         }
1083         switch (d[1]) {
1084         case 'a':
1085         case 'b':
1086             break;
1087         case 'c':
1088             if (strEQ(d,"scalar"))
1089                 UNI(O_SCALAR);
1090             break;
1091         case 'd':
1092             break;
1093         case 'e':
1094             if (strEQ(d,"select"))
1095                 OPERATOR(SSELECT);
1096             if (strEQ(d,"seek"))
1097                 FOP3(O_SEEK);
1098             if (strEQ(d,"semctl"))
1099                 FUN4(O_SEMCTL);
1100             if (strEQ(d,"semget"))
1101                 FUN3(O_SEMGET);
1102             if (strEQ(d,"semop"))
1103                 FUN2(O_SEMOP);
1104             if (strEQ(d,"send"))
1105                 FOP3(O_SEND);
1106             if (strEQ(d,"setpgrp"))
1107                 FUN2(O_SETPGRP);
1108             if (strEQ(d,"setpriority"))
1109                 FUN3(O_SETPRIORITY);
1110             if (strEQ(d,"sethostent"))
1111                 FUN1(O_SHOSTENT);
1112             if (strEQ(d,"setnetent"))
1113                 FUN1(O_SNETENT);
1114             if (strEQ(d,"setservent"))
1115                 FUN1(O_SSERVENT);
1116             if (strEQ(d,"setprotoent"))
1117                 FUN1(O_SPROTOENT);
1118             if (strEQ(d,"setpwent"))
1119                 FUN0(O_SPWENT);
1120             if (strEQ(d,"setgrent"))
1121                 FUN0(O_SGRENT);
1122             if (strEQ(d,"seekdir"))
1123                 FOP2(O_SEEKDIR);
1124             if (strEQ(d,"setsockopt"))
1125                 FOP4(O_SSOCKOPT);
1126             break;
1127         case 'f':
1128         case 'g':
1129             break;
1130         case 'h':
1131             if (strEQ(d,"shift"))
1132                 TERM(SHIFT);
1133             if (strEQ(d,"shmctl"))
1134                 FUN3(O_SHMCTL);
1135             if (strEQ(d,"shmget"))
1136                 FUN3(O_SHMGET);
1137             if (strEQ(d,"shmread"))
1138                 FUN4(O_SHMREAD);
1139             if (strEQ(d,"shmwrite"))
1140                 FUN4(O_SHMWRITE);
1141             if (strEQ(d,"shutdown"))
1142                 FOP2(O_SHUTDOWN);
1143             break;
1144         case 'i':
1145             if (strEQ(d,"sin"))
1146                 UNI(O_SIN);
1147             break;
1148         case 'j':
1149         case 'k':
1150             break;
1151         case 'l':
1152             if (strEQ(d,"sleep"))
1153                 UNI(O_SLEEP);
1154             break;
1155         case 'm':
1156         case 'n':
1157             break;
1158         case 'o':
1159             if (strEQ(d,"socket"))
1160                 FOP4(O_SOCKET);
1161             if (strEQ(d,"socketpair"))
1162                 FOP25(O_SOCKPAIR);
1163             if (strEQ(d,"sort")) {
1164                 checkcomma(s,"subroutine name");
1165                 d = bufend;
1166                 while (s < d && isascii(*s) && isspace(*s)) s++;
1167                 if (*s == ';' || *s == ')')             /* probably a close */
1168                     fatal("sort is now a reserved word");
1169                 if (isascii(*s) && (isalpha(*s) || *s == '_')) {
1170                     for (d = s; isalpha(*d) || isdigit(*d) || *d == '_'; d++) ;
1171                     strncpy(tokenbuf,s,d-s);
1172                     if (strNE(tokenbuf,"keys") &&
1173                         strNE(tokenbuf,"values") &&
1174                         strNE(tokenbuf,"split") &&
1175                         strNE(tokenbuf,"grep") &&
1176                         strNE(tokenbuf,"readdir") &&
1177                         strNE(tokenbuf,"unpack") &&
1178                         strNE(tokenbuf,"do") &&
1179                         (d >= bufend || isspace(*d)) )
1180                         *(--s) = '\\';  /* force next ident to WORD */
1181                 }
1182                 LOP(O_SORT);
1183             }
1184             break;
1185         case 'p':
1186             if (strEQ(d,"split"))
1187                 TERM(SPLIT);
1188             if (strEQ(d,"sprintf"))
1189                 FL(O_SPRINTF);
1190             if (strEQ(d,"splice")) {
1191                 yylval.ival = O_SPLICE;
1192                 OPERATOR(PUSH);
1193             }
1194             break;
1195         case 'q':
1196             if (strEQ(d,"sqrt"))
1197                 UNI(O_SQRT);
1198             break;
1199         case 'r':
1200             if (strEQ(d,"srand"))
1201                 UNI(O_SRAND);
1202             break;
1203         case 's':
1204             break;
1205         case 't':
1206             if (strEQ(d,"stat"))
1207                 FOP(O_STAT);
1208             if (strEQ(d,"study")) {
1209                 sawstudy++;
1210                 LFUN(O_STUDY);
1211             }
1212             break;
1213         case 'u':
1214             if (strEQ(d,"substr"))
1215                 FUN2x(O_SUBSTR);
1216             if (strEQ(d,"sub")) {
1217                 subline = curcmd->c_line;
1218                 d = bufend;
1219                 while (s < d && isspace(*s))
1220                     s++;
1221                 if (isalpha(*s) || *s == '_' || *s == '\'') {
1222                     if (perldb) {
1223                         str_sset(subname,curstname);
1224                         str_ncat(subname,"'",1);
1225                         for (d = s+1;
1226                           isalpha(*d) || isdigit(*d) || *d == '_' || *d == '\'';
1227                           d++);
1228                         if (d[-1] == '\'')
1229                             d--;
1230                         str_ncat(subname,s,d-s);
1231                     }
1232                     *(--s) = '\\';      /* force next ident to WORD */
1233                 }
1234                 else if (perldb)
1235                     str_set(subname,"?");
1236                 OPERATOR(SUB);
1237             }
1238             break;
1239         case 'v':
1240         case 'w':
1241         case 'x':
1242             break;
1243         case 'y':
1244             if (strEQ(d,"system")) {
1245                 set_csh();
1246                 LOP(O_SYSTEM);
1247             }
1248             if (strEQ(d,"symlink"))
1249                 FUN2(O_SYMLINK);
1250             if (strEQ(d,"syscall"))
1251                 LOP(O_SYSCALL);
1252             if (strEQ(d,"sysread"))
1253                 FOP3(O_SYSREAD);
1254             if (strEQ(d,"syswrite"))
1255                 FOP3(O_SYSWRITE);
1256             break;
1257         case 'z':
1258             break;
1259         }
1260         break;
1261     case 't': case 'T':
1262         SNARFWORD;
1263         if (strEQ(d,"tr")) {
1264             s = scantrans(s);
1265             if (yylval.arg)
1266                 TERM(TRANS);
1267             else
1268                 RETURN(1);      /* force error */
1269         }
1270         if (strEQ(d,"tell"))
1271             FOP(O_TELL);
1272         if (strEQ(d,"telldir"))
1273             FOP(O_TELLDIR);
1274         if (strEQ(d,"time"))
1275             FUN0(O_TIME);
1276         if (strEQ(d,"times"))
1277             FUN0(O_TMS);
1278         if (strEQ(d,"truncate"))
1279             FOP2(O_TRUNCATE);
1280         break;
1281     case 'u': case 'U':
1282         SNARFWORD;
1283         if (strEQ(d,"using"))
1284             OPERATOR(USING);
1285         if (strEQ(d,"until")) {
1286             yylval.ival = curcmd->c_line;
1287             OPERATOR(UNTIL);
1288         }
1289         if (strEQ(d,"unless")) {
1290             yylval.ival = curcmd->c_line;
1291             OPERATOR(UNLESS);
1292         }
1293         if (strEQ(d,"unlink"))
1294             LOP(O_UNLINK);
1295         if (strEQ(d,"undef"))
1296             LFUN(O_UNDEF);
1297         if (strEQ(d,"unpack"))
1298             FUN2(O_UNPACK);
1299         if (strEQ(d,"utime"))
1300             LOP(O_UTIME);
1301         if (strEQ(d,"umask"))
1302             UNI(O_UMASK);
1303         if (strEQ(d,"unshift")) {
1304             yylval.ival = O_UNSHIFT;
1305             OPERATOR(PUSH);
1306         }
1307         break;
1308     case 'v': case 'V':
1309         SNARFWORD;
1310         if (strEQ(d,"values"))
1311             HFUN(O_VALUES);
1312         if (strEQ(d,"vec")) {
1313             sawvec = TRUE;
1314             FUN3(O_VEC);
1315         }
1316         break;
1317     case 'w': case 'W':
1318         SNARFWORD;
1319         if (strEQ(d,"while")) {
1320             yylval.ival = curcmd->c_line;
1321             OPERATOR(WHILE);
1322         }
1323         if (strEQ(d,"warn"))
1324             LOP(O_WARN);
1325         if (strEQ(d,"wait"))
1326             FUN0(O_WAIT);
1327         if (strEQ(d,"waitpid"))
1328             FUN2(O_WAITPID);
1329         if (strEQ(d,"wantarray")) {
1330             yylval.arg = op_new(1);
1331             yylval.arg->arg_type = O_ITEM;
1332             yylval.arg[1].arg_type = A_WANTARRAY;
1333             TERM(RSTRING);
1334         }
1335         if (strEQ(d,"write"))
1336             FOP(O_WRITE);
1337         break;
1338     case 'x': case 'X':
1339         SNARFWORD;
1340         if (!expectterm && strEQ(d,"x"))
1341             MOP(O_REPEAT);
1342         break;
1343     case 'y': case 'Y':
1344         if (s[1] == '\'') {
1345             d = "y";
1346             s++;
1347         }
1348         else {
1349             SNARFWORD;
1350         }
1351         if (strEQ(d,"y")) {
1352             s = scantrans(s);
1353             TERM(TRANS);
1354         }
1355         break;
1356     case 'z': case 'Z':
1357         SNARFWORD;
1358         break;
1359     }
1360     yylval.cval = savestr(d);
1361     expectterm = FALSE;
1362     if (oldoldbufptr && oldoldbufptr < bufptr) {
1363         while (isspace(*oldoldbufptr))
1364             oldoldbufptr++;
1365         if (*oldoldbufptr == 'p' && strnEQ(oldoldbufptr,"print",5))
1366             expectterm = TRUE;
1367         else if (*oldoldbufptr == 's' && strnEQ(oldoldbufptr,"sort",4))
1368             expectterm = TRUE;
1369     }
1370     return (CLINE, bufptr = s, (int)WORD);
1371 }
1372
1373 int
1374 checkcomma(s,what)
1375 register char *s;
1376 char *what;
1377 {
1378     char *word;
1379
1380     if (*s == '(')
1381         s++;
1382     while (s < bufend && isascii(*s) && isspace(*s))
1383         s++;
1384     if (isascii(*s) && (isalpha(*s) || *s == '_')) {
1385         word = s++;
1386         while (isalpha(*s) || isdigit(*s) || *s == '_')
1387             s++;
1388         while (s < bufend && isspace(*s))
1389             s++;
1390         if (*s == ',') {
1391             *s = '\0';
1392             word = instr(
1393               "tell eof times getlogin wait length shift umask getppid \
1394               cos exp int log rand sin sqrt ord wantarray",
1395               word);
1396             *s = ',';
1397             if (word)
1398                 return;
1399             fatal("No comma allowed after %s", what);
1400         }
1401     }
1402 }
1403
1404 char *
1405 scanreg(s,send,dest)
1406 register char *s;
1407 register char *send;
1408 char *dest;
1409 {
1410     register char *d;
1411     int brackets = 0;
1412
1413     reparse = Nullch;
1414     s++;
1415     d = dest;
1416     if (isdigit(*s)) {
1417         while (isdigit(*s))
1418             *d++ = *s++;
1419     }
1420     else {
1421         while (isalpha(*s) || isdigit(*s) || *s == '_' || *s == '\'')
1422             *d++ = *s++;
1423     }
1424     while (d > dest+1 && d[-1] == '\'')
1425         d--,s--;
1426     *d = '\0';
1427     d = dest;
1428     if (!*d) {
1429         *d = *s++;
1430         if (*d == '{' /* } */ ) {
1431             d = dest;
1432             brackets++;
1433             while (s < send && brackets) {
1434                 if (!reparse && (d == dest || (*s && isascii(*s) &&
1435                   (isalpha(*s) || isdigit(*s) || *s == '_') ))) {
1436                     *d++ = *s++;
1437                     continue;
1438                 }
1439                 else if (!reparse)
1440                     reparse = s;
1441                 switch (*s++) {
1442                 /* { */
1443                 case '}':
1444                     brackets--;
1445                     if (reparse && reparse == s - 1)
1446                         reparse = Nullch;
1447                     break;
1448                 case '{':   /* } */
1449                     brackets++;
1450                     break;
1451                 }
1452             }
1453             *d = '\0';
1454             d = dest;
1455         }
1456         else
1457             d[1] = '\0';
1458     }
1459     if (*d == '^' && !isspace(*s))
1460         *d = *s++ & 31;
1461     return s;
1462 }
1463
1464 STR *
1465 scanconst(string,len)
1466 char *string;
1467 int len;
1468 {
1469     register STR *retstr;
1470     register char *t;
1471     register char *d;
1472     register char *e;
1473
1474     if (index(string,'|')) {
1475         return Nullstr;
1476     }
1477     retstr = Str_new(86,len);
1478     str_nset(retstr,string,len);
1479     t = str_get(retstr);
1480     e = t + len;
1481     retstr->str_u.str_useful = 100;
1482     for (d=t; d < e; ) {
1483         switch (*d) {
1484         case '{':
1485             if (isdigit(d[1]))
1486                 e = d;
1487             else
1488                 goto defchar;
1489             break;
1490         case '.': case '[': case '$': case '(': case ')': case '|': case '+':
1491             e = d;
1492             break;
1493         case '\\':
1494             if (d[1] && index("wWbB0123456789sSdD",d[1])) {
1495                 e = d;
1496                 break;
1497             }
1498             (void)bcopy(d+1,d,e-d);
1499             e--;
1500             switch(*d) {
1501             case 'n':
1502                 *d = '\n';
1503                 break;
1504             case 't':
1505                 *d = '\t';
1506                 break;
1507             case 'f':
1508                 *d = '\f';
1509                 break;
1510             case 'r':
1511                 *d = '\r';
1512                 break;
1513             }
1514             /* FALL THROUGH */
1515         default:
1516           defchar:
1517             if (d[1] == '*' || (d[1] == '{' && d[2] == '0') || d[1] == '?') {
1518                 e = d;
1519                 break;
1520             }
1521             d++;
1522         }
1523     }
1524     if (d == t) {
1525         str_free(retstr);
1526         return Nullstr;
1527     }
1528     *d = '\0';
1529     retstr->str_cur = d - t;
1530     return retstr;
1531 }
1532
1533 char *
1534 scanpat(s)
1535 register char *s;
1536 {
1537     register SPAT *spat;
1538     register char *d;
1539     register char *e;
1540     int len;
1541     SPAT savespat;
1542     STR *str = Str_new(93,0);
1543
1544     Newz(801,spat,1,SPAT);
1545     spat->spat_next = curstash->tbl_spatroot;   /* link into spat list */
1546     curstash->tbl_spatroot = spat;
1547
1548     switch (*s++) {
1549     case 'm':
1550         s++;
1551         break;
1552     case '/':
1553         break;
1554     case '?':
1555         spat->spat_flags |= SPAT_ONCE;
1556         break;
1557     default:
1558         fatal("panic: scanpat");
1559     }
1560     s = str_append_till(str,s,bufend,s[-1],patleave);
1561     if (s >= bufend) {
1562         str_free(str);
1563         yyerror("Search pattern not terminated");
1564         yylval.arg = Nullarg;
1565         return s;
1566     }
1567     s++;
1568     while (*s == 'i' || *s == 'o') {
1569         if (*s == 'i') {
1570             s++;
1571             sawi = TRUE;
1572             spat->spat_flags |= SPAT_FOLD;
1573         }
1574         if (*s == 'o') {
1575             s++;
1576             spat->spat_flags |= SPAT_KEEP;
1577         }
1578     }
1579     len = str->str_cur;
1580     e = str->str_ptr + len;
1581     for (d = str->str_ptr; d < e; d++) {
1582         if (*d == '\\')
1583             d++;
1584         else if ((*d == '$' && d[1] && d[1] != '|' && d[1] != ')') ||
1585                  (*d == '@')) {
1586             register ARG *arg;
1587
1588             spat->spat_runtime = arg = op_new(1);
1589             arg->arg_type = O_ITEM;
1590             arg[1].arg_type = A_DOUBLE;
1591             arg[1].arg_ptr.arg_str = str_smake(str);
1592             d = scanreg(d,bufend,buf);
1593             (void)stabent(buf,TRUE);            /* make sure it's created */
1594             for (; d < e; d++) {
1595                 if (*d == '\\')
1596                     d++;
1597                 else if (*d == '$' && d[1] && d[1] != '|' && d[1] != ')') {
1598                     d = scanreg(d,bufend,buf);
1599                     (void)stabent(buf,TRUE);
1600                 }
1601                 else if (*d == '@') {
1602                     d = scanreg(d,bufend,buf);
1603                     if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
1604                       strEQ(buf,"SIG") || strEQ(buf,"INC"))
1605                         (void)stabent(buf,TRUE);
1606                 }
1607             }
1608             goto got_pat;               /* skip compiling for now */
1609         }
1610     }
1611     if (spat->spat_flags & SPAT_FOLD)
1612 #ifdef STRUCTCOPY
1613         savespat = *spat;
1614 #else
1615         (void)bcopy((char *)spat, (char *)&savespat, sizeof(SPAT));
1616 #endif
1617     if (*str->str_ptr == '^') {
1618         spat->spat_short = scanconst(str->str_ptr+1,len-1);
1619         if (spat->spat_short) {
1620             spat->spat_slen = spat->spat_short->str_cur;
1621             if (spat->spat_slen == len - 1)
1622                 spat->spat_flags |= SPAT_ALL;
1623         }
1624     }
1625     else {
1626         spat->spat_flags |= SPAT_SCANFIRST;
1627         spat->spat_short = scanconst(str->str_ptr,len);
1628         if (spat->spat_short) {
1629             spat->spat_slen = spat->spat_short->str_cur;
1630             if (spat->spat_slen == len)
1631                 spat->spat_flags |= SPAT_ALL;
1632         }
1633     }
1634     if ((spat->spat_flags & SPAT_ALL) && (spat->spat_flags & SPAT_SCANFIRST)) {
1635         fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
1636         spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
1637             spat->spat_flags & SPAT_FOLD);
1638                 /* Note that this regexp can still be used if someone says
1639                  * something like /a/ && s//b/;  so we can't delete it.
1640                  */
1641     }
1642     else {
1643         if (spat->spat_flags & SPAT_FOLD)
1644 #ifdef STRUCTCOPY
1645             *spat = savespat;
1646 #else
1647             (void)bcopy((char *)&savespat, (char *)spat, sizeof(SPAT));
1648 #endif
1649         if (spat->spat_short)
1650             fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
1651         spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
1652             spat->spat_flags & SPAT_FOLD,1);
1653         hoistmust(spat);
1654     }
1655   got_pat:
1656     str_free(str);
1657     yylval.arg = make_match(O_MATCH,stab2arg(A_STAB,defstab),spat);
1658     return s;
1659 }
1660
1661 char *
1662 scansubst(s)
1663 register char *s;
1664 {
1665     register SPAT *spat;
1666     register char *d;
1667     register char *e;
1668     int len;
1669     STR *str = Str_new(93,0);
1670
1671     Newz(802,spat,1,SPAT);
1672     spat->spat_next = curstash->tbl_spatroot;   /* link into spat list */
1673     curstash->tbl_spatroot = spat;
1674
1675     s = str_append_till(str,s+1,bufend,*s,patleave);
1676     if (s >= bufend) {
1677         str_free(str);
1678         yyerror("Substitution pattern not terminated");
1679         yylval.arg = Nullarg;
1680         return s;
1681     }
1682     len = str->str_cur;
1683     e = str->str_ptr + len;
1684     for (d = str->str_ptr; d < e; d++) {
1685         if (*d == '\\')
1686             d++;
1687         else if ((*d == '$' && d[1] && d[1] != '|' && /*(*/ d[1] != ')') ||
1688             *d == '@' ) {
1689             register ARG *arg;
1690
1691             spat->spat_runtime = arg = op_new(1);
1692             arg->arg_type = O_ITEM;
1693             arg[1].arg_type = A_DOUBLE;
1694             arg[1].arg_ptr.arg_str = str_smake(str);
1695             d = scanreg(d,bufend,buf);
1696             (void)stabent(buf,TRUE);            /* make sure it's created */
1697             for (; *d; d++) {
1698                 if (*d == '$' && d[1] && d[-1] != '\\' && d[1] != '|') {
1699                     d = scanreg(d,bufend,buf);
1700                     (void)stabent(buf,TRUE);
1701                 }
1702                 else if (*d == '@' && d[-1] != '\\') {
1703                     d = scanreg(d,bufend,buf);
1704                     if (strEQ(buf,"ARGV") || strEQ(buf,"ENV") ||
1705                       strEQ(buf,"SIG") || strEQ(buf,"INC"))
1706                         (void)stabent(buf,TRUE);
1707                 }
1708             }
1709             goto get_repl;              /* skip compiling for now */
1710         }
1711     }
1712     if (*str->str_ptr == '^') {
1713         spat->spat_short = scanconst(str->str_ptr+1,len-1);
1714         if (spat->spat_short)
1715             spat->spat_slen = spat->spat_short->str_cur;
1716     }
1717     else {
1718         spat->spat_flags |= SPAT_SCANFIRST;
1719         spat->spat_short = scanconst(str->str_ptr,len);
1720         if (spat->spat_short)
1721             spat->spat_slen = spat->spat_short->str_cur;
1722     }
1723 get_repl:
1724     s = scanstr(s);
1725     if (s >= bufend) {
1726         str_free(str);
1727         yyerror("Substitution replacement not terminated");
1728         yylval.arg = Nullarg;
1729         return s;
1730     }
1731     spat->spat_repl = yylval.arg;
1732     spat->spat_flags |= SPAT_ONCE;
1733     if ((spat->spat_repl[1].arg_type & A_MASK) == A_SINGLE)
1734         spat->spat_flags |= SPAT_CONST;
1735     else if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE) {
1736         STR *tmpstr;
1737         register char *t;
1738
1739         spat->spat_flags |= SPAT_CONST;
1740         tmpstr = spat->spat_repl[1].arg_ptr.arg_str;
1741         e = tmpstr->str_ptr + tmpstr->str_cur;
1742         for (t = tmpstr->str_ptr; t < e; t++) {
1743             if (*t == '$' && t[1] && (index("`'&+0123456789",t[1]) ||
1744               (t[1] == '{' /*}*/ && isdigit(t[2])) ))
1745                 spat->spat_flags &= ~SPAT_CONST;
1746         }
1747     }
1748     while (*s == 'g' || *s == 'i' || *s == 'e' || *s == 'o') {
1749         if (*s == 'e') {
1750             s++;
1751             if ((spat->spat_repl[1].arg_type & A_MASK) == A_DOUBLE)
1752                 spat->spat_repl[1].arg_type = A_SINGLE;
1753             spat->spat_repl = make_op(O_EVAL,2,
1754                 spat->spat_repl,
1755                 Nullarg,
1756                 Nullarg);
1757             spat->spat_flags &= ~SPAT_CONST;
1758         }
1759         if (*s == 'g') {
1760             s++;
1761             spat->spat_flags &= ~SPAT_ONCE;
1762         }
1763         if (*s == 'i') {
1764             s++;
1765             sawi = TRUE;
1766             spat->spat_flags |= SPAT_FOLD;
1767             if (!(spat->spat_flags & SPAT_SCANFIRST)) {
1768                 str_free(spat->spat_short);     /* anchored opt doesn't do */
1769                 spat->spat_short = Nullstr;     /* case insensitive match */
1770                 spat->spat_slen = 0;
1771             }
1772         }
1773         if (*s == 'o') {
1774             s++;
1775             spat->spat_flags |= SPAT_KEEP;
1776         }
1777     }
1778     if (spat->spat_short && (spat->spat_flags & SPAT_SCANFIRST))
1779         fbmcompile(spat->spat_short, spat->spat_flags & SPAT_FOLD);
1780     if (!spat->spat_runtime) {
1781         spat->spat_regexp = regcomp(str->str_ptr,str->str_ptr+len,
1782           spat->spat_flags & SPAT_FOLD,1);
1783         hoistmust(spat);
1784     }
1785     yylval.arg = make_match(O_SUBST,stab2arg(A_STAB,defstab),spat);
1786     str_free(str);
1787     return s;
1788 }
1789
1790 hoistmust(spat)
1791 register SPAT *spat;
1792 {
1793     if (spat->spat_regexp->regmust) {   /* is there a better short-circuit? */
1794         if (spat->spat_short &&
1795           str_eq(spat->spat_short,spat->spat_regexp->regmust))
1796         {
1797             if (spat->spat_flags & SPAT_SCANFIRST) {
1798                 str_free(spat->spat_short);
1799                 spat->spat_short = Nullstr;
1800             }
1801             else {
1802                 str_free(spat->spat_regexp->regmust);
1803                 spat->spat_regexp->regmust = Nullstr;
1804                 return;
1805             }
1806         }
1807         if (!spat->spat_short ||        /* promote the better string */
1808           ((spat->spat_flags & SPAT_SCANFIRST) &&
1809            (spat->spat_short->str_cur < spat->spat_regexp->regmust->str_cur) )){
1810             str_free(spat->spat_short);         /* ok if null */
1811             spat->spat_short = spat->spat_regexp->regmust;
1812             spat->spat_regexp->regmust = Nullstr;
1813             spat->spat_flags |= SPAT_SCANFIRST;
1814         }
1815     }
1816 }
1817
1818 char *
1819 expand_charset(s,len,retlen)
1820 register char *s;
1821 int len;
1822 int *retlen;
1823 {
1824     char t[520];
1825     register char *d = t;
1826     register int i;
1827     register char *send = s + len;
1828
1829     while (s < send && d - t <= 256) {
1830         if (s[1] == '-' && s+2 < send) {
1831             for (i = s[0]; i <= s[2]; i++)
1832                 *d++ = i;
1833             s += 3;
1834         }
1835         else
1836             *d++ = *s++;
1837     }
1838     *d = '\0';
1839     *retlen = d - t;
1840     return nsavestr(t,d-t);
1841 }
1842
1843 char *
1844 scantrans(s)
1845 register char *s;
1846 {
1847     ARG *arg =
1848         l(make_op(O_TRANS,2,stab2arg(A_STAB,defstab),Nullarg,Nullarg));
1849     register char *t;
1850     register char *r;
1851     register short *tbl;
1852     register int i;
1853     register int j;
1854     int tlen, rlen;
1855     int squash;
1856     int delete;
1857     int complement;
1858
1859     New(803,tbl,256,short);
1860     arg[2].arg_type = A_NULL;
1861     arg[2].arg_ptr.arg_cval = (char*) tbl;
1862     s = scanstr(s);
1863     if (s >= bufend) {
1864         yyerror("Translation pattern not terminated");
1865         yylval.arg = Nullarg;
1866         return s;
1867     }
1868     t = expand_charset(yylval.arg[1].arg_ptr.arg_str->str_ptr,
1869         yylval.arg[1].arg_ptr.arg_str->str_cur,&tlen);
1870     free_arg(yylval.arg);
1871     s = scanstr(s-1);
1872     if (s >= bufend) {
1873         yyerror("Translation replacement not terminated");
1874         yylval.arg = Nullarg;
1875         return s;
1876     }
1877     complement = delete = squash = 0;
1878     while (*s == 'c' || *s == 'd' || *s == 's') {
1879         if (*s == 'c')
1880             complement = 1;
1881         else if (*s == 'd')
1882             delete = 2;
1883         else
1884             squash = 1;
1885         s++;
1886     }
1887     r = expand_charset(yylval.arg[1].arg_ptr.arg_str->str_ptr,
1888         yylval.arg[1].arg_ptr.arg_str->str_cur,&rlen);
1889     free_arg(yylval.arg);
1890     arg[2].arg_len = delete|squash;
1891     yylval.arg = arg;
1892     if (!rlen && !delete) {
1893         Safefree(r);
1894         r = t; rlen = tlen;
1895     }
1896     if (complement) {
1897         Zero(tbl, 256, short);
1898         for (i = 0; i < tlen; i++)
1899             tbl[t[i] & 0377] = -1;
1900         for (i = 0, j = 0; i < 256; i++,j++) {
1901             if (!tbl[i]) {
1902                 if (j >= rlen) {
1903                     if (delete) {
1904                         tbl[i] = -2;
1905                         continue;
1906                     }
1907                     --j;
1908                 }
1909                 tbl[i] = r[j];
1910             }
1911         }
1912     }
1913     else {
1914         for (i = 0; i < 256; i++)
1915             tbl[i] = -1;
1916         for (i = 0, j = 0; i < tlen; i++,j++) {
1917             if (j >= rlen) {
1918                 if (delete) {
1919                     if (tbl[t[i] & 0377] == -1)
1920                         tbl[t[i] & 0377] = -2;
1921                     continue;
1922                 }
1923                 --j;
1924             }
1925             if (tbl[t[i] & 0377] == -1)
1926                 tbl[t[i] & 0377] = r[j];
1927         }
1928     }
1929     if (r != t)
1930         Safefree(r);
1931     Safefree(t);
1932     return s;
1933 }
1934
1935 char *
1936 scanstr(s)
1937 register char *s;
1938 {
1939     register char term;
1940     register char *d;
1941     register ARG *arg;
1942     register char *send;
1943     register bool makesingle = FALSE;
1944     register STAB *stab;
1945     bool alwaysdollar = FALSE;
1946     bool hereis = FALSE;
1947     STR *herewas;
1948     STR *str;
1949     char *leave = "\\$@nrtfb0123456789[{]}"; /* which backslash sequences to keep */
1950     int len;
1951
1952     arg = op_new(1);
1953     yylval.arg = arg;
1954     arg->arg_type = O_ITEM;
1955
1956     switch (*s) {
1957     default:                    /* a substitution replacement */
1958         arg[1].arg_type = A_DOUBLE;
1959         makesingle = TRUE;      /* maybe disable runtime scanning */
1960         term = *s;
1961         if (term == '\'')
1962             leave = Nullch;
1963         goto snarf_it;
1964     case '0':
1965         {
1966             unsigned long i;
1967             int shift;
1968
1969             arg[1].arg_type = A_SINGLE;
1970             if (s[1] == 'x') {
1971                 shift = 4;
1972                 s += 2;
1973             }
1974             else if (s[1] == '.')
1975                 goto decimal;
1976             else
1977                 shift = 3;
1978             i = 0;
1979             for (;;) {
1980                 switch (*s) {
1981                 default:
1982                     goto out;
1983                 case '8': case '9':
1984                     if (shift != 4)
1985                         yyerror("Illegal octal digit");
1986                     /* FALL THROUGH */
1987                 case '0': case '1': case '2': case '3': case '4':
1988                 case '5': case '6': case '7':
1989                     i <<= shift;
1990                     i += *s++ & 15;
1991                     break;
1992                 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
1993                 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
1994                     if (shift != 4)
1995                         goto out;
1996                     i <<= 4;
1997                     i += (*s++ & 7) + 9;
1998                     break;
1999                 }
2000             }
2001           out:
2002             str = Str_new(92,0);
2003             str_numset(str,(double)i);
2004             if (str->str_ptr) {
2005                 Safefree(str->str_ptr);
2006                 str->str_ptr = Nullch;
2007                 str->str_len = str->str_cur = 0;
2008             }
2009             arg[1].arg_ptr.arg_str = str;
2010         }
2011         break;
2012     case '1': case '2': case '3': case '4': case '5':
2013     case '6': case '7': case '8': case '9': case '.':
2014       decimal:
2015         arg[1].arg_type = A_SINGLE;
2016         d = tokenbuf;
2017         while (isdigit(*s) || *s == '_') {
2018             if (*s == '_')
2019                 s++;
2020             else
2021                 *d++ = *s++;
2022         }
2023         if (*s == '.' && s[1] && index("0123456789eE ;",s[1])) {
2024             *d++ = *s++;
2025             while (isdigit(*s) || *s == '_') {
2026                 if (*s == '_')
2027                     s++;
2028                 else
2029                     *d++ = *s++;
2030             }
2031         }
2032         if (*s && index("eE",*s) && index("+-0123456789",s[1])) {
2033             *d++ = *s++;
2034             if (*s == '+' || *s == '-')
2035                 *d++ = *s++;
2036             while (isdigit(*s))
2037                 *d++ = *s++;
2038         }
2039         *d = '\0';
2040         str = Str_new(92,0);
2041         str_numset(str,atof(tokenbuf));
2042         if (str->str_ptr) {
2043             Safefree(str->str_ptr);
2044             str->str_ptr = Nullch;
2045             str->str_len = str->str_cur = 0;
2046         }
2047         arg[1].arg_ptr.arg_str = str;
2048         break;
2049     case '<':
2050         if (*++s == '<') {
2051             hereis = TRUE;
2052             d = tokenbuf;
2053             if (!rsfp)
2054                 *d++ = '\n';
2055             if (*++s && index("`'\"",*s)) {
2056                 term = *s++;
2057                 s = cpytill(d,s,bufend,term,&len);
2058                 if (s < bufend)
2059                     s++;
2060                 d += len;
2061             }
2062             else {
2063                 if (*s == '\\')
2064                     s++, term = '\'';
2065                 else
2066                     term = '"';
2067                 while (isascii(*s) && (isalpha(*s) || isdigit(*s) || *s == '_'))
2068                     *d++ = *s++;
2069             }                           /* assuming tokenbuf won't clobber */
2070             *d++ = '\n';
2071             *d = '\0';
2072             len = d - tokenbuf;
2073             d = "\n";
2074             if (rsfp || !(d=ninstr(s,bufend,d,d+1)))
2075                 herewas = str_make(s,bufend-s);
2076             else
2077                 s--, herewas = str_make(s,d-s);
2078             s += herewas->str_cur;
2079             if (term == '\'')
2080                 goto do_single;
2081             if (term == '`')
2082                 goto do_back;
2083             goto do_double;
2084         }
2085         d = tokenbuf;
2086         s = cpytill(d,s,bufend,'>',&len);
2087         if (s < bufend)
2088             s++;
2089         if (*d == '$') d++;
2090         while (*d &&
2091           (isalpha(*d) || isdigit(*d) || *d == '_' || *d == '\''))
2092             d++;
2093         if (d - tokenbuf != len) {
2094             d = tokenbuf;
2095             arg[1].arg_type = A_GLOB;
2096             d = nsavestr(d,len);
2097             arg[1].arg_ptr.arg_stab = stab = genstab();
2098             stab_io(stab) = stio_new();
2099             stab_val(stab) = str_make(d,len);
2100             Safefree(d);
2101             set_csh();
2102         }
2103         else {
2104             d = tokenbuf;
2105             if (!len)
2106                 (void)strcpy(d,"ARGV");
2107             if (*d == '$') {
2108                 arg[1].arg_type = A_INDREAD;
2109                 arg[1].arg_ptr.arg_stab = stabent(d+1,TRUE);
2110             }
2111             else {
2112                 arg[1].arg_type = A_READ;
2113                 arg[1].arg_ptr.arg_stab = stabent(d,TRUE);
2114                 if (!stab_io(arg[1].arg_ptr.arg_stab))
2115                     stab_io(arg[1].arg_ptr.arg_stab) = stio_new();
2116                 if (strEQ(d,"ARGV")) {
2117                     (void)aadd(arg[1].arg_ptr.arg_stab);
2118                     stab_io(arg[1].arg_ptr.arg_stab)->flags |=
2119                       IOF_ARGV|IOF_START;
2120                 }
2121             }
2122         }
2123         break;
2124
2125     case 'q':
2126         s++;
2127         if (*s == 'q') {
2128             s++;
2129             goto do_double;
2130         }
2131         /* FALL THROUGH */
2132     case '\'':
2133       do_single:
2134         term = *s;
2135         arg[1].arg_type = A_SINGLE;
2136         leave = Nullch;
2137         goto snarf_it;
2138
2139     case '"':
2140       do_double:
2141         term = *s;
2142         arg[1].arg_type = A_DOUBLE;
2143         makesingle = TRUE;      /* maybe disable runtime scanning */
2144         alwaysdollar = TRUE;    /* treat $) and $| as variables */
2145         goto snarf_it;
2146     case '`':
2147       do_back:
2148         term = *s;
2149         arg[1].arg_type = A_BACKTICK;
2150         set_csh();
2151         alwaysdollar = TRUE;    /* treat $) and $| as variables */
2152       snarf_it:
2153         {
2154             STR *tmpstr;
2155             char *tmps;
2156
2157             multi_start = curcmd->c_line;
2158             if (hereis)
2159                 multi_open = multi_close = '<';
2160             else {
2161                 multi_open = term;
2162                 if (term && (tmps = index("([{< )]}> )]}>",term)))
2163                     term = tmps[5];
2164                 multi_close = term;
2165             }
2166             tmpstr = Str_new(87,80);
2167             if (hereis) {
2168                 term = *tokenbuf;
2169                 if (!rsfp) {
2170                     d = s;
2171                     while (s < bufend &&
2172                       (*s != term || bcmp(s,tokenbuf,len) != 0) ) {
2173                         if (*s++ == '\n')
2174                             curcmd->c_line++;
2175                     }
2176                     if (s >= bufend) {
2177                         curcmd->c_line = multi_start;
2178                         fatal("EOF in string");
2179                     }
2180                     str_nset(tmpstr,d+1,s-d);
2181                     s += len - 1;
2182                     str_ncat(herewas,s,bufend-s);
2183                     str_replace(linestr,herewas);
2184                     oldoldbufptr = oldbufptr = bufptr = s = str_get(linestr);
2185                     bufend = linestr->str_ptr + linestr->str_cur;
2186                     hereis = FALSE;
2187                 }
2188                 else
2189                     str_nset(tmpstr,"",0);   /* avoid "uninitialized" warning */
2190             }
2191             else
2192                 s = str_append_till(tmpstr,s+1,bufend,term,leave);
2193             while (s >= bufend) {       /* multiple line string? */
2194                 if (!rsfp ||
2195                  !(oldoldbufptr = oldbufptr = s = str_gets(linestr, rsfp, 0))) {
2196                     curcmd->c_line = multi_start;
2197                     fatal("EOF in string");
2198                 }
2199                 curcmd->c_line++;
2200                 if (perldb) {
2201                     STR *str = Str_new(88,0);
2202
2203                     str_sset(str,linestr);
2204                     astore(stab_xarray(curcmd->c_filestab),
2205                       (int)curcmd->c_line,str);
2206                 }
2207                 bufend = linestr->str_ptr + linestr->str_cur;
2208                 if (hereis) {
2209                     if (*s == term && bcmp(s,tokenbuf,len) == 0) {
2210                         s = bufend - 1;
2211                         *s = ' ';
2212                         str_scat(linestr,herewas);
2213                         bufend = linestr->str_ptr + linestr->str_cur;
2214                     }
2215                     else {
2216                         s = bufend;
2217                         str_scat(tmpstr,linestr);
2218                     }
2219                 }
2220                 else
2221                     s = str_append_till(tmpstr,s,bufend,term,leave);
2222             }
2223             multi_end = curcmd->c_line;
2224             s++;
2225             if (tmpstr->str_cur + 5 < tmpstr->str_len) {
2226                 tmpstr->str_len = tmpstr->str_cur + 1;
2227                 Renew(tmpstr->str_ptr, tmpstr->str_len, char);
2228             }
2229             if ((arg[1].arg_type & A_MASK) == A_SINGLE) {
2230                 arg[1].arg_ptr.arg_str = tmpstr;
2231                 break;
2232             }
2233             tmps = s;
2234             s = tmpstr->str_ptr;
2235             send = s + tmpstr->str_cur;
2236             while (s < send) {          /* see if we can make SINGLE */
2237                 if (*s == '\\' && s[1] && isdigit(s[1]) && !isdigit(s[2]) &&
2238                   !alwaysdollar && s[1] != '0')
2239                     *s = '$';           /* grandfather \digit in subst */
2240                 if ((*s == '$' || *s == '@') && s+1 < send &&
2241                   (alwaysdollar || (s[1] != ')' && s[1] != '|'))) {
2242                     makesingle = FALSE; /* force interpretation */
2243                 }
2244                 else if (*s == '\\' && s+1 < send) {
2245                     s++;
2246                 }
2247                 s++;
2248             }
2249             s = d = tmpstr->str_ptr;    /* assuming shrinkage only */
2250             while (s < send) {
2251                 if ((*s == '$' && s+1 < send &&
2252                     (alwaysdollar || /*(*/ (s[1] != ')' && s[1] != '|')) ) ||
2253                     (*s == '@' && s+1 < send) ) {
2254                     len = scanreg(s,send,tokenbuf) - s;
2255                     if (*s == '$' || strEQ(tokenbuf,"ARGV")
2256                       || strEQ(tokenbuf,"ENV")
2257                       || strEQ(tokenbuf,"SIG")
2258                       || strEQ(tokenbuf,"INC") )
2259                         (void)stabent(tokenbuf,TRUE); /* make sure it exists */
2260                     while (len--)
2261                         *d++ = *s++;
2262                     continue;
2263                 }
2264                 else if (*s == '\\' && s+1 < send) {
2265                     s++;
2266                     switch (*s) {
2267                     default:
2268                         if (!makesingle && (!leave || (*s && index(leave,*s))))
2269                             *d++ = '\\';
2270                         *d++ = *s++;
2271                         continue;
2272                     case '0': case '1': case '2': case '3':
2273                     case '4': case '5': case '6': case '7':
2274                         *d = *s++ - '0';
2275                         if (s < send && *s && index("01234567",*s)) {
2276                             *d <<= 3;
2277                             *d += *s++ - '0';
2278                         }
2279                         if (s < send && *s && index("01234567",*s)) {
2280                             *d <<= 3;
2281                             *d += *s++ - '0';
2282                         }
2283                         d++;
2284                         continue;
2285                     case 'b':
2286                         *d++ = '\b';
2287                         break;
2288                     case 'n':
2289                         *d++ = '\n';
2290                         break;
2291                     case 'r':
2292                         *d++ = '\r';
2293                         break;
2294                     case 'f':
2295                         *d++ = '\f';
2296                         break;
2297                     case 't':
2298                         *d++ = '\t';
2299                         break;
2300                     }
2301                     s++;
2302                     continue;
2303                 }
2304                 *d++ = *s++;
2305             }
2306             *d = '\0';
2307
2308             if ((arg[1].arg_type & A_MASK) == A_DOUBLE && makesingle)
2309                     arg[1].arg_type = A_SINGLE; /* now we can optimize on it */
2310
2311             tmpstr->str_cur = d - tmpstr->str_ptr;
2312             arg[1].arg_ptr.arg_str = tmpstr;
2313             s = tmps;
2314             break;
2315         }
2316     }
2317     if (hereis)
2318         str_free(herewas);
2319     return s;
2320 }
2321
2322 FCMD *
2323 load_format()
2324 {
2325     FCMD froot;
2326     FCMD *flinebeg;
2327     char *eol;
2328     register FCMD *fprev = &froot;
2329     register FCMD *fcmd;
2330     register char *s;
2331     register char *t;
2332     register STR *str;
2333     bool noblank;
2334     bool repeater;
2335
2336     Zero(&froot, 1, FCMD);
2337     s = bufptr;
2338     while (s < bufend || (s = str_gets(linestr,rsfp, 0)) != Nullch) {
2339         curcmd->c_line++;
2340         if (in_eval && !rsfp) {
2341             eol = index(s,'\n');
2342             if (!eol++)
2343                 eol = bufend;
2344         }
2345         else
2346             eol = bufend = linestr->str_ptr + linestr->str_cur;
2347         if (perldb) {
2348             STR *tmpstr = Str_new(89,0);
2349
2350             str_nset(tmpstr, s, eol-s);
2351             astore(stab_xarray(curcmd->c_filestab), (int)curcmd->c_line,tmpstr);
2352         }
2353         if (strnEQ(s,".\n",2)) {
2354             bufptr = s;
2355             return froot.f_next;
2356         }
2357         if (*s == '#') {
2358             s = eol;
2359             continue;
2360         }
2361         flinebeg = Nullfcmd;
2362         noblank = FALSE;
2363         repeater = FALSE;
2364         while (s < eol) {
2365             Newz(804,fcmd,1,FCMD);
2366             fprev->f_next = fcmd;
2367             fprev = fcmd;
2368             for (t=s; t < eol && *t != '@' && *t != '^'; t++) {
2369                 if (*t == '~') {
2370                     noblank = TRUE;
2371                     *t = ' ';
2372                     if (t[1] == '~') {
2373                         repeater = TRUE;
2374                         t[1] = ' ';
2375                     }
2376                 }
2377             }
2378             fcmd->f_pre = nsavestr(s, t-s);
2379             fcmd->f_presize = t-s;
2380             s = t;
2381             if (s >= eol) {
2382                 if (noblank)
2383                     fcmd->f_flags |= FC_NOBLANK;
2384                 if (repeater)
2385                     fcmd->f_flags |= FC_REPEAT;
2386                 break;
2387             }
2388             if (!flinebeg)
2389                 flinebeg = fcmd;                /* start values here */
2390             if (*s++ == '^')
2391                 fcmd->f_flags |= FC_CHOP;       /* for doing text filling */
2392             switch (*s) {
2393             case '*':
2394                 fcmd->f_type = F_LINES;
2395                 *s = '\0';
2396                 break;
2397             case '<':
2398                 fcmd->f_type = F_LEFT;
2399                 while (*s == '<')
2400                     s++;
2401                 break;
2402             case '>':
2403                 fcmd->f_type = F_RIGHT;
2404                 while (*s == '>')
2405                     s++;
2406                 break;
2407             case '|':
2408                 fcmd->f_type = F_CENTER;
2409                 while (*s == '|')
2410                     s++;
2411                 break;
2412             case '#':
2413             case '.':
2414                 /* Catch the special case @... and handle it as a string
2415                    field. */
2416                 if (*s == '.' && s[1] == '.') {
2417                     goto default_format;
2418                 }
2419                 fcmd->f_type = F_DECIMAL;
2420                 {
2421                     char *p;
2422
2423                     /* Read a format in the form @####.####, where either group
2424                        of ### may be empty, or the final .### may be missing. */
2425                     while (*s == '#')
2426                         s++;
2427                     if (*s == '.') {
2428                         s++;
2429                         p = s;
2430                         while (*s == '#')
2431                             s++;
2432                         fcmd->f_decimals = s-p;
2433                         fcmd->f_flags |= FC_DP;
2434                     } else {
2435                         fcmd->f_decimals = 0;
2436                     }
2437                 }
2438                 break;
2439             default:
2440             default_format:
2441                 fcmd->f_type = F_LEFT;
2442                 break;
2443             }
2444             if (fcmd->f_flags & FC_CHOP && *s == '.') {
2445                 fcmd->f_flags |= FC_MORE;
2446                 while (*s == '.')
2447                     s++;
2448             }
2449             fcmd->f_size = s-t;
2450         }
2451         if (flinebeg) {
2452           again:
2453             if (s >= bufend && (s = str_gets(linestr, rsfp, 0)) == Nullch)
2454                 goto badform;
2455             curcmd->c_line++;
2456             if (in_eval && !rsfp) {
2457                 eol = index(s,'\n');
2458                 if (!eol++)
2459                     eol = bufend;
2460             }
2461             else
2462                 eol = bufend = linestr->str_ptr + linestr->str_cur;
2463             if (perldb) {
2464                 STR *tmpstr = Str_new(90,0);
2465
2466                 str_nset(tmpstr, s, eol-s);
2467                 astore(stab_xarray(curcmd->c_filestab),
2468                     (int)curcmd->c_line,tmpstr);
2469             }
2470             if (strnEQ(s,".\n",2)) {
2471                 bufptr = s;
2472                 yyerror("Missing values line");
2473                 return froot.f_next;
2474             }
2475             if (*s == '#') {
2476                 s = eol;
2477                 goto again;
2478             }
2479             str = flinebeg->f_unparsed = Str_new(91,eol - s);
2480             str->str_u.str_hash = curstash;
2481             str_nset(str,"(",1);
2482             flinebeg->f_line = curcmd->c_line;
2483             eol[-1] = '\0';
2484             if (!flinebeg->f_next->f_type || index(s, ',')) {
2485                 eol[-1] = '\n';
2486                 str_ncat(str, s, eol - s - 1);
2487                 str_ncat(str,",$$);",5);
2488                 s = eol;
2489             }
2490             else {
2491                 eol[-1] = '\n';
2492                 while (s < eol && isspace(*s))
2493                     s++;
2494                 t = s;
2495                 while (s < eol) {
2496                     switch (*s) {
2497                     case ' ': case '\t': case '\n': case ';':
2498                         str_ncat(str, t, s - t);
2499                         str_ncat(str, "," ,1);
2500                         while (s < eol && (isspace(*s) || *s == ';'))
2501                             s++;
2502                         t = s;
2503                         break;
2504                     case '$':
2505                         str_ncat(str, t, s - t);
2506                         t = s;
2507                         s = scanreg(s,eol,tokenbuf);
2508                         str_ncat(str, t, s - t);
2509                         t = s;
2510                         if (s < eol && *s && index("$'\"",*s))
2511                             str_ncat(str, ",", 1);
2512                         break;
2513                     case '"': case '\'':
2514                         str_ncat(str, t, s - t);
2515                         t = s;
2516                         s++;
2517                         while (s < eol && (*s != *t || s[-1] == '\\'))
2518                             s++;
2519                         if (s < eol)
2520                             s++;
2521                         str_ncat(str, t, s - t);
2522                         t = s;
2523                         if (s < eol && *s && index("$'\"",*s))
2524                             str_ncat(str, ",", 1);
2525                         break;
2526                     default:
2527                         yyerror("Please use commas to separate fields");
2528                     }
2529                 }
2530                 str_ncat(str,"$$);",4);
2531             }
2532         }
2533     }
2534   badform:
2535     bufptr = str_get(linestr);
2536     yyerror("Format not terminated");
2537     return froot.f_next;
2538 }
2539
2540 set_csh()
2541 {
2542 #ifdef CSH
2543     if (!cshlen)
2544         cshlen = strlen(cshname);
2545 #endif
2546 }