toke.c

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