toke.c

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