toke.c

   1 /* $RCSfile: toke.c,v $$Revision: 4.1 $$Date: 92/08/07 18:28:39 $
   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.1  92/08/07  18:28:39  lwall
  10  *
  11  * Revision 4.0.1.7  92/06/11  21:16:30  lwall
  12  * patch34: expect incorrectly set to indicate start of program or block
  13  *
  14  * Revision 4.0.1.6  92/06/08  16:03:49  lwall
  15  * patch20: an EXPR may now start with a bareword
  16  * patch20: print $fh EXPR can now expect term rather than operator in EXPR
  17  * patch20: added ... as variant on ..
  18  * patch20: new warning on spurious backslash
  19  * patch20: new warning on missing $ for foreach variable
  20  * patch20: "foo"x1024 now legal without space after x
  21  * patch20: new warning on print accidentally used as function
  22  * patch20: tr/stuff// wasn't working right
  23  * patch20: 2. now eats the dot
  24  * patch20: <@ARGV> now notices @ARGV
  25  * patch20: tr/// now lets you say \-
  26  *
  27  * Revision 4.0.1.5  91/11/11  16:45:51  lwall
  28  * patch19: default arg for shift was wrong after first subroutine definition
  29  *
  30  * Revision 4.0.1.4  91/11/05  19:02:48  lwall
  31  * patch11: \x and \c were subject to double interpretation in regexps
  32  * patch11: prepared for ctype implementations that don't define isascii()
  33  * patch11: nested list operators could miscount parens
  34  * patch11: once-thru blocks didn't display right in the debugger
  35  * patch11: sort eval "whatever" didn't work
  36  * patch11: underscore is now allowed within literal octal and hex numbers
  37  *
  38  * Revision 4.0.1.3  91/06/10  01:32:26  lwall
  39  * patch10: m'$foo' now treats string as single quoted
  40  * patch10: certain pattern optimizations were botched
  41  *
  42  * Revision 4.0.1.2  91/06/07  12:05:56  lwall
  43  * patch4: new copyright notice
  44  * patch4: debugger lost track of lines in eval
  45  * patch4: //o and s///o now optimize themselves fully at runtime
  46  * patch4: added global modifier for pattern matches
  47  *
  48  * Revision 4.0.1.1  91/04/12  09:18:18  lwall
  49  * patch1: perl -de "print" wouldn't stop at the first statement
  50  *
  51  * Revision 4.0  91/03/20  01:42:14  lwall
  52  * 4.0 baseline.
  53  *
  54  */
  55
  56 #include "EXTERN.h"
  57 #include "perl.h"
  58 #include "perly.h"
  59
  60 static void set_csh();
  61
  62 /* The following are arranged oddly so that the guard on the switch statement
  63  * can get by with a single comparison (if the compiler is smart enough).
  64  */
  65
  66 #define LEX_NORMAL              8
  67 #define LEX_INTERPNORMAL        7
  68 #define LEX_INTERPCASEMOD       6
  69 #define LEX_INTERPSTART         5
  70 #define LEX_INTERPEND           4
  71 #define LEX_INTERPENDMAYBE      3
  72 #define LEX_INTERPCONCAT        2
  73 #define LEX_INTERPCONST         1
  74 #define LEX_KNOWNEXT            0
  75
  76 static U32              lex_state = LEX_NORMAL; /* next token is determined */
  77 static U32              lex_defer;      /* state after determined token */
  78 static expectation      lex_expect;     /* expect after determined token */
  79 static I32              lex_brackets;   /* bracket count */
  80 static I32              lex_fakebrack;  /* outer bracket is mere delimiter */
  81 static I32              lex_casemods;   /* casemod count */
  82 static I32              lex_dojoin;     /* doing an array interpolation */
  83 static I32              lex_starts;     /* how many interps done on level */
  84 static SV *             lex_stuff;      /* runtime pattern from m// or s/// */
  85 static SV *             lex_repl;       /* runtime replacement from s/// */
  86 static OP *             lex_op;         /* extra info to pass back on op */
  87 static I32              lex_inpat;      /* in pattern $) and $| are special */
  88 static I32              lex_inwhat;     /* what kind of quoting are we in */
  89 static char *           lex_brackstack; /* what kind of brackets to pop */
  90
  91 /* What we know when we're in LEX_KNOWNEXT state. */
  92 static YYSTYPE  nextval[5];     /* value of next token, if any */
  93 static I32      nexttype[5];    /* type of next token */
  94 static I32      nexttoke = 0;
  95
  96 #ifdef I_FCNTL
  97 #include <fcntl.h>
  98 #endif
  99 #ifdef I_SYS_FILE
 100 #include <sys/file.h>
 101 #endif
 102
 103 #ifdef ff_next
 104 #undef ff_next
 105 #endif
 106
 107 #include "keywords.h"
 108
 109 void checkcomma();
 110
 111 #ifdef CLINE
 112 #undef CLINE
 113 #endif
 114 #define CLINE (copline = (curcop->cop_line < copline ? curcop->cop_line : copline))
 115
 116 #ifdef atarist
 117 #define PERL_META(c) ((c) | 128)
 118 #else
 119 #define META(c) ((c) | 128)
 120 #endif
 121
 122 #define TOKEN(retval) return (bufptr = s,(int)retval)
 123 #define OPERATOR(retval) return (expect = XTERM,bufptr = s,(int)retval)
 124 #define PREBLOCK(retval) return (expect = XBLOCK,bufptr = s,(int)retval)
 125 #define PREREF(retval) return (expect = XREF,bufptr = s,(int)retval)
 126 #define TERM(retval) return (CLINE, expect = XOPERATOR,bufptr = s,(int)retval)
 127 #define LOOPX(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LOOPEX)
 128 #define FTST(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)UNIOP)
 129 #define FUN0(f) return(yylval.ival = f,expect = XOPERATOR,bufptr = s,(int)FUNC0)
 130 #define FUN1(f) return(yylval.ival = f,expect = XOPERATOR,bufptr = s,(int)FUNC1)
 131 #define BOop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)BITOROP)
 132 #define BAop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)BITANDOP)
 133 #define SHop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)SHIFTOP)
 134 #define PWop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)POWOP)
 135 #define PMop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)MATCHOP)
 136 #define Aop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)ADDOP)
 137 #define Mop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)MULOP)
 138 #define Eop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)EQOP)
 139 #define Rop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)RELOP)
 140
 141 /* This bit of chicanery makes a unary function followed by
 142  * a parenthesis into a function with one argument, highest precedence.
 143  */
 144 #define UNI(f) return(yylval.ival = f, \
 145         expect = XTERM, \
 146         bufptr = s, \
 147         last_uni = oldbufptr, \
 148         (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
 149
 150 #define UNIBRACK(f) return(yylval.ival = f, \
 151         bufptr = s, \
 152         last_uni = oldbufptr, \
 153         (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
 154
 155 /* This does similarly for list operators */
 156 #define LOP(f) return(yylval.ival = f, \
 157         CLINE, \
 158         expect = XREF, \
 159         bufptr = s, \
 160         last_lop = oldbufptr, \
 161         last_lop_op = f, \
 162         (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC : (int)LSTOP) )
 163
 164 /* grandfather return to old style */
 165 #define OLDLOP(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LSTOP)
 166
 167 static void
 168 no_op(what, s)
 169 char *what;
 170 char *s;
 171 {
 172     char tmpbuf[128];
 173     char *oldbufptr = bufptr;
 174     bufptr = s;
 175     sprintf(tmpbuf, "%s found where operator expected", what);
 176     yywarn(tmpbuf);
 177     if (bufptr == SvPVX(linestr))
 178         warn("\t(Missing semicolon on previous line?)\n", what);
 179     bufptr = oldbufptr;
 180 }
 181
 182 static void
 183 missingterm(s)
 184 char *s;
 185 {
 186     char tmpbuf[3];
 187     char q;
 188     if (s) {
 189         char *nl = strrchr(s,'\n');
 190         if (nl)
 191             *nl = '\0';
 192     }
 193     else if (multi_close < 32 || multi_close == 127) {
 194         *tmpbuf = '^';
 195         tmpbuf[1] = multi_close ^ 64;
 196         s = "\\n";
 197         tmpbuf[2] = '\0';
 198         s = tmpbuf;
 199     }
 200     else {
 201         *tmpbuf = multi_close;
 202         tmpbuf[1] = '\0';
 203         s = tmpbuf;
 204     }
 205     q = strchr(s,'"') ? '\'' : '"';
 206     croak("Can't find string terminator %c%s%c anywhere before EOF",q,s,q);
 207 }
 208
 209 void
 210 lex_start(line)
 211 SV *line;
 212 {
 213     char *s;
 214     STRLEN len;
 215
 216     SAVEINT(lex_dojoin);
 217     SAVEINT(lex_brackets);
 218     SAVEINT(lex_fakebrack);
 219     SAVEINT(lex_casemods);
 220     SAVEINT(lex_starts);
 221     SAVEINT(lex_state);
 222     SAVEINT(lex_inpat);
 223     SAVEINT(lex_inwhat);
 224     SAVEINT(curcop->cop_line);
 225     SAVESPTR(bufptr);
 226     SAVESPTR(bufend);
 227     SAVESPTR(oldbufptr);
 228     SAVESPTR(oldoldbufptr);
 229     SAVESPTR(linestr);
 230     SAVESPTR(lex_brackstack);
 231     SAVESPTR(rsfp);
 232
 233     lex_state = LEX_NORMAL;
 234     lex_defer = 0;
 235     expect = XSTATE;
 236     lex_brackets = 0;
 237     lex_fakebrack = 0;
 238     if (lex_brackstack)
 239         SAVESPTR(lex_brackstack);
 240     New(899, lex_brackstack, 120, char);
 241     SAVEFREEPV(lex_brackstack);
 242     lex_casemods = 0;
 243     lex_dojoin = 0;
 244     lex_starts = 0;
 245     if (lex_stuff)
 246         SvREFCNT_dec(lex_stuff);
 247     lex_stuff = Nullsv;
 248     if (lex_repl)
 249         SvREFCNT_dec(lex_repl);
 250     lex_repl = Nullsv;
 251     lex_inpat = 0;
 252     lex_inwhat = 0;
 253     linestr = line;
 254     if (SvREADONLY(linestr))
 255         linestr = sv_2mortal(newSVsv(linestr));
 256     s = SvPV(linestr, len);
 257     if (len && s[len-1] != ';') {
 258         if (!(SvFLAGS(linestr) & SVs_TEMP));
 259             linestr = sv_2mortal(newSVsv(linestr));
 260         sv_catpvn(linestr, "\n;", 2);
 261     }
 262     SvTEMP_off(linestr);
 263     oldoldbufptr = oldbufptr = bufptr = SvPVX(linestr);
 264     bufend = bufptr + SvCUR(linestr);
 265     rs = "\n";
 266     rslen = 1;
 267     rschar = '\n';
 268     rspara = 0;
 269     rsfp = 0;
 270 }
 271
 272 void
 273 lex_end()
 274 {
 275 }
 276
 277 static void
 278 incline(s)
 279 char *s;
 280 {
 281     char *t;
 282     char *n;
 283     char ch;
 284     int sawline = 0;
 285
 286     curcop->cop_line++;
 287     if (*s++ != '#')
 288         return;
 289     while (*s == ' ' || *s == '\t') s++;
 290     if (strnEQ(s, "line ", 5)) {
 291         s += 5;
 292         sawline = 1;
 293     }
 294     if (!isDIGIT(*s))
 295         return;
 296     n = s;
 297     while (isDIGIT(*s))
 298         s++;
 299     while (*s == ' ' || *s == '\t')
 300         s++;
 301     if (*s == '"' && (t = strchr(s+1, '"')))
 302         s++;
 303     else {
 304         if (!sawline)
 305             return;             /* false alarm */
 306         for (t = s; !isSPACE(*t); t++) ;
 307     }
 308     ch = *t;
 309     *t = '\0';
 310     if (t - s > 0)
 311         curcop->cop_filegv = gv_fetchfile(s);
 312     else
 313         curcop->cop_filegv = gv_fetchfile(origfilename);
 314     *t = ch;
 315     curcop->cop_line = atoi(n)-1;
 316 }
 317
 318 static char *
 319 skipspace(s)
 320 register char *s;
 321 {
 322     if (in_format && lex_brackets <= 1) {
 323         while (s < bufend && (*s == ' ' || *s == '\t'))
 324             s++;
 325         return s;
 326     }
 327     for (;;) {
 328         while (s < bufend && isSPACE(*s))
 329             s++;
 330         if (s < bufend && *s == '#') {
 331             while (s < bufend && *s != '\n')
 332                 s++;
 333             if (s < bufend)
 334                 s++;
 335         }
 336         if (s < bufend || !rsfp)
 337             return s;
 338         if ((s = sv_gets(linestr, rsfp, 0)) == Nullch) {
 339             sv_setpv(linestr,";");
 340             oldoldbufptr = oldbufptr = bufptr = s = SvPVX(linestr);
 341             bufend = s+1;
 342             if (preprocess)
 343                 (void)my_pclose(rsfp);
 344             else if ((FILE*)rsfp == stdin)
 345                 clearerr(stdin);
 346             else
 347                 (void)fclose(rsfp);
 348             rsfp = Nullfp;
 349             return s;
 350         }
 351         oldoldbufptr = oldbufptr = bufptr = s;
 352         bufend = bufptr + SvCUR(linestr);
 353         if (perldb && curstash != debstash) {
 354             SV *sv = NEWSV(85,0);
 355
 356             sv_upgrade(sv, SVt_PVMG);
 357             sv_setsv(sv,linestr);
 358             av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv);
 359         }
 360         incline(s);
 361     }
 362 }
 363
 364 static void
 365 check_uni() {
 366     char *s;
 367     char ch;
 368
 369     if (oldoldbufptr != last_uni)
 370         return;
 371     while (isSPACE(*last_uni))
 372         last_uni++;
 373     for (s = last_uni; isALNUM(*s) || *s == '-'; s++) ;
 374     ch = *s;
 375     *s = '\0';
 376     warn("Warning: Use of \"%s\" without parens is ambiguous", last_uni);
 377     *s = ch;
 378 }
 379
 380 #ifdef CRIPPLED_CC
 381
 382 #undef UNI
 383 #undef LOP
 384 #define UNI(f) return uni(f,s)
 385 #define LOP(f) return lop(f,s)
 386
 387 static int
 388 uni(f,s)
 389 I32 f;
 390 char *s;
 391 {
 392     yylval.ival = f;
 393     expect = XTERM;
 394     bufptr = s;
 395     last_uni = oldbufptr;
 396     if (*s == '(')
 397         return FUNC1;
 398     s = skipspace(s);
 399     if (*s == '(')
 400         return FUNC1;
 401     else
 402         return UNIOP;
 403 }
 404
 405 static I32
 406 lop(f,s)
 407 I32 f;
 408 char *s;
 409 {
 410     yylval.ival = f;
 411     CLINE;
 412     expect = XREF;
 413     bufptr = s;
 414     last_lop = oldbufptr;
 415     last_lop_op = f;
 416     if (*s == '(')
 417         return FUNC;
 418     s = skipspace(s);
 419     if (*s == '(')
 420         return FUNC;
 421     else
 422         return LSTOP;
 423 }
 424
 425 #endif /* CRIPPLED_CC */
 426
 427 static void
 428 force_next(type)
 429 I32 type;
 430 {
 431     nexttype[nexttoke] = type;
 432     nexttoke++;
 433     if (lex_state != LEX_KNOWNEXT) {
 434         lex_defer = lex_state;
 435         lex_expect = expect;
 436         lex_state = LEX_KNOWNEXT;
 437     }
 438 }
 439
 440 static char *
 441 force_word(start,token,check_keyword,allow_tick)
 442 register char *start;
 443 int token;
 444 int check_keyword;
 445 int allow_tick;
 446 {
 447     register char *s;
 448     STRLEN len;
 449
 450     start = skipspace(start);
 451     s = start;
 452     if (isIDFIRST(*s) || (allow_tick && (*s == '\'' || *s == ':'))) {
 453         s = scan_word(s, tokenbuf, allow_tick, &len);
 454         if (check_keyword && keyword(tokenbuf, len))
 455             return start;
 456         if (token == METHOD) {
 457             s = skipspace(s);
 458             if (*s == '(')
 459                 expect = XTERM;
 460             else {
 461                 expect = XOPERATOR;
 462                 force_next(')');
 463                 force_next('(');
 464             }
 465         }
 466         nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST,0, newSVpv(tokenbuf,0));
 467         nextval[nexttoke].opval->op_private |= OPpCONST_BARE;
 468         force_next(token);
 469     }
 470     return s;
 471 }
 472
 473 static void
 474 force_ident(s)
 475 register char *s;
 476 {
 477     if (s && *s) {
 478         nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
 479         force_next(WORD);
 480     }
 481 }
 482
 483 static SV *
 484 q(sv)
 485 SV *sv;
 486 {
 487     register char *s;
 488     register char *send;
 489     register char *d;
 490     register char delim;
 491     STRLEN len;
 492
 493     if (!SvLEN(sv))
 494         return sv;
 495
 496     s = SvPV(sv, len);
 497     send = s + len;
 498     while (s < send && *s != '\\')
 499         s++;
 500     if (s == send)
 501         return sv;
 502     d = s;
 503     delim = SvIVX(sv);
 504     while (s < send) {
 505         if (*s == '\\') {
 506             if (s + 1 < send && (s[1] == '\\' || s[1] == delim))
 507                 s++;            /* all that, just for this */
 508         }
 509         *d++ = *s++;
 510     }
 511     *d = '\0';
 512     SvCUR_set(sv, d - SvPVX(sv));
 513
 514     return sv;
 515 }
 516
 517 static I32
 518 sublex_start()
 519 {
 520     register I32 op_type = yylval.ival;
 521     SV *sv;
 522     STRLEN len;
 523
 524     if (op_type == OP_NULL) {
 525         yylval.opval = lex_op;
 526         lex_op = Nullop;
 527         return THING;
 528     }
 529     if (op_type == OP_CONST || op_type == OP_READLINE) {
 530         yylval.opval = (OP*)newSVOP(op_type, 0, q(lex_stuff));
 531         lex_stuff = Nullsv;
 532         return THING;
 533     }
 534
 535     push_scope();
 536     SAVEINT(lex_dojoin);
 537     SAVEINT(lex_brackets);
 538     SAVEINT(lex_fakebrack);
 539     SAVEINT(lex_casemods);
 540     SAVEINT(lex_starts);
 541     SAVEINT(lex_state);
 542     SAVEINT(lex_inpat);
 543     SAVEINT(lex_inwhat);
 544     SAVEINT(curcop->cop_line);
 545     SAVESPTR(bufptr);
 546     SAVESPTR(oldbufptr);
 547     SAVESPTR(oldoldbufptr);
 548     SAVESPTR(linestr);
 549     SAVESPTR(lex_brackstack);
 550
 551     linestr = lex_stuff;
 552     lex_stuff = Nullsv;
 553
 554     bufend = bufptr = oldbufptr = oldoldbufptr = SvPVX(linestr);
 555     bufend += SvCUR(linestr);
 556     SAVEFREESV(linestr);
 557
 558     lex_dojoin = FALSE;
 559     lex_brackets = 0;
 560     lex_fakebrack = 0;
 561     New(899, lex_brackstack, 120, char);
 562     SAVEFREEPV(lex_brackstack);
 563     lex_casemods = 0;
 564     lex_starts = 0;
 565     lex_state = LEX_INTERPCONCAT;
 566     curcop->cop_line = multi_start;
 567
 568     lex_inwhat = op_type;
 569     if (op_type == OP_MATCH || op_type == OP_SUBST)
 570         lex_inpat = op_type;
 571     else
 572         lex_inpat = 0;
 573
 574     expect = XTERM;
 575     force_next('(');
 576     if (lex_op) {
 577         yylval.opval = lex_op;
 578         lex_op = Nullop;
 579         return PMFUNC;
 580     }
 581     else
 582         return FUNC;
 583 }
 584
 585 static I32
 586 sublex_done()
 587 {
 588     if (!lex_starts++) {
 589         expect = XOPERATOR;
 590         yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv("",0));
 591         return THING;
 592     }
 593
 594     if (lex_casemods) {         /* oops, we've got some unbalanced parens */
 595         lex_state = LEX_INTERPCASEMOD;
 596         return yylex();
 597     }
 598
 599     /* Is there a right-hand side to take care of? */
 600     if (lex_repl && (lex_inwhat == OP_SUBST || lex_inwhat == OP_TRANS)) {
 601         linestr = lex_repl;
 602         lex_inpat = 0;
 603         bufend = bufptr = oldbufptr = oldoldbufptr = SvPVX(linestr);
 604         bufend += SvCUR(linestr);
 605         SAVEFREESV(linestr);
 606         lex_dojoin = FALSE;
 607         lex_brackets = 0;
 608         lex_fakebrack = 0;
 609         lex_casemods = 0;
 610         lex_starts = 0;
 611         if (SvCOMPILED(lex_repl)) {
 612             lex_state = LEX_INTERPNORMAL;
 613             lex_starts++;
 614         }
 615         else
 616             lex_state = LEX_INTERPCONCAT;
 617         lex_repl = Nullsv;
 618         return ',';
 619     }
 620     else {
 621         pop_scope();
 622         bufend = SvPVX(linestr);
 623         bufend += SvCUR(linestr);
 624         expect = XOPERATOR;
 625         return ')';
 626     }
 627 }
 628
 629 static char *
 630 scan_const(start)
 631 char *start;
 632 {
 633     register char *send = bufend;
 634     SV *sv = NEWSV(93, send - start);
 635     register char *s = start;
 636     register char *d = SvPVX(sv);
 637     char delim = SvIVX(linestr);
 638     bool dorange = FALSE;
 639     I32 len;
 640     char *leave =
 641         lex_inpat
 642             ? "\\.^$@dDwWsSbB+*?|()-nrtfeaxc0123456789[{]}"
 643             : (lex_inwhat & OP_TRANS)
 644                 ? ""
 645                 : "";
 646
 647     while (s < send || dorange) {
 648         if (lex_inwhat == OP_TRANS) {
 649             if (dorange) {
 650                 I32 i;
 651                 I32 max;
 652                 i = d - SvPVX(sv);
 653                 SvGROW(sv, SvLEN(sv) + 256);
 654                 d = SvPVX(sv) + i;
 655                 d -= 2;
 656                 max = d[1] & 0377;
 657                 for (i = (*d & 0377); i <= max; i++)
 658                     *d++ = i;
 659                 dorange = FALSE;
 660                 continue;
 661             }
 662             else if (*s == '-' && s+1 < send  && s != start) {
 663                 dorange = TRUE;
 664                 s++;
 665             }
 666         }
 667         else if (*s == '@')
 668             break;
 669         else if (*s == '$') {
 670             if (!lex_inpat)     /* not a regexp, so $ must be var */
 671                 break;
 672             if (s + 1 < send && s[1] != ')' && s[1] != '|')
 673                 break;          /* in regexp, $ might be tail anchor */
 674         }
 675         if (*s == '\\' && s+1 < send) {
 676             s++;
 677             if (*s == delim) {
 678                 *d++ = *s++;
 679                 continue;
 680             }
 681             if (*s && strchr(leave, *s)) {
 682                 *d++ = '\\';
 683                 *d++ = *s++;
 684                 continue;
 685             }
 686             if (lex_inwhat == OP_SUBST && !lex_inpat &&
 687                 isDIGIT(*s) && !isDIGIT(s[1]))
 688             {
 689                 *--s = '$';
 690                 break;
 691             }
 692             if (lex_inwhat != OP_TRANS && *s && strchr("lLuUE", *s)) {
 693                 --s;
 694                 break;
 695             }
 696             switch (*s) {
 697             case '-':
 698                 if (lex_inwhat == OP_TRANS) {
 699                     *d++ = *s++;
 700                     continue;
 701                 }
 702                 /* FALL THROUGH */
 703             default:
 704                 *d++ = *s++;
 705                 continue;
 706             case '0': case '1': case '2': case '3':
 707             case '4': case '5': case '6': case '7':
 708                 *d++ = scan_oct(s, 3, &len);
 709                 s += len;
 710                 continue;
 711             case 'x':
 712                 *d++ = scan_hex(++s, 2, &len);
 713                 s += len;
 714                 continue;
 715             case 'c':
 716                 s++;
 717                 *d = *s++;
 718                 if (isLOWER(*d))
 719                     *d = toupper(*d);
 720                 *d++ ^= 64;
 721                 continue;
 722             case 'b':
 723                 *d++ = '\b';
 724                 break;
 725             case 'n':
 726                 *d++ = '\n';
 727                 break;
 728             case 'r':
 729                 *d++ = '\r';
 730                 break;
 731             case 'f':
 732                 *d++ = '\f';
 733                 break;
 734             case 't':
 735                 *d++ = '\t';
 736                 break;
 737             case 'e':
 738                 *d++ = '\033';
 739                 break;
 740             case 'a':
 741                 *d++ = '\007';
 742                 break;
 743             }
 744             s++;
 745             continue;
 746         }
 747         *d++ = *s++;
 748     }
 749     *d = '\0';
 750     SvCUR_set(sv, d - SvPVX(sv));
 751     SvPOK_on(sv);
 752
 753     if (SvCUR(sv) + 5 < SvLEN(sv)) {
 754         SvLEN_set(sv, SvCUR(sv) + 1);
 755         Renew(SvPVX(sv), SvLEN(sv), char);
 756     }
 757     if (s > bufptr)
 758         yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
 759     else
 760         SvREFCNT_dec(sv);
 761     return s;
 762 }
 763
 764 /* This is the one truly awful dwimmer necessary to conflate C and sed. */
 765 static int
 766 intuit_more(s)
 767 register char *s;
 768 {
 769     if (lex_brackets)
 770         return TRUE;
 771     if (*s == '-' && s[1] == '>' && (s[2] == '[' || s[2] == '{'))
 772         return TRUE;
 773     if (*s != '{' && *s != '[')
 774         return FALSE;
 775     if (!lex_inpat)
 776         return TRUE;
 777
 778     /* In a pattern, so maybe we have {n,m}. */
 779     if (*s == '{') {
 780         s++;
 781         if (!isDIGIT(*s))
 782             return TRUE;
 783         while (isDIGIT(*s))
 784             s++;
 785         if (*s == ',')
 786             s++;
 787         while (isDIGIT(*s))
 788             s++;
 789         if (*s == '}')
 790             return FALSE;
 791         return TRUE;
 792
 793     }
 794
 795     /* On the other hand, maybe we have a character class */
 796
 797     s++;
 798     if (*s == ']' || *s == '^')
 799         return FALSE;
 800     else {
 801         int weight = 2;         /* let's weigh the evidence */
 802         char seen[256];
 803         unsigned char un_char = 0, last_un_char;
 804         char *send = strchr(s,']');
 805         char tmpbuf[512];
 806
 807         if (!send)              /* has to be an expression */
 808             return TRUE;
 809
 810         Zero(seen,256,char);
 811         if (*s == '$')
 812             weight -= 3;
 813         else if (isDIGIT(*s)) {
 814             if (s[1] != ']') {
 815                 if (isDIGIT(s[1]) && s[2] == ']')
 816                     weight -= 10;
 817             }
 818             else
 819                 weight -= 100;
 820         }
 821         for (; s < send; s++) {
 822             last_un_char = un_char;
 823             un_char = (unsigned char)*s;
 824             switch (*s) {
 825             case '@':
 826             case '&':
 827             case '$':
 828                 weight -= seen[un_char] * 10;
 829                 if (isALNUM(s[1])) {
 830                     scan_ident(s,send,tmpbuf,FALSE);
 831                     if (strlen(tmpbuf) > 1 && gv_fetchpv(tmpbuf,FALSE))
 832                         weight -= 100;
 833                     else
 834                         weight -= 10;
 835                 }
 836                 else if (*s == '$' && s[1] &&
 837                   strchr("[#!%*<>()-=",s[1])) {
 838                     if (/*{*/ strchr("])} =",s[2]))
 839                         weight -= 10;
 840                     else
 841                         weight -= 1;
 842                 }
 843                 break;
 844             case '\\':
 845                 un_char = 254;
 846                 if (s[1]) {
 847                     if (strchr("wds]",s[1]))
 848                         weight += 100;
 849                     else if (seen['\''] || seen['"'])
 850                         weight += 1;
 851                     else if (strchr("rnftbxcav",s[1]))
 852                         weight += 40;
 853                     else if (isDIGIT(s[1])) {
 854                         weight += 40;
 855                         while (s[1] && isDIGIT(s[1]))
 856                             s++;
 857                     }
 858                 }
 859                 else
 860                     weight += 100;
 861                 break;
 862             case '-':
 863                 if (s[1] == '\\')
 864                     weight += 50;
 865                 if (strchr("aA01! ",last_un_char))
 866                     weight += 30;
 867                 if (strchr("zZ79~",s[1]))
 868                     weight += 30;
 869                 break;
 870             default:
 871                 if (!isALNUM(last_un_char) && !strchr("$@&",last_un_char) &&
 872                         isALPHA(*s) && s[1] && isALPHA(s[1])) {
 873                     char *d = tmpbuf;
 874                     while (isALPHA(*s))
 875                         *d++ = *s++;
 876                     *d = '\0';
 877                     if (keyword(tmpbuf, d - tmpbuf))
 878                         weight -= 150;
 879                 }
 880                 if (un_char == last_un_char + 1)
 881                     weight += 5;
 882                 weight -= seen[un_char];
 883                 break;
 884             }
 885             seen[un_char]++;
 886         }
 887         if (weight >= 0)        /* probably a character class */
 888             return FALSE;
 889     }
 890
 891     return TRUE;
 892 }
 893
 894 static char* exp_name[] = { "OPERATOR", "TERM", "REF", "STATE", "BLOCK" };
 895
 896 extern int yychar;              /* last token */
 897
 898 int
 899 yylex()
 900 {
 901     register char *s;
 902     register char *d;
 903     register I32 tmp;
 904     STRLEN len;
 905
 906     switch (lex_state) {
 907 #ifdef COMMENTARY
 908     case LEX_NORMAL:            /* Some compilers will produce faster */
 909     case LEX_INTERPNORMAL:      /* code if we comment these out. */
 910         break;
 911 #endif
 912
 913     case LEX_KNOWNEXT:
 914         nexttoke--;
 915         yylval = nextval[nexttoke];
 916         if (!nexttoke) {
 917             lex_state = lex_defer;
 918             expect = lex_expect;
 919         }
 920         return(nexttype[nexttoke]);
 921
 922     case LEX_INTERPCASEMOD:
 923 #ifdef DEBUGGING
 924         if (bufptr != bufend && *bufptr != '\\')
 925             croak("panic: INTERPCASEMOD");
 926 #endif
 927         if (bufptr == bufend || bufptr[1] == 'E') {
 928             if (lex_casemods <= 1) {
 929                 if (bufptr != bufend)
 930                     bufptr += 2;
 931                 lex_state = LEX_INTERPSTART;
 932             }
 933             if (lex_casemods) {
 934                 --lex_casemods;
 935                 return ')';
 936             }
 937             return yylex();
 938         }
 939         else if (lex_casemods) {
 940             --lex_casemods;
 941             return ')';
 942         }
 943         else {
 944             s = bufptr + 1;
 945             if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
 946                 tmp = *s, *s = s[2], s[2] = tmp;        /* misordered... */
 947             ++lex_casemods;
 948             lex_state = LEX_INTERPCONCAT;
 949             nextval[nexttoke].ival = 0;
 950             force_next('(');
 951             if (*s == 'l')
 952                 nextval[nexttoke].ival = OP_LCFIRST;
 953             else if (*s == 'u')
 954                 nextval[nexttoke].ival = OP_UCFIRST;
 955             else if (*s == 'L')
 956                 nextval[nexttoke].ival = OP_LC;
 957             else if (*s == 'U')
 958                 nextval[nexttoke].ival = OP_UC;
 959             else
 960                 croak("panic: yylex");
 961             bufptr = s + 1;
 962             force_next(FUNC);
 963             if (lex_starts) {
 964                 s = bufptr;
 965                 lex_starts = 0;
 966                 Aop(OP_CONCAT);
 967             }
 968             else
 969                 return yylex();
 970         }
 971
 972     case LEX_INTERPSTART:
 973         if (bufptr == bufend)
 974             return sublex_done();
 975         expect = XTERM;
 976         lex_dojoin = (*bufptr == '@');
 977         lex_state = LEX_INTERPNORMAL;
 978         if (lex_dojoin) {
 979             nextval[nexttoke].ival = 0;
 980             force_next(',');
 981             force_ident("\"");
 982             nextval[nexttoke].ival = 0;
 983             force_next('$');
 984             nextval[nexttoke].ival = 0;
 985             force_next('(');
 986             nextval[nexttoke].ival = OP_JOIN;   /* emulate join($", ...) */
 987             force_next(FUNC);
 988         }
 989         if (lex_starts++) {
 990             s = bufptr;
 991             Aop(OP_CONCAT);
 992         }
 993         else
 994             return yylex();
 995         break;
 996
 997     case LEX_INTERPENDMAYBE:
 998         if (intuit_more(bufptr)) {
 999             lex_state = LEX_INTERPNORMAL;       /* false alarm, more expr */
1000             break;
1001         }
1002         /* FALL THROUGH */
1003
1004     case LEX_INTERPEND:
1005         if (lex_dojoin) {
1006             lex_dojoin = FALSE;
1007             lex_state = LEX_INTERPCONCAT;
1008             return ')';
1009         }
1010         /* FALLTHROUGH */
1011     case LEX_INTERPCONCAT:
1012 #ifdef DEBUGGING
1013         if (lex_brackets)
1014             croak("panic: INTERPCONCAT");
1015 #endif
1016         if (bufptr == bufend)
1017             return sublex_done();
1018
1019         if (SvIVX(linestr) == '\'') {
1020             SV *sv = newSVsv(linestr);
1021             if (!lex_inpat)
1022                 sv = q(sv);
1023             yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
1024             s = bufend;
1025         }
1026         else {
1027             s = scan_const(bufptr);
1028             if (*s == '\\')
1029                 lex_state = LEX_INTERPCASEMOD;
1030             else
1031                 lex_state = LEX_INTERPSTART;
1032         }
1033
1034         if (s != bufptr) {
1035             nextval[nexttoke] = yylval;
1036             expect = XTERM;
1037             force_next(THING);
1038             if (lex_starts++)
1039                 Aop(OP_CONCAT);
1040             else {
1041                 bufptr = s;
1042                 return yylex();
1043             }
1044         }
1045
1046         return yylex();
1047     }
1048
1049     s = bufptr;
1050     oldoldbufptr = oldbufptr;
1051     oldbufptr = s;
1052     DEBUG_p( {
1053         fprintf(stderr,"### Tokener expecting %s at %s\n", exp_name[expect], s);
1054     } )
1055
1056   retry:
1057 #ifdef BADSWITCH
1058     if (*s & 128) {
1059         if ((*s & 127) == '}') {
1060             *s++ = '}';
1061             TOKEN('}');
1062         }
1063         else
1064             warn("Unrecognized character \\%03o ignored", *s++ & 255);
1065         goto retry;
1066     }
1067 #endif
1068     switch (*s) {
1069     default:
1070         if ((*s & 127) == '}') {
1071             *s++ = '}';
1072             TOKEN('}');
1073         }
1074         else
1075             warn("Unrecognized character \\%03o ignored", *s++ & 255);
1076         goto retry;
1077     case 4:
1078     case 26:
1079         goto fake_eof;                  /* emulate EOF on ^D or ^Z */
1080     case 0:
1081         if (!rsfp) {
1082             if (lex_brackets)
1083                 yyerror("Missing right bracket");
1084             TOKEN(0);
1085         }
1086         if (s++ < bufend)
1087             goto retry;                 /* ignore stray nulls */
1088         last_uni = 0;
1089         last_lop = 0;
1090         if (!preambled) {
1091             preambled = TRUE;
1092             sv_setpv(linestr,"");
1093             if (perldb) {
1094                 char *pdb = getenv("PERLDB");
1095
1096                 sv_catpv(linestr, pdb ? pdb : "BEGIN { require 'perldb.pl' }");
1097             }
1098             if (minus_n || minus_p) {
1099                 sv_catpv(linestr, "LINE: while (<>) {");
1100                 if (minus_l)
1101                     sv_catpv(linestr,"chop;");
1102                 if (minus_a)
1103                     sv_catpv(linestr,"@F=split(' ');");
1104             }
1105             oldoldbufptr = oldbufptr = s = SvPVX(linestr);
1106             bufend = SvPVX(linestr) + SvCUR(linestr);
1107             goto retry;
1108         }
1109 #ifdef CRYPTSCRIPT
1110         cryptswitch();
1111 #endif /* CRYPTSCRIPT */
1112         do {
1113             if ((s = sv_gets(linestr, rsfp, 0)) == Nullch) {
1114               fake_eof:
1115                 if (rsfp) {
1116                     if (preprocess)
1117                         (void)my_pclose(rsfp);
1118                     else if ((FILE*)rsfp == stdin)
1119                         clearerr(stdin);
1120                     else
1121                         (void)fclose(rsfp);
1122                     rsfp = Nullfp;
1123                 }
1124                 if (minus_n || minus_p) {
1125                     sv_setpv(linestr,minus_p ? ";}continue{print" : "");
1126                     sv_catpv(linestr,";}");
1127                     oldoldbufptr = oldbufptr = s = SvPVX(linestr);
1128                     bufend = SvPVX(linestr) + SvCUR(linestr);
1129                     minus_n = minus_p = 0;
1130                     goto retry;
1131                 }
1132                 oldoldbufptr = oldbufptr = s = SvPVX(linestr);
1133                 sv_setpv(linestr,"");
1134                 TOKEN(';');     /* not infinite loop because rsfp is NULL now */
1135             }
1136             if (doextract && *s == '#')
1137                 doextract = FALSE;
1138             incline(s);
1139         } while (doextract);
1140         oldoldbufptr = oldbufptr = bufptr = s;
1141         if (perldb && curstash != debstash) {
1142             SV *sv = NEWSV(85,0);
1143
1144             sv_upgrade(sv, SVt_PVMG);
1145             sv_setsv(sv,linestr);
1146             av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv);
1147         }
1148         bufend = SvPVX(linestr) + SvCUR(linestr);
1149         if (curcop->cop_line == 1) {
1150             while (s < bufend && isSPACE(*s))
1151                 s++;
1152             if (*s == ':')      /* for csh's that have to exec sh scripts */
1153                 s++;
1154             if (*s == '#' && s[1] == '!') {
1155                 if (!in_eval && !instr(s,"perl") && instr(origargv[0],"perl")) {
1156                     char **newargv;
1157                     char *cmd;
1158
1159                     s += 2;
1160                     if (*s == ' ')
1161                         s++;
1162                     cmd = s;
1163                     while (s < bufend && !isSPACE(*s))
1164                         s++;
1165                     *s++ = '\0';
1166                     while (s < bufend && isSPACE(*s))
1167                         s++;
1168                     if (s < bufend) {
1169                         Newz(899,newargv,origargc+3,char*);
1170                         newargv[1] = s;
1171                         while (s < bufend && !isSPACE(*s))
1172                             s++;
1173                         *s = '\0';
1174                         Copy(origargv+1, newargv+2, origargc+1, char*);
1175                     }
1176                     else
1177                         newargv = origargv;
1178                     newargv[0] = cmd;
1179                     execv(cmd,newargv);
1180                     croak("Can't exec %s", cmd);
1181                 }
1182                 if (d = instr(s, "perl -")) {
1183                     d += 6;
1184                     /*SUPPRESS 530*/
1185                     while (d = moreswitches(d)) ;
1186                 }
1187             }
1188         }
1189         if (in_format && lex_brackets <= 1) {
1190             s = scan_formline(s);
1191             if (!in_format)
1192                 goto rightbracket;
1193             OPERATOR(';');
1194         }
1195         goto retry;
1196     case ' ': case '\t': case '\f': case '\r': case 013:
1197         s++;
1198         goto retry;
1199     case '#':
1200     case '\n':
1201         if (lex_state != LEX_NORMAL || (in_eval && !rsfp)) {
1202             d = bufend;
1203             while (s < d && *s != '\n')
1204                 s++;
1205             if (s < d)
1206                 s++;
1207             incline(s);
1208             if (in_format && lex_brackets <= 1) {
1209                 s = scan_formline(s);
1210                 if (!in_format)
1211                     goto rightbracket;
1212                 OPERATOR(';');
1213             }
1214         }
1215         else {
1216             *s = '\0';
1217             bufend = s;
1218         }
1219         goto retry;
1220     case '-':
1221         if (s[1] && isALPHA(s[1]) && !isALNUM(s[2])) {
1222             s++;
1223             last_uni = oldbufptr;
1224             switch (*s++) {
1225             case 'r': FTST(OP_FTEREAD);
1226             case 'w': FTST(OP_FTEWRITE);
1227             case 'x': FTST(OP_FTEEXEC);
1228             case 'o': FTST(OP_FTEOWNED);
1229             case 'R': FTST(OP_FTRREAD);
1230             case 'W': FTST(OP_FTRWRITE);
1231             case 'X': FTST(OP_FTREXEC);
1232             case 'O': FTST(OP_FTROWNED);
1233             case 'e': FTST(OP_FTIS);
1234             case 'z': FTST(OP_FTZERO);
1235             case 's': FTST(OP_FTSIZE);
1236             case 'f': FTST(OP_FTFILE);
1237             case 'd': FTST(OP_FTDIR);
1238             case 'l': FTST(OP_FTLINK);
1239             case 'p': FTST(OP_FTPIPE);
1240             case 'S': FTST(OP_FTSOCK);
1241             case 'u': FTST(OP_FTSUID);
1242             case 'g': FTST(OP_FTSGID);
1243             case 'k': FTST(OP_FTSVTX);
1244             case 'b': FTST(OP_FTBLK);
1245             case 'c': FTST(OP_FTCHR);
1246             case 't': FTST(OP_FTTTY);
1247             case 'T': FTST(OP_FTTEXT);
1248             case 'B': FTST(OP_FTBINARY);
1249             case 'M': gv_fetchpv("\024",TRUE); FTST(OP_FTMTIME);
1250             case 'A': gv_fetchpv("\024",TRUE); FTST(OP_FTATIME);
1251             case 'C': gv_fetchpv("\024",TRUE); FTST(OP_FTCTIME);
1252             default:
1253                 s -= 2;
1254                 break;
1255             }
1256         }
1257         tmp = *s++;
1258         if (*s == tmp) {
1259             s++;
1260             if (expect == XOPERATOR)
1261                 TERM(POSTDEC);
1262             else
1263                 OPERATOR(PREDEC);
1264         }
1265         else if (*s == '>') {
1266             s++;
1267             s = skipspace(s);
1268             if (isIDFIRST(*s)) {
1269                 s = force_word(s,METHOD,FALSE,TRUE);
1270                 TOKEN(ARROW);
1271             }
1272             else
1273                 PREBLOCK(ARROW);
1274         }
1275         if (expect == XOPERATOR)
1276             Aop(OP_SUBTRACT);
1277         else {
1278             if (isSPACE(*s) || !isSPACE(*bufptr))
1279                 check_uni();
1280             OPERATOR('-');              /* unary minus */
1281         }
1282
1283     case '+':
1284         tmp = *s++;
1285         if (*s == tmp) {
1286             s++;
1287             if (expect == XOPERATOR)
1288                 TERM(POSTINC);
1289             else
1290                 OPERATOR(PREINC);
1291         }
1292         if (expect == XOPERATOR)
1293             Aop(OP_ADD);
1294         else {
1295             if (isSPACE(*s) || !isSPACE(*bufptr))
1296                 check_uni();
1297             OPERATOR('+');
1298         }
1299
1300     case '*':
1301         if (expect != XOPERATOR) {
1302             s = scan_ident(s, bufend, tokenbuf, TRUE);
1303             expect = XOPERATOR;
1304             force_ident(tokenbuf);
1305             TERM('*');
1306         }
1307         s++;
1308         if (*s == '*') {
1309             s++;
1310             PWop(OP_POW);
1311         }
1312         Mop(OP_MULTIPLY);
1313
1314     case '%':
1315         if (expect != XOPERATOR) {
1316             s = scan_ident(s, bufend, tokenbuf + 1, TRUE);
1317             if (tokenbuf[1]) {
1318                 expect = XOPERATOR;
1319                 tokenbuf[0] = '%';
1320                 if (in_my) {
1321                     if (strchr(tokenbuf,':'))
1322                         croak("\"my\" variable %s can't be in a package",tokenbuf);
1323                     nextval[nexttoke].opval = newOP(OP_PADANY, 0);
1324                     nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf);
1325                     force_next(PRIVATEREF);
1326                     TERM('%');
1327                 }
1328                 if (!strchr(tokenbuf,':')) {
1329                     if (tmp = pad_findmy(tokenbuf)) {
1330                         nextval[nexttoke].opval = newOP(OP_PADANY, 0);
1331                         nextval[nexttoke].opval->op_targ = tmp;
1332                         force_next(PRIVATEREF);
1333                         TERM('%');
1334                     }
1335                 }
1336                 force_ident(tokenbuf + 1);
1337             }
1338             else
1339                 PREREF('%');
1340             TERM('%');
1341         }
1342         ++s;
1343         Mop(OP_MODULO);
1344
1345     case '^':
1346         s++;
1347         BOop(OP_XOR);
1348     case '[':
1349         lex_brackets++;
1350         /* FALL THROUGH */
1351     case '~':
1352     case ',':
1353     case ':':
1354         tmp = *s++;
1355         OPERATOR(tmp);
1356     case '(':
1357         s++;
1358         if (last_lop == oldoldbufptr)
1359             oldbufptr = oldoldbufptr;           /* allow print(STDOUT 123) */
1360         OPERATOR('(');
1361     case ';':
1362         if (curcop->cop_line < copline)
1363             copline = curcop->cop_line;
1364         tmp = *s++;
1365         OPERATOR(tmp);
1366     case ')':
1367         tmp = *s++;
1368         TERM(tmp);
1369     case ']':
1370         s++;
1371         if (lex_brackets <= 0)
1372             yyerror("Unmatched right bracket");
1373         else
1374             --lex_brackets;
1375         if (lex_state == LEX_INTERPNORMAL) {
1376             if (lex_brackets == 0) {
1377                 if (*s != '-' || s[1] != '>')
1378                     lex_state = LEX_INTERPEND;
1379             }
1380         }
1381         TOKEN(']');
1382     case '{':
1383       leftbracket:
1384         if (in_format == 2)
1385             in_format = 0;
1386         s++;
1387         if (lex_brackets > 100) {
1388             char* newlb = (char*)realloc(lex_brackstack, lex_brackets + 1);
1389             if (newlb != lex_brackstack) {
1390                 SAVEFREEPV(newlb);
1391                 lex_brackstack = newlb;
1392             }
1393         }
1394         if (oldoldbufptr == last_lop)
1395             lex_brackstack[lex_brackets++] = XTERM;
1396         else
1397             lex_brackstack[lex_brackets++] = XOPERATOR;
1398         if (expect == XTERM)
1399             OPERATOR(HASHBRACK);
1400         else if (expect == XBLOCK || expect == XOPERATOR) {
1401             lex_brackstack[lex_brackets-1] = XBLOCK;
1402             expect = XBLOCK;
1403         }
1404         else {
1405             char *t;
1406             s = skipspace(s);
1407             if (*s == '}')
1408                 OPERATOR(HASHBRACK);
1409             for (t = s;
1410                 t < bufend &&
1411                     (isSPACE(*t) || isALPHA(*t) || *t == '"' || *t == '\'');
1412                 t++) ;
1413             if (*t == ',' || (*t == '=' && t[1] == '>'))
1414                 OPERATOR(HASHBRACK);
1415             if (expect == XREF)
1416                 expect = XTERM;
1417             else {
1418                 lex_brackstack[lex_brackets-1] = XSTATE;
1419                 expect = XSTATE;
1420             }
1421         }
1422         yylval.ival = curcop->cop_line;
1423         if (isSPACE(*s) || *s == '#')
1424             copline = NOLINE;   /* invalidate current command line number */
1425         TOKEN('{');
1426     case '}':
1427       rightbracket:
1428         s++;
1429         if (lex_brackets <= 0)
1430             yyerror("Unmatched right bracket");
1431         else
1432             expect = (expectation)lex_brackstack[--lex_brackets];
1433         if (lex_state == LEX_INTERPNORMAL) {
1434             if (lex_brackets == 0) {
1435                 if (lex_fakebrack) {
1436                     lex_state = LEX_INTERPEND;
1437                     bufptr = s;
1438                     return yylex();             /* ignore fake brackets */
1439                 }
1440                 if (*s != '-' || s[1] != '>')
1441                     lex_state = LEX_INTERPEND;
1442             }
1443         }
1444         force_next('}');
1445         TOKEN(';');
1446     case '&':
1447         s++;
1448         tmp = *s++;
1449         if (tmp == '&')
1450             OPERATOR(ANDAND);
1451         s--;
1452         if (expect == XOPERATOR) {
1453             if (dowarn && isALPHA(*s) && bufptr == SvPVX(linestr)) {
1454                 curcop->cop_line--;
1455                 warn(warn_nosemi);
1456                 curcop->cop_line++;
1457             }
1458             BAop(OP_BIT_AND);
1459         }
1460
1461         s = scan_ident(s-1, bufend, tokenbuf, TRUE);
1462         if (*tokenbuf) {
1463             expect = XOPERATOR;
1464             force_ident(tokenbuf);
1465         }
1466         else
1467             PREREF('&');
1468         TERM('&');
1469
1470     case '|':
1471         s++;
1472         tmp = *s++;
1473         if (tmp == '|')
1474             OPERATOR(OROR);
1475         s--;
1476         BOop(OP_BIT_OR);
1477     case '=':
1478         s++;
1479         tmp = *s++;
1480         if (tmp == '=')
1481             Eop(OP_EQ);
1482         if (tmp == '>')
1483             OPERATOR(',');
1484         if (tmp == '~')
1485             PMop(OP_MATCH);
1486         if (dowarn && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp))
1487             warn("Reversed %c= operator",tmp);
1488         s--;
1489         if (in_format == 2 && (tmp == '\n' || s[1] == '\n')) {
1490             in_format = 1;
1491             s--;
1492             expect = XBLOCK;
1493             goto leftbracket;
1494         }
1495         OPERATOR('=');
1496     case '!':
1497         s++;
1498         tmp = *s++;
1499         if (tmp == '=')
1500             Eop(OP_NE);
1501         if (tmp == '~')
1502             PMop(OP_NOT);
1503         s--;
1504         OPERATOR('!');
1505     case '<':
1506         if (expect != XOPERATOR) {
1507             if (s[1] != '<' && !strchr(s,'>'))
1508                 check_uni();
1509             if (s[1] == '<')
1510                 s = scan_heredoc(s);
1511             else
1512                 s = scan_inputsymbol(s);
1513             TERM(sublex_start());
1514         }
1515         s++;
1516         tmp = *s++;
1517         if (tmp == '<')
1518             SHop(OP_LEFT_SHIFT);
1519         if (tmp == '=') {
1520             tmp = *s++;
1521             if (tmp == '>')
1522                 Eop(OP_NCMP);
1523             s--;
1524             Rop(OP_LE);
1525         }
1526         s--;
1527         Rop(OP_LT);
1528     case '>':
1529         s++;
1530         tmp = *s++;
1531         if (tmp == '>')
1532             SHop(OP_RIGHT_SHIFT);
1533         if (tmp == '=')
1534             Rop(OP_GE);
1535         s--;
1536         Rop(OP_GT);
1537
1538     case '$':
1539         if (s[1] == '#'  && (isALPHA(s[2]) || s[2] == '_' || s[2] == '{')) {
1540             s = scan_ident(s+1, bufend, tokenbuf, FALSE);
1541             if (expect == XOPERATOR) {
1542                 if (in_format)
1543                     OPERATOR(','); /* grandfather non-comma-format format */
1544                 else
1545                     no_op("Array length",s);
1546             }
1547             expect = XOPERATOR;
1548             force_ident(tokenbuf);
1549             TOKEN(DOLSHARP);
1550         }
1551         s = scan_ident(s, bufend, tokenbuf+1, FALSE);
1552         if (expect == XOPERATOR) {
1553             if (in_format)
1554                 OPERATOR(',');  /* grandfather non-comma-format format */
1555             else
1556                 no_op("Scalar",s);
1557         }
1558         if (tokenbuf[1]) {
1559             tokenbuf[0] = '$';
1560             if (dowarn && *s == '[') {
1561                 char *t;
1562                 for (t = s+1; isSPACE(*t) || isALNUM(*t) || *t == '$'; t++) ;
1563                 if (*t++ == ',') {
1564                     bufptr = skipspace(bufptr);
1565                     while (t < bufend && *t != ']') t++;
1566                     warn("Multidimensional syntax %.*s not supported",
1567                         t-bufptr+1, bufptr);
1568                 }
1569             }
1570             expect = XOPERATOR;
1571             if (lex_state == LEX_NORMAL && isSPACE(*s)) {
1572                 bool islop = (last_lop == oldoldbufptr);
1573                 s = skipspace(s);
1574                 if (!islop)
1575                     expect = XOPERATOR;
1576                 else if (strchr("$@\"'`q", *s))
1577                     expect = XTERM;             /* e.g. print $fh "foo" */
1578                 else if (strchr("&*<%", *s) && isIDFIRST(s[1]))
1579                     expect = XTERM;             /* e.g. print $fh &sub */
1580                 else if (isDIGIT(*s))
1581                     expect = XTERM;             /* e.g. print $fh 3 */
1582                 else if (*s == '.' && isDIGIT(s[1]))
1583                     expect = XTERM;             /* e.g. print $fh .3 */
1584                 else if (strchr("/?-+", *s) && !isSPACE(s[1]))
1585                     expect = XTERM;             /* e.g. print $fh -1 */
1586                 else if (*s == '<' && s[1] == '<' && !isSPACE(s[2]))
1587                     expect = XTERM;             /* print $fh <<"EOF" */
1588             }
1589             if (in_my) {
1590                 if (strchr(tokenbuf,':'))
1591                     croak("\"my\" variable %s can't be in a package",tokenbuf);
1592                 nextval[nexttoke].opval = newOP(OP_PADANY, 0);
1593                 nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf);
1594                 force_next(PRIVATEREF);
1595             }
1596             else if (!strchr(tokenbuf,':')) {
1597                 if (*s == '[')
1598                     tokenbuf[0] = '@';
1599                 else if (*s == '{')
1600                     tokenbuf[0] = '%';
1601                 if (tmp = pad_findmy(tokenbuf)) {
1602                     nextval[nexttoke].opval = newOP(OP_PADANY, 0);
1603                     nextval[nexttoke].opval->op_targ = tmp;
1604                     force_next(PRIVATEREF);
1605                 }
1606                 else
1607                     force_ident(tokenbuf+1);
1608             }
1609             else
1610                 force_ident(tokenbuf+1);
1611         }
1612         else {
1613             if (s == bufend)
1614                 yyerror("Final $ should be \\$ or $name");
1615             PREREF('$');
1616         }
1617         TOKEN('$');
1618
1619     case '@':
1620         s = scan_ident(s, bufend, tokenbuf+1, FALSE);
1621         if (expect == XOPERATOR)
1622             no_op("Array",s);
1623         if (tokenbuf[1]) {
1624             tokenbuf[0] = '@';
1625             expect = XOPERATOR;
1626             if (in_my) {
1627                 if (strchr(tokenbuf,':'))
1628                     croak("\"my\" variable %s can't be in a package",tokenbuf);
1629                 nextval[nexttoke].opval = newOP(OP_PADANY, 0);
1630                 nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf);
1631                 force_next(PRIVATEREF);
1632                 TERM('@');
1633             }
1634             else if (!strchr(tokenbuf,':')) {
1635                 if (*s == '{')
1636                     tokenbuf[0] = '%';
1637                 if (tmp = pad_findmy(tokenbuf)) {
1638                     nextval[nexttoke].opval = newOP(OP_PADANY, 0);
1639                     nextval[nexttoke].opval->op_targ = tmp;
1640                     force_next(PRIVATEREF);
1641                     TERM('@');
1642                 }
1643             }
1644             if (dowarn && *s == '[') {
1645                 char *t;
1646                 for (t = s+1; *t && (isALNUM(*t) || strchr(" \t$#+-", *t)); t++)
1647                     ;
1648                 if (*t++ == ']') {
1649                     bufptr = skipspace(bufptr);
1650                     warn("Scalar value %.*s better written as $%.*s",
1651                         t-bufptr, bufptr, t-bufptr-1, bufptr+1);
1652                 }
1653             }
1654             force_ident(tokenbuf+1);
1655         }
1656         else {
1657             if (s == bufend)
1658                 yyerror("Final @ should be \\@ or @name");
1659             PREREF('@');
1660         }
1661         TERM('@');
1662
1663     case '/':                   /* may either be division or pattern */
1664     case '?':                   /* may either be conditional or pattern */
1665         if (expect != XOPERATOR) {
1666             check_uni();
1667             s = scan_pat(s);
1668             TERM(sublex_start());
1669         }
1670         tmp = *s++;
1671         if (tmp == '/')
1672             Mop(OP_DIVIDE);
1673         OPERATOR(tmp);
1674
1675     case '.':
1676         if (in_format == 2) {
1677             in_format = 0;
1678             expect = XSTATE;
1679             goto rightbracket;
1680         }
1681         if (expect == XOPERATOR || !isDIGIT(s[1])) {
1682             tmp = *s++;
1683             if (*s == tmp) {
1684                 s++;
1685                 if (*s == tmp) {
1686                     s++;
1687                     yylval.ival = OPf_SPECIAL;
1688                 }
1689                 else
1690                     yylval.ival = 0;
1691                 OPERATOR(DOTDOT);
1692             }
1693             if (expect != XOPERATOR)
1694                 check_uni();
1695             Aop(OP_CONCAT);
1696         }
1697         /* FALL THROUGH */
1698     case '0': case '1': case '2': case '3': case '4':
1699     case '5': case '6': case '7': case '8': case '9':
1700         s = scan_num(s);
1701         if (expect == XOPERATOR)
1702             no_op("Number",s);
1703         TERM(THING);
1704
1705     case '\'':
1706         s = scan_str(s);
1707         if (expect == XOPERATOR) {
1708             if (in_format)
1709                 OPERATOR(',');  /* grandfather non-comma-format format */
1710             else
1711                 no_op("String",s);
1712         }
1713         if (!s)
1714             missingterm(0);
1715         yylval.ival = OP_CONST;
1716         TERM(sublex_start());
1717
1718     case '"':
1719         s = scan_str(s);
1720         if (expect == XOPERATOR) {
1721             if (in_format)
1722                 OPERATOR(',');  /* grandfather non-comma-format format */
1723             else
1724                 no_op("String",s);
1725         }
1726         if (!s)
1727             missingterm(0);
1728         yylval.ival = OP_SCALAR;
1729         TERM(sublex_start());
1730
1731     case '`':
1732         s = scan_str(s);
1733         if (expect == XOPERATOR)
1734             no_op("Backticks",s);
1735         if (!s)
1736             missingterm(0);
1737         yylval.ival = OP_BACKTICK;
1738         set_csh();
1739         TERM(sublex_start());
1740
1741     case '\\':
1742         s++;
1743         if (expect == XOPERATOR)
1744             no_op("Backslash",s);
1745         OPERATOR(REFGEN);
1746
1747     case 'x':
1748         if (isDIGIT(s[1]) && expect == XOPERATOR) {
1749             s++;
1750             Mop(OP_REPEAT);
1751         }
1752         goto keylookup;
1753
1754     case '_':
1755     case 'a': case 'A':
1756     case 'b': case 'B':
1757     case 'c': case 'C':
1758     case 'd': case 'D':
1759     case 'e': case 'E':
1760     case 'f': case 'F':
1761     case 'g': case 'G':
1762     case 'h': case 'H':
1763     case 'i': case 'I':
1764     case 'j': case 'J':
1765     case 'k': case 'K':
1766     case 'l': case 'L':
1767     case 'm': case 'M':
1768     case 'n': case 'N':
1769     case 'o': case 'O':
1770     case 'p': case 'P':
1771     case 'q': case 'Q':
1772     case 'r': case 'R':
1773     case 's': case 'S':
1774     case 't': case 'T':
1775     case 'u': case 'U':
1776     case 'v': case 'V':
1777     case 'w': case 'W':
1778               case 'X':
1779     case 'y': case 'Y':
1780     case 'z': case 'Z':
1781
1782       keylookup:
1783         d = s;
1784         s = scan_word(s, tokenbuf, FALSE, &len);
1785
1786         switch (tmp = keyword(tokenbuf, len)) {
1787
1788         default:                        /* not a keyword */
1789           just_a_word: {
1790                 GV *gv;
1791
1792                 /* Get the rest if it looks like a package qualifier */
1793
1794                 if (*s == '\'' || *s == ':')
1795                     s = scan_word(s, tokenbuf + len, TRUE, &len);
1796
1797                 /* Do special processing at start of statement. */
1798
1799                 if (expect == XSTATE) {
1800                     while (isSPACE(*s)) s++;
1801                     if (*s == ':') {    /* It's a label. */
1802                         yylval.pval = savestr(tokenbuf);
1803                         s++;
1804                         CLINE;
1805                         TOKEN(LABEL);
1806                     }
1807                 }
1808                 else if (dowarn && expect == XOPERATOR) {
1809                     if (bufptr == SvPVX(linestr)) {
1810                         curcop->cop_line--;
1811                         warn(warn_nosemi);
1812                         curcop->cop_line++;
1813                     }
1814                     else
1815                         no_op("Bare word",s);
1816                 }
1817
1818                 /* Look for a subroutine with this name in current package. */
1819
1820                 gv = gv_fetchpv(tokenbuf,FALSE);
1821
1822                 /* See if it's the indirect object for a list operator. */
1823
1824                 if (oldoldbufptr && oldoldbufptr < bufptr) {
1825                     if (oldoldbufptr == last_lop &&
1826                         (!gv || !GvCV(gv) || last_lop_op == OP_SORT))
1827                     {
1828                         expect = XTERM;
1829                         CLINE;
1830                         yylval.opval = (OP*)newSVOP(OP_CONST, 0,
1831                             newSVpv(tokenbuf,0));
1832                         yylval.opval->op_private = OPpCONST_BARE;
1833                         for (d = tokenbuf; *d && isLOWER(*d); d++) ;
1834                         if (dowarn && !*d)
1835                             warn(warn_reserved, tokenbuf);
1836                         TOKEN(WORD);
1837                     }
1838                 }
1839
1840                 /* If followed by a paren, it's certainly a subroutine. */
1841
1842                 expect = XOPERATOR;
1843                 s = skipspace(s);
1844                 if (*s == '(') {
1845                     CLINE;
1846                     nextval[nexttoke].opval =
1847                         (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
1848                     nextval[nexttoke].opval->op_private = OPpCONST_BARE;
1849                     expect = XOPERATOR;
1850                     force_next(WORD);
1851                     TOKEN('&');
1852                 }
1853                 CLINE;
1854                 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
1855                 yylval.opval->op_private = OPpCONST_BARE;
1856
1857                 /* If followed by var or block, call it a method (maybe). */
1858
1859                 if ((*s == '$' || *s == '{') && (!gv || !GvCV(gv))) {
1860                     last_lop = oldbufptr;
1861                     last_lop_op = OP_METHOD;
1862                     PREBLOCK(METHOD);
1863                 }
1864
1865                 /* If followed by a bareword, see if it looks like indir obj. */
1866
1867                 if (isALPHA(*s)) {
1868                     char *olds = s;
1869                     char tmpbuf[1024];
1870                     GV* indirgv;
1871                     s = scan_word(s, tmpbuf, TRUE, &len);
1872                     if (!keyword(tmpbuf, len)) {
1873                         SV* tmpsv = newSVpv(tmpbuf,0);
1874                         indirgv = gv_fetchpv(tmpbuf,FALSE);
1875                         if (!indirgv || !GvCV(indirgv)) {
1876                             if (!gv || !GvCV(gv) || fetch_stash(tmpsv, FALSE)) {
1877                                 nextval[nexttoke].opval =
1878                                     (OP*)newSVOP(OP_CONST, 0, tmpsv);
1879                                 nextval[nexttoke].opval->op_private =
1880                                     OPpCONST_BARE;
1881                                 expect = XTERM;
1882                                 force_next(WORD);
1883                                 TOKEN(METHOD);
1884                             }
1885                         }
1886                         SvREFCNT_dec(tmpsv);
1887                     }
1888                     s = olds;
1889                 }
1890
1891                 /* Not a method, so call it a subroutine (if defined) */
1892
1893                 if (gv && GvCV(gv)) {
1894                     nextval[nexttoke].opval = yylval.opval;
1895                     if (*s == '(') {
1896                         expect = XTERM;
1897                         force_next(WORD);
1898                         TOKEN('&');
1899                     }
1900                     last_lop = oldbufptr;
1901                     last_lop_op = OP_ENTERSUBR;
1902                     expect = XTERM;
1903                     force_next(WORD);
1904                     TOKEN(NOAMP);
1905                 }
1906
1907                 /* Call it a bare word */
1908
1909                 for (d = tokenbuf; *d && isLOWER(*d); d++) ;
1910                 if (dowarn && !*d)
1911                     warn(warn_reserved, tokenbuf);
1912                 TOKEN(WORD);
1913             }
1914
1915         case KEY___LINE__:
1916         case KEY___FILE__: {
1917             if (tokenbuf[2] == 'L')
1918                 (void)sprintf(tokenbuf,"%ld",(long)curcop->cop_line);
1919             else
1920                 strcpy(tokenbuf, SvPVX(GvSV(curcop->cop_filegv)));
1921             yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
1922             TERM(THING);
1923         }
1924
1925         case KEY___END__: {
1926             GV *gv;
1927             int fd;
1928
1929             /*SUPPRESS 560*/
1930             if (!in_eval && (gv = gv_fetchpv("DATA",FALSE))) {
1931                 SvMULTI_on(gv);
1932                 if (!GvIO(gv))
1933                     GvIO(gv) = newIO();
1934                 IoIFP(GvIO(gv)) = rsfp;
1935 #if defined(HAS_FCNTL) && defined(FFt_SETFD)
1936                 fd = fileno(rsfp);
1937                 fcntl(fd,FFt_SETFD,fd >= 3);
1938 #endif
1939                 if (preprocess)
1940                     IoTYPE(GvIO(gv)) = '|';
1941                 else if ((FILE*)rsfp == stdin)
1942                     IoTYPE(GvIO(gv)) = '-';
1943                 else
1944                     IoTYPE(GvIO(gv)) = '<';
1945                 rsfp = Nullfp;
1946             }
1947             goto fake_eof;
1948         }
1949
1950         case KEY_AUTOLOAD:
1951         case KEY_DESTROY:
1952         case KEY_BEGIN:
1953         case KEY_END:
1954             s = skipspace(s);
1955             if (expect == XSTATE && (minus_p || minus_n || *s == '{' )) {
1956                 s = bufptr;
1957                 goto really_sub;
1958             }
1959             goto just_a_word;
1960
1961         case KEY_abs:
1962             UNI(OP_ABS);
1963
1964         case KEY_alarm:
1965             UNI(OP_ALARM);
1966
1967         case KEY_accept:
1968             LOP(OP_ACCEPT);
1969
1970         case KEY_and:
1971             OPERATOR(ANDOP);
1972
1973         case KEY_atan2:
1974             LOP(OP_ATAN2);
1975
1976         case KEY_bind:
1977             LOP(OP_BIND);
1978
1979         case KEY_binmode:
1980             UNI(OP_BINMODE);
1981
1982         case KEY_bless:
1983             LOP(OP_BLESS);
1984
1985         case KEY_chop:
1986             UNI(OP_CHOP);
1987
1988         case KEY_continue:
1989             PREBLOCK(CONTINUE);
1990
1991         case KEY_chdir:
1992             (void)gv_fetchpv("ENV",TRUE);       /* may use HOME */
1993             UNI(OP_CHDIR);
1994
1995         case KEY_close:
1996             UNI(OP_CLOSE);
1997
1998         case KEY_closedir:
1999             UNI(OP_CLOSEDIR);
2000
2001         case KEY_cmp:
2002             Eop(OP_SCMP);
2003
2004         case KEY_caller:
2005             UNI(OP_CALLER);
2006
2007         case KEY_crypt:
2008 #ifdef FCRYPT
2009             if (!cryptseen++)
2010                 init_des();
2011 #endif
2012             LOP(OP_CRYPT);
2013
2014         case KEY_chmod:
2015             s = skipspace(s);
2016             if (dowarn && *s != '0' && isDIGIT(*s))
2017                 yywarn("chmod: mode argument is missing initial 0");
2018             LOP(OP_CHMOD);
2019
2020         case KEY_chown:
2021             LOP(OP_CHOWN);
2022
2023         case KEY_connect:
2024             LOP(OP_CONNECT);
2025
2026         case KEY_chr:
2027             UNI(OP_CHR);
2028
2029         case KEY_cos:
2030             UNI(OP_COS);
2031
2032         case KEY_chroot:
2033             UNI(OP_CHROOT);
2034
2035         case KEY_do:
2036             s = skipspace(s);
2037             if (*s == '{')
2038                 PREBLOCK(DO);
2039             if (*s != '\'')
2040                 s = force_word(s,WORD,FALSE,TRUE);
2041             OPERATOR(DO);
2042
2043         case KEY_die:
2044             LOP(OP_DIE);
2045
2046         case KEY_defined:
2047             UNI(OP_DEFINED);
2048
2049         case KEY_delete:
2050             OPERATOR(DELETE);
2051
2052         case KEY_dbmopen:
2053             LOP(OP_DBMOPEN);
2054
2055         case KEY_dbmclose:
2056             UNI(OP_DBMCLOSE);
2057
2058         case KEY_dump:
2059             s = force_word(s,WORD,TRUE,FALSE);
2060             LOOPX(OP_DUMP);
2061
2062         case KEY_else:
2063             PREBLOCK(ELSE);
2064
2065         case KEY_elsif:
2066             yylval.ival = curcop->cop_line;
2067             OPERATOR(ELSIF);
2068
2069         case KEY_eq:
2070             Eop(OP_SEQ);
2071
2072         case KEY_exit:
2073             UNI(OP_EXIT);
2074
2075         case KEY_eval:
2076             s = skipspace(s);
2077             expect = (*s == '{') ? XBLOCK : XTERM;
2078             UNIBRACK(OP_ENTEREVAL);
2079
2080         case KEY_eof:
2081             UNI(OP_EOF);
2082
2083         case KEY_exp:
2084             UNI(OP_EXP);
2085
2086         case KEY_each:
2087             UNI(OP_EACH);
2088
2089         case KEY_exec:
2090             set_csh();
2091             LOP(OP_EXEC);
2092
2093         case KEY_endhostent:
2094             FUN0(OP_EHOSTENT);
2095
2096         case KEY_endnetent:
2097             FUN0(OP_ENETENT);
2098
2099         case KEY_endservent:
2100             FUN0(OP_ESERVENT);
2101
2102         case KEY_endprotoent:
2103             FUN0(OP_EPROTOENT);
2104
2105         case KEY_endpwent:
2106             FUN0(OP_EPWENT);
2107
2108         case KEY_endgrent:
2109             FUN0(OP_EGRENT);
2110
2111         case KEY_for:
2112         case KEY_foreach:
2113             yylval.ival = curcop->cop_line;
2114             while (s < bufend && isSPACE(*s))
2115                 s++;
2116             if (isIDFIRST(*s))
2117                 croak("Missing $ on loop variable");
2118             OPERATOR(FOR);
2119
2120         case KEY_formline:
2121             LOP(OP_FORMLINE);
2122
2123         case KEY_fork:
2124             FUN0(OP_FORK);
2125
2126         case KEY_fcntl:
2127             LOP(OP_FCNTL);
2128
2129         case KEY_fileno:
2130             UNI(OP_FILENO);
2131
2132         case KEY_flock:
2133             LOP(OP_FLOCK);
2134
2135         case KEY_gt:
2136             Rop(OP_SGT);
2137
2138         case KEY_ge:
2139             Rop(OP_SGE);
2140
2141         case KEY_grep:
2142             LOP(OP_GREPSTART);
2143
2144         case KEY_goto:
2145             s = force_word(s,WORD,TRUE,FALSE);
2146             LOOPX(OP_GOTO);
2147
2148         case KEY_gmtime:
2149             UNI(OP_GMTIME);
2150
2151         case KEY_getc:
2152             UNI(OP_GETC);
2153
2154         case KEY_getppid:
2155             FUN0(OP_GETPPID);
2156
2157         case KEY_getpgrp:
2158             UNI(OP_GETPGRP);
2159
2160         case KEY_getpriority:
2161             LOP(OP_GETPRIORITY);
2162
2163         case KEY_getprotobyname:
2164             UNI(OP_GPBYNAME);
2165
2166         case KEY_getprotobynumber:
2167             LOP(OP_GPBYNUMBER);
2168
2169         case KEY_getprotoent:
2170             FUN0(OP_GPROTOENT);
2171
2172         case KEY_getpwent:
2173             FUN0(OP_GPWENT);
2174
2175         case KEY_getpwnam:
2176             FUN1(OP_GPWNAM);
2177
2178         case KEY_getpwuid:
2179             FUN1(OP_GPWUID);
2180
2181         case KEY_getpeername:
2182             UNI(OP_GETPEERNAME);
2183
2184         case KEY_gethostbyname:
2185             UNI(OP_GHBYNAME);
2186
2187         case KEY_gethostbyaddr:
2188             LOP(OP_GHBYADDR);
2189
2190         case KEY_gethostent:
2191             FUN0(OP_GHOSTENT);
2192
2193         case KEY_getnetbyname:
2194             UNI(OP_GNBYNAME);
2195
2196         case KEY_getnetbyaddr:
2197             LOP(OP_GNBYADDR);
2198
2199         case KEY_getnetent:
2200             FUN0(OP_GNETENT);
2201
2202         case KEY_getservbyname:
2203             LOP(OP_GSBYNAME);
2204
2205         case KEY_getservbyport:
2206             LOP(OP_GSBYPORT);
2207
2208         case KEY_getservent:
2209             FUN0(OP_GSERVENT);
2210
2211         case KEY_getsockname:
2212             UNI(OP_GETSOCKNAME);
2213
2214         case KEY_getsockopt:
2215             LOP(OP_GSOCKOPT);
2216
2217         case KEY_getgrent:
2218             FUN0(OP_GGRENT);
2219
2220         case KEY_getgrnam:
2221             FUN1(OP_GGRNAM);
2222
2223         case KEY_getgrgid:
2224             FUN1(OP_GGRGID);
2225
2226         case KEY_getlogin:
2227             FUN0(OP_GETLOGIN);
2228
2229         case KEY_glob:
2230             UNI(OP_GLOB);
2231
2232         case KEY_hex:
2233             UNI(OP_HEX);
2234
2235         case KEY_if:
2236             yylval.ival = curcop->cop_line;
2237             OPERATOR(IF);
2238
2239         case KEY_index:
2240             LOP(OP_INDEX);
2241
2242         case KEY_int:
2243             UNI(OP_INT);
2244
2245         case KEY_ioctl:
2246             LOP(OP_IOCTL);
2247
2248         case KEY_join:
2249             LOP(OP_JOIN);
2250
2251         case KEY_keys:
2252             UNI(OP_KEYS);
2253
2254         case KEY_kill:
2255             LOP(OP_KILL);
2256
2257         case KEY_last:
2258             s = force_word(s,WORD,TRUE,FALSE);
2259             LOOPX(OP_LAST);
2260
2261         case KEY_lc:
2262             UNI(OP_LC);
2263
2264         case KEY_lcfirst:
2265             UNI(OP_LCFIRST);
2266
2267         case KEY_local:
2268             yylval.ival = 0;
2269             OPERATOR(LOCAL);
2270
2271         case KEY_length:
2272             UNI(OP_LENGTH);
2273
2274         case KEY_lt:
2275             Rop(OP_SLT);
2276
2277         case KEY_le:
2278             Rop(OP_SLE);
2279
2280         case KEY_localtime:
2281             UNI(OP_LOCALTIME);
2282
2283         case KEY_log:
2284             UNI(OP_LOG);
2285
2286         case KEY_link:
2287             LOP(OP_LINK);
2288
2289         case KEY_listen:
2290             LOP(OP_LISTEN);
2291
2292         case KEY_lstat:
2293             UNI(OP_LSTAT);
2294
2295         case KEY_m:
2296             s = scan_pat(s);
2297             TERM(sublex_start());
2298
2299         case KEY_mkdir:
2300             LOP(OP_MKDIR);
2301
2302         case KEY_msgctl:
2303             LOP(OP_MSGCTL);
2304
2305         case KEY_msgget:
2306             LOP(OP_MSGGET);
2307
2308         case KEY_msgrcv:
2309             LOP(OP_MSGRCV);
2310
2311         case KEY_msgsnd:
2312             LOP(OP_MSGSND);
2313
2314         case KEY_my:
2315             in_my = TRUE;
2316             yylval.ival = 1;
2317             OPERATOR(LOCAL);
2318
2319         case KEY_next:
2320             s = force_word(s,WORD,TRUE,FALSE);
2321             LOOPX(OP_NEXT);
2322
2323         case KEY_ne:
2324             Eop(OP_SNE);
2325
2326         case KEY_open:
2327             s = skipspace(s);
2328             if (isIDFIRST(*s)) {
2329                 char *t;
2330                 for (d = s; isALNUM(*d); d++) ;
2331                 t = skipspace(d);
2332                 if (strchr("|&*+-=!?:.", *t))
2333                     warn("Precedence problem: open %.*s should be open(%.*s)",
2334                         d-s,s, d-s,s);
2335             }
2336             LOP(OP_OPEN);
2337
2338         case KEY_or:
2339             OPERATOR(OROP);
2340
2341         case KEY_ord:
2342             UNI(OP_ORD);
2343
2344         case KEY_oct:
2345             UNI(OP_OCT);
2346
2347         case KEY_opendir:
2348             LOP(OP_OPEN_DIR);
2349
2350         case KEY_print:
2351             checkcomma(s,tokenbuf,"filehandle");
2352             LOP(OP_PRINT);
2353
2354         case KEY_printf:
2355             checkcomma(s,tokenbuf,"filehandle");
2356             LOP(OP_PRTF);
2357
2358         case KEY_push:
2359             LOP(OP_PUSH);
2360
2361         case KEY_pop:
2362             UNI(OP_POP);
2363
2364         case KEY_pack:
2365             LOP(OP_PACK);
2366
2367         case KEY_package:
2368             s = force_word(s,WORD,FALSE,TRUE);
2369             OPERATOR(PACKAGE);
2370
2371         case KEY_pipe:
2372             LOP(OP_PIPE_OP);
2373
2374         case KEY_q:
2375             s = scan_str(s);
2376             if (!s)
2377                 missingterm(0);
2378             yylval.ival = OP_CONST;
2379             TERM(sublex_start());
2380
2381         case KEY_qw:
2382             s = scan_str(s);
2383             if (!s)
2384                 missingterm(0);
2385             force_next(')');
2386             nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, q(lex_stuff));
2387             lex_stuff = Nullsv;
2388             force_next(THING);
2389             force_next(',');
2390             nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(" ",1));
2391             force_next(THING);
2392             force_next('(');
2393             LOP(OP_SPLIT);
2394
2395         case KEY_qq:
2396             s = scan_str(s);
2397             if (!s)
2398                 missingterm(0);
2399             yylval.ival = OP_SCALAR;
2400             if (SvIVX(lex_stuff) == '\'')
2401                 SvIVX(lex_stuff) = 0;   /* qq'$foo' should intepolate */
2402             TERM(sublex_start());
2403
2404         case KEY_qx:
2405             s = scan_str(s);
2406             if (!s)
2407                 missingterm(0);
2408             yylval.ival = OP_BACKTICK;
2409             set_csh();
2410             TERM(sublex_start());
2411
2412         case KEY_return:
2413             OLDLOP(OP_RETURN);
2414
2415         case KEY_require:
2416             s = force_word(s,WORD,TRUE,FALSE);
2417             UNI(OP_REQUIRE);
2418
2419         case KEY_reset:
2420             UNI(OP_RESET);
2421
2422         case KEY_redo:
2423             s = force_word(s,WORD,TRUE,FALSE);
2424             LOOPX(OP_REDO);
2425
2426         case KEY_rename:
2427             LOP(OP_RENAME);
2428
2429         case KEY_rand:
2430             UNI(OP_RAND);
2431
2432         case KEY_rmdir:
2433             UNI(OP_RMDIR);
2434
2435         case KEY_rindex:
2436             LOP(OP_RINDEX);
2437
2438         case KEY_read:
2439             LOP(OP_READ);
2440
2441         case KEY_readdir:
2442             UNI(OP_READDIR);
2443
2444         case KEY_readline:
2445             set_csh();
2446             UNI(OP_READLINE);
2447
2448         case KEY_readpipe:
2449             set_csh();
2450             UNI(OP_BACKTICK);
2451
2452         case KEY_rewinddir:
2453             UNI(OP_REWINDDIR);
2454
2455         case KEY_recv:
2456             LOP(OP_RECV);
2457
2458         case KEY_reverse:
2459             LOP(OP_REVERSE);
2460
2461         case KEY_readlink:
2462             UNI(OP_READLINK);
2463
2464         case KEY_ref:
2465             UNI(OP_REF);
2466
2467         case KEY_s:
2468             s = scan_subst(s);
2469             if (yylval.opval)
2470                 TERM(sublex_start());
2471             else
2472                 TOKEN(1);       /* force error */
2473
2474         case KEY_scalar:
2475             UNI(OP_SCALAR);
2476
2477         case KEY_select:
2478             LOP(OP_SELECT);
2479
2480         case KEY_seek:
2481             LOP(OP_SEEK);
2482
2483         case KEY_semctl:
2484             LOP(OP_SEMCTL);
2485
2486         case KEY_semget:
2487             LOP(OP_SEMGET);
2488
2489         case KEY_semop:
2490             LOP(OP_SEMOP);
2491
2492         case KEY_send:
2493             LOP(OP_SEND);
2494
2495         case KEY_setpgrp:
2496             LOP(OP_SETPGRP);
2497
2498         case KEY_setpriority:
2499             LOP(OP_SETPRIORITY);
2500
2501         case KEY_sethostent:
2502             FUN1(OP_SHOSTENT);
2503
2504         case KEY_setnetent:
2505             FUN1(OP_SNETENT);
2506
2507         case KEY_setservent:
2508             FUN1(OP_SSERVENT);
2509
2510         case KEY_setprotoent:
2511             FUN1(OP_SPROTOENT);
2512
2513         case KEY_setpwent:
2514             FUN0(OP_SPWENT);
2515
2516         case KEY_setgrent:
2517             FUN0(OP_SGRENT);
2518
2519         case KEY_seekdir:
2520             LOP(OP_SEEKDIR);
2521
2522         case KEY_setsockopt:
2523             LOP(OP_SSOCKOPT);
2524
2525         case KEY_shift:
2526             UNI(OP_SHIFT);
2527
2528         case KEY_shmctl:
2529             LOP(OP_SHMCTL);
2530
2531         case KEY_shmget:
2532             LOP(OP_SHMGET);
2533
2534         case KEY_shmread:
2535             LOP(OP_SHMREAD);
2536
2537         case KEY_shmwrite:
2538             LOP(OP_SHMWRITE);
2539
2540         case KEY_shutdown:
2541             LOP(OP_SHUTDOWN);
2542
2543         case KEY_sin:
2544             UNI(OP_SIN);
2545
2546         case KEY_sleep:
2547             UNI(OP_SLEEP);
2548
2549         case KEY_socket:
2550             LOP(OP_SOCKET);
2551
2552         case KEY_socketpair:
2553             LOP(OP_SOCKPAIR);
2554
2555         case KEY_sort:
2556             checkcomma(s,tokenbuf,"subroutine name");
2557             s = skipspace(s);
2558             if (*s == ';' || *s == ')')         /* probably a close */
2559                 croak("sort is now a reserved word");
2560             expect = XTERM;
2561             s = force_word(s,WORD,TRUE,TRUE);
2562             LOP(OP_SORT);
2563
2564         case KEY_split:
2565             LOP(OP_SPLIT);
2566
2567         case KEY_sprintf:
2568             LOP(OP_SPRINTF);
2569
2570         case KEY_splice:
2571             LOP(OP_SPLICE);
2572
2573         case KEY_sqrt:
2574             UNI(OP_SQRT);
2575
2576         case KEY_srand:
2577             UNI(OP_SRAND);
2578
2579         case KEY_stat:
2580             UNI(OP_STAT);
2581
2582         case KEY_study:
2583             sawstudy++;
2584             UNI(OP_STUDY);
2585
2586         case KEY_substr:
2587             LOP(OP_SUBSTR);
2588
2589         case KEY_format:
2590         case KEY_sub:
2591           really_sub:
2592             yylval.ival = start_subparse();
2593             s = skipspace(s);
2594             if (tmp == KEY_format)
2595                 expect = XTERM;
2596             else
2597                 expect = XBLOCK;
2598             if (isIDFIRST(*s) || *s == '\'' || *s == ':') {
2599                 char tmpbuf[128];
2600                 d = scan_word(s, tmpbuf, TRUE, &len);
2601                 if (strchr(tmpbuf, ':'))
2602                     sv_setpv(subname, tmpbuf);
2603                 else {
2604                     sv_setsv(subname,curstname);
2605                     sv_catpvn(subname,"::",2);
2606                     sv_catpvn(subname,tmpbuf,len);
2607                 }
2608                 s = force_word(s,WORD,FALSE,TRUE);
2609             }
2610             else
2611                 sv_setpv(subname,"?");
2612
2613             if (tmp != KEY_format)
2614                 PREBLOCK(SUB);
2615
2616             in_format = 2;
2617             lex_brackets = 0;
2618             OPERATOR(FORMAT);
2619
2620         case KEY_system:
2621             set_csh();
2622             LOP(OP_SYSTEM);
2623
2624         case KEY_symlink:
2625             LOP(OP_SYMLINK);
2626
2627         case KEY_syscall:
2628             LOP(OP_SYSCALL);
2629
2630         case KEY_sysread:
2631             LOP(OP_SYSREAD);
2632
2633         case KEY_syswrite:
2634             LOP(OP_SYSWRITE);
2635
2636         case KEY_tr:
2637             s = scan_trans(s);
2638             TERM(sublex_start());
2639
2640         case KEY_tell:
2641             UNI(OP_TELL);
2642
2643         case KEY_telldir:
2644             UNI(OP_TELLDIR);
2645
2646         case KEY_tie:
2647             LOP(OP_TIE);
2648
2649         case KEY_time:
2650             FUN0(OP_TIME);
2651
2652         case KEY_times:
2653             FUN0(OP_TMS);
2654
2655         case KEY_truncate:
2656             LOP(OP_TRUNCATE);
2657
2658         case KEY_uc:
2659             UNI(OP_UC);
2660
2661         case KEY_ucfirst:
2662             UNI(OP_UCFIRST);
2663
2664         case KEY_untie:
2665             UNI(OP_UNTIE);
2666
2667         case KEY_until:
2668             yylval.ival = curcop->cop_line;
2669             OPERATOR(UNTIL);
2670
2671         case KEY_unless:
2672             yylval.ival = curcop->cop_line;
2673             OPERATOR(UNLESS);
2674
2675         case KEY_unlink:
2676             LOP(OP_UNLINK);
2677
2678         case KEY_undef:
2679             UNI(OP_UNDEF);
2680
2681         case KEY_unpack:
2682             LOP(OP_UNPACK);
2683
2684         case KEY_utime:
2685             LOP(OP_UTIME);
2686
2687         case KEY_umask:
2688             s = skipspace(s);
2689             if (dowarn && *s != '0' && isDIGIT(*s))
2690                 warn("umask: argument is missing initial 0");
2691             UNI(OP_UMASK);
2692
2693         case KEY_unshift:
2694             LOP(OP_UNSHIFT);
2695
2696         case KEY_values:
2697             UNI(OP_VALUES);
2698
2699         case KEY_vec:
2700             sawvec = TRUE;
2701             LOP(OP_VEC);
2702
2703         case KEY_while:
2704             yylval.ival = curcop->cop_line;
2705             OPERATOR(WHILE);
2706
2707         case KEY_warn:
2708             LOP(OP_WARN);
2709
2710         case KEY_wait:
2711             FUN0(OP_WAIT);
2712
2713         case KEY_waitpid:
2714             LOP(OP_WAITPID);
2715
2716         case KEY_wantarray:
2717             FUN0(OP_WANTARRAY);
2718
2719         case KEY_write:
2720             UNI(OP_ENTERWRITE);
2721
2722         case KEY_x:
2723             if (expect == XOPERATOR)
2724                 Mop(OP_REPEAT);
2725             check_uni();
2726             goto just_a_word;
2727
2728         case KEY_y:
2729             s = scan_trans(s);
2730             TERM(sublex_start());
2731         }
2732     }
2733 }
2734
2735 I32
2736 keyword(d, len)
2737 register char *d;
2738 I32 len;
2739 {
2740     switch (*d) {
2741     case '_':
2742         if (d[1] == '_') {
2743             if (strEQ(d,"__LINE__"))            return KEY___LINE__;
2744             if (strEQ(d,"__FILE__"))            return KEY___FILE__;
2745             if (strEQ(d,"__END__"))             return KEY___END__;
2746         }
2747         break;
2748     case 'A':
2749         if (strEQ(d,"AUTOLOAD"))                return KEY_AUTOLOAD;
2750         break;
2751     case 'a':
2752         switch (len) {
2753         case 3:
2754             if (strEQ(d,"and"))                 return KEY_and;
2755             if (strEQ(d,"abs"))                 return KEY_abs;
2756             break;
2757         case 5:
2758             if (strEQ(d,"alarm"))               return KEY_alarm;
2759             if (strEQ(d,"atan2"))               return KEY_atan2;
2760             break;
2761         case 6:
2762             if (strEQ(d,"accept"))              return KEY_accept;
2763             break;
2764         }
2765         break;
2766     case 'B':
2767         if (strEQ(d,"BEGIN"))                   return KEY_BEGIN;
2768         break;
2769     case 'b':
2770         if (strEQ(d,"bless"))                   return KEY_bless;
2771         if (strEQ(d,"bind"))                    return KEY_bind;
2772         if (strEQ(d,"binmode"))                 return KEY_binmode;
2773         break;
2774     case 'c':
2775         switch (len) {
2776         case 3:
2777             if (strEQ(d,"cmp"))                 return KEY_cmp;
2778             if (strEQ(d,"chr"))                 return KEY_chr;
2779             if (strEQ(d,"cos"))                 return KEY_cos;
2780             break;
2781         case 4:
2782             if (strEQ(d,"chop"))                return KEY_chop;
2783             break;
2784         case 5:
2785             if (strEQ(d,"close"))               return KEY_close;
2786             if (strEQ(d,"chdir"))               return KEY_chdir;
2787             if (strEQ(d,"chmod"))               return KEY_chmod;
2788             if (strEQ(d,"chown"))               return KEY_chown;
2789             if (strEQ(d,"crypt"))               return KEY_crypt;
2790             break;
2791         case 6:
2792             if (strEQ(d,"chroot"))              return KEY_chroot;
2793             if (strEQ(d,"caller"))              return KEY_caller;
2794             break;
2795         case 7:
2796             if (strEQ(d,"connect"))             return KEY_connect;
2797             break;
2798         case 8:
2799             if (strEQ(d,"closedir"))            return KEY_closedir;
2800             if (strEQ(d,"continue"))            return KEY_continue;
2801             break;
2802         }
2803         break;
2804     case 'D':
2805         if (strEQ(d,"DESTROY"))                 return KEY_DESTROY;
2806         break;
2807     case 'd':
2808         switch (len) {
2809         case 2:
2810             if (strEQ(d,"do"))                  return KEY_do;
2811             break;
2812         case 3:
2813             if (strEQ(d,"die"))                 return KEY_die;
2814             break;
2815         case 4:
2816             if (strEQ(d,"dump"))                return KEY_dump;
2817             break;
2818         case 6:
2819             if (strEQ(d,"delete"))              return KEY_delete;
2820             break;
2821         case 7:
2822             if (strEQ(d,"defined"))             return KEY_defined;
2823             if (strEQ(d,"dbmopen"))             return KEY_dbmopen;
2824             break;
2825         case 8:
2826             if (strEQ(d,"dbmclose"))            return KEY_dbmclose;
2827             break;
2828         }
2829         break;
2830     case 'E':
2831         if (strEQ(d,"EQ"))                      return KEY_eq;
2832         if (strEQ(d,"END"))                     return KEY_END;
2833         break;
2834     case 'e':
2835         switch (len) {
2836         case 2:
2837             if (strEQ(d,"eq"))                  return KEY_eq;
2838             break;
2839         case 3:
2840             if (strEQ(d,"eof"))                 return KEY_eof;
2841             if (strEQ(d,"exp"))                 return KEY_exp;
2842             break;
2843         case 4:
2844             if (strEQ(d,"else"))                return KEY_else;
2845             if (strEQ(d,"exit"))                return KEY_exit;
2846             if (strEQ(d,"eval"))                return KEY_eval;
2847             if (strEQ(d,"exec"))                return KEY_exec;
2848             if (strEQ(d,"each"))                return KEY_each;
2849             break;
2850         case 5:
2851             if (strEQ(d,"elsif"))               return KEY_elsif;
2852             break;
2853         case 8:
2854             if (strEQ(d,"endgrent"))            return KEY_endgrent;
2855             if (strEQ(d,"endpwent"))            return KEY_endpwent;
2856             break;
2857         case 9:
2858             if (strEQ(d,"endnetent"))           return KEY_endnetent;
2859             break;
2860         case 10:
2861             if (strEQ(d,"endhostent"))          return KEY_endhostent;
2862             if (strEQ(d,"endservent"))          return KEY_endservent;
2863             break;
2864         case 11:
2865             if (strEQ(d,"endprotoent"))         return KEY_endprotoent;
2866             break;
2867         }
2868         break;
2869     case 'f':
2870         switch (len) {
2871         case 3:
2872             if (strEQ(d,"for"))                 return KEY_for;
2873             break;
2874         case 4:
2875             if (strEQ(d,"fork"))                return KEY_fork;
2876             break;
2877         case 5:
2878             if (strEQ(d,"fcntl"))               return KEY_fcntl;
2879             if (strEQ(d,"flock"))               return KEY_flock;
2880             break;
2881         case 6:
2882             if (strEQ(d,"format"))              return KEY_format;
2883             if (strEQ(d,"fileno"))              return KEY_fileno;
2884             break;
2885         case 7:
2886             if (strEQ(d,"foreach"))             return KEY_foreach;
2887             break;
2888         case 8:
2889             if (strEQ(d,"formline"))            return KEY_formline;
2890             break;
2891         }
2892         break;
2893     case 'G':
2894         if (len == 2) {
2895             if (strEQ(d,"GT"))                  return KEY_gt;
2896             if (strEQ(d,"GE"))                  return KEY_ge;
2897         }
2898         break;
2899     case 'g':
2900         if (strnEQ(d,"get",3)) {
2901             d += 3;
2902             if (*d == 'p') {
2903                 switch (len) {
2904                 case 7:
2905                     if (strEQ(d,"ppid"))        return KEY_getppid;
2906                     if (strEQ(d,"pgrp"))        return KEY_getpgrp;
2907                     break;
2908                 case 8:
2909                     if (strEQ(d,"pwent"))       return KEY_getpwent;
2910                     if (strEQ(d,"pwnam"))       return KEY_getpwnam;
2911                     if (strEQ(d,"pwuid"))       return KEY_getpwuid;
2912                     break;
2913                 case 11:
2914                     if (strEQ(d,"peername"))    return KEY_getpeername;
2915                     if (strEQ(d,"protoent"))    return KEY_getprotoent;
2916                     if (strEQ(d,"priority"))    return KEY_getpriority;
2917                     break;
2918                 case 14:
2919                     if (strEQ(d,"protobyname")) return KEY_getprotobyname;
2920                     break;
2921                 case 16:
2922                     if (strEQ(d,"protobynumber"))return KEY_getprotobynumber;
2923                     break;
2924                 }
2925             }
2926             else if (*d == 'h') {
2927                 if (strEQ(d,"hostbyname"))      return KEY_gethostbyname;
2928                 if (strEQ(d,"hostbyaddr"))      return KEY_gethostbyaddr;
2929                 if (strEQ(d,"hostent"))         return KEY_gethostent;
2930             }
2931             else if (*d == 'n') {
2932                 if (strEQ(d,"netbyname"))       return KEY_getnetbyname;
2933                 if (strEQ(d,"netbyaddr"))       return KEY_getnetbyaddr;
2934                 if (strEQ(d,"netent"))          return KEY_getnetent;
2935             }
2936             else if (*d == 's') {
2937                 if (strEQ(d,"servbyname"))      return KEY_getservbyname;
2938                 if (strEQ(d,"servbyport"))      return KEY_getservbyport;
2939                 if (strEQ(d,"servent"))         return KEY_getservent;
2940                 if (strEQ(d,"sockname"))        return KEY_getsockname;
2941                 if (strEQ(d,"sockopt"))         return KEY_getsockopt;
2942             }
2943             else if (*d == 'g') {
2944                 if (strEQ(d,"grent"))           return KEY_getgrent;
2945                 if (strEQ(d,"grnam"))           return KEY_getgrnam;
2946                 if (strEQ(d,"grgid"))           return KEY_getgrgid;
2947             }
2948             else if (*d == 'l') {
2949                 if (strEQ(d,"login"))           return KEY_getlogin;
2950             }
2951             else if (strEQ(d,"c"))              return KEY_getc;
2952             break;
2953         }
2954         switch (len) {
2955         case 2:
2956             if (strEQ(d,"gt"))                  return KEY_gt;
2957             if (strEQ(d,"ge"))                  return KEY_ge;
2958             break;
2959         case 4:
2960             if (strEQ(d,"grep"))                return KEY_grep;
2961             if (strEQ(d,"goto"))                return KEY_goto;
2962             if (strEQ(d,"glob"))                return KEY_glob;
2963             break;
2964         case 6:
2965             if (strEQ(d,"gmtime"))              return KEY_gmtime;
2966             break;
2967         }
2968         break;
2969     case 'h':
2970         if (strEQ(d,"hex"))                     return KEY_hex;
2971         break;
2972     case 'i':
2973         switch (len) {
2974         case 2:
2975             if (strEQ(d,"if"))                  return KEY_if;
2976             break;
2977         case 3:
2978             if (strEQ(d,"int"))                 return KEY_int;
2979             break;
2980         case 5:
2981             if (strEQ(d,"index"))               return KEY_index;
2982             if (strEQ(d,"ioctl"))               return KEY_ioctl;
2983             break;
2984         }
2985         break;
2986     case 'j':
2987         if (strEQ(d,"join"))                    return KEY_join;
2988         break;
2989     case 'k':
2990         if (len == 4) {
2991             if (strEQ(d,"keys"))                return KEY_keys;
2992             if (strEQ(d,"kill"))                return KEY_kill;
2993         }
2994         break;
2995     case 'L':
2996         if (len == 2) {
2997             if (strEQ(d,"LT"))                  return KEY_lt;
2998             if (strEQ(d,"LE"))                  return KEY_le;
2999         }
3000         break;
3001     case 'l':
3002         switch (len) {
3003         case 2:
3004             if (strEQ(d,"lt"))                  return KEY_lt;
3005             if (strEQ(d,"le"))                  return KEY_le;
3006             if (strEQ(d,"lc"))                  return KEY_lc;
3007             break;
3008         case 3:
3009             if (strEQ(d,"log"))                 return KEY_log;
3010             break;
3011         case 4:
3012             if (strEQ(d,"last"))                return KEY_last;
3013             if (strEQ(d,"link"))                return KEY_link;
3014             break;
3015         case 5:
3016             if (strEQ(d,"local"))               return KEY_local;
3017             if (strEQ(d,"lstat"))               return KEY_lstat;
3018             break;
3019         case 6:
3020             if (strEQ(d,"length"))              return KEY_length;
3021             if (strEQ(d,"listen"))              return KEY_listen;
3022             break;
3023         case 7:
3024             if (strEQ(d,"lcfirst"))             return KEY_lcfirst;
3025             break;
3026         case 9:
3027             if (strEQ(d,"localtime"))           return KEY_localtime;
3028             break;
3029         }
3030         break;
3031     case 'm':
3032         switch (len) {
3033         case 1:                                 return KEY_m;
3034         case 2:
3035             if (strEQ(d,"my"))                  return KEY_my;
3036             break;
3037         case 5:
3038             if (strEQ(d,"mkdir"))               return KEY_mkdir;
3039             break;
3040         case 6:
3041             if (strEQ(d,"msgctl"))              return KEY_msgctl;
3042             if (strEQ(d,"msgget"))              return KEY_msgget;
3043             if (strEQ(d,"msgrcv"))              return KEY_msgrcv;
3044             if (strEQ(d,"msgsnd"))              return KEY_msgsnd;
3045             break;
3046         }
3047         break;
3048     case 'N':
3049         if (strEQ(d,"NE"))                      return KEY_ne;
3050         break;
3051     case 'n':
3052         if (strEQ(d,"next"))                    return KEY_next;
3053         if (strEQ(d,"ne"))                      return KEY_ne;
3054         break;
3055     case 'o':
3056         switch (len) {
3057         case 2:
3058             if (strEQ(d,"or"))                  return KEY_or;
3059             break;
3060         case 3:
3061             if (strEQ(d,"ord"))                 return KEY_ord;
3062             if (strEQ(d,"oct"))                 return KEY_oct;
3063             break;
3064         case 4:
3065             if (strEQ(d,"open"))                return KEY_open;
3066             break;
3067         case 7:
3068             if (strEQ(d,"opendir"))             return KEY_opendir;
3069             break;
3070         }
3071         break;
3072     case 'p':
3073         switch (len) {
3074         case 3:
3075             if (strEQ(d,"pop"))                 return KEY_pop;
3076             break;
3077         case 4:
3078             if (strEQ(d,"push"))                return KEY_push;
3079             if (strEQ(d,"pack"))                return KEY_pack;
3080             if (strEQ(d,"pipe"))                return KEY_pipe;
3081             break;
3082         case 5:
3083             if (strEQ(d,"print"))               return KEY_print;
3084             break;
3085         case 6:
3086             if (strEQ(d,"printf"))              return KEY_printf;
3087             break;
3088         case 7:
3089             if (strEQ(d,"package"))             return KEY_package;
3090             break;
3091         }
3092         break;
3093     case 'q':
3094         if (len <= 2) {
3095             if (strEQ(d,"q"))                   return KEY_q;
3096             if (strEQ(d,"qq"))                  return KEY_qq;
3097             if (strEQ(d,"qw"))                  return KEY_qw;
3098             if (strEQ(d,"qx"))                  return KEY_qx;
3099         }
3100         break;
3101     case 'r':
3102         switch (len) {
3103         case 3:
3104             if (strEQ(d,"ref"))                 return KEY_ref;
3105             break;
3106         case 4:
3107             if (strEQ(d,"read"))                return KEY_read;
3108             if (strEQ(d,"rand"))                return KEY_rand;
3109             if (strEQ(d,"recv"))                return KEY_recv;
3110             if (strEQ(d,"redo"))                return KEY_redo;
3111             break;
3112         case 5:
3113             if (strEQ(d,"rmdir"))               return KEY_rmdir;
3114             if (strEQ(d,"reset"))               return KEY_reset;
3115             break;
3116         case 6:
3117             if (strEQ(d,"return"))              return KEY_return;
3118             if (strEQ(d,"rename"))              return KEY_rename;
3119             if (strEQ(d,"rindex"))              return KEY_rindex;
3120             break;
3121         case 7:
3122             if (strEQ(d,"require"))             return KEY_require;
3123             if (strEQ(d,"reverse"))             return KEY_reverse;
3124             if (strEQ(d,"readdir"))             return KEY_readdir;
3125             break;
3126         case 8:
3127             if (strEQ(d,"readlink"))            return KEY_readlink;
3128             if (strEQ(d,"readline"))            return KEY_readline;
3129             if (strEQ(d,"readpipe"))            return KEY_readpipe;
3130             break;
3131         case 9:
3132             if (strEQ(d,"rewinddir"))           return KEY_rewinddir;
3133             break;
3134         }
3135         break;
3136     case 's':
3137         switch (d[1]) {
3138         case 0:                                 return KEY_s;
3139         case 'c':
3140             if (strEQ(d,"scalar"))              return KEY_scalar;
3141             break;
3142         case 'e':
3143             switch (len) {
3144             case 4:
3145                 if (strEQ(d,"seek"))            return KEY_seek;
3146                 if (strEQ(d,"send"))            return KEY_send;
3147                 break;
3148             case 5:
3149                 if (strEQ(d,"semop"))           return KEY_semop;
3150                 break;
3151             case 6:
3152                 if (strEQ(d,"select"))          return KEY_select;
3153                 if (strEQ(d,"semctl"))          return KEY_semctl;
3154                 if (strEQ(d,"semget"))          return KEY_semget;
3155                 break;
3156             case 7:
3157                 if (strEQ(d,"setpgrp"))         return KEY_setpgrp;
3158                 if (strEQ(d,"seekdir"))         return KEY_seekdir;
3159                 break;
3160             case 8:
3161                 if (strEQ(d,"setpwent"))        return KEY_setpwent;
3162                 if (strEQ(d,"setgrent"))        return KEY_setgrent;
3163                 break;
3164             case 9:
3165                 if (strEQ(d,"setnetent"))       return KEY_setnetent;
3166                 break;
3167             case 10:
3168                 if (strEQ(d,"setsockopt"))      return KEY_setsockopt;
3169                 if (strEQ(d,"sethostent"))      return KEY_sethostent;
3170                 if (strEQ(d,"setservent"))      return KEY_setservent;
3171                 break;
3172             case 11:
3173                 if (strEQ(d,"setpriority"))     return KEY_setpriority;
3174                 if (strEQ(d,"setprotoent"))     return KEY_setprotoent;
3175                 break;
3176             }
3177             break;
3178         case 'h':
3179             switch (len) {
3180             case 5:
3181                 if (strEQ(d,"shift"))           return KEY_shift;
3182                 break;
3183             case 6:
3184                 if (strEQ(d,"shmctl"))          return KEY_shmctl;
3185                 if (strEQ(d,"shmget"))          return KEY_shmget;
3186                 break;
3187             case 7:
3188                 if (strEQ(d,"shmread"))         return KEY_shmread;
3189                 break;
3190             case 8:
3191                 if (strEQ(d,"shmwrite"))        return KEY_shmwrite;
3192                 if (strEQ(d,"shutdown"))        return KEY_shutdown;
3193                 break;
3194             }
3195             break;
3196         case 'i':
3197             if (strEQ(d,"sin"))                 return KEY_sin;
3198             break;
3199         case 'l':
3200             if (strEQ(d,"sleep"))               return KEY_sleep;
3201             break;
3202         case 'o':
3203             if (strEQ(d,"sort"))                return KEY_sort;
3204             if (strEQ(d,"socket"))              return KEY_socket;
3205             if (strEQ(d,"socketpair"))          return KEY_socketpair;
3206             break;
3207         case 'p':
3208             if (strEQ(d,"split"))               return KEY_split;
3209             if (strEQ(d,"sprintf"))             return KEY_sprintf;
3210             if (strEQ(d,"splice"))              return KEY_splice;
3211             break;
3212         case 'q':
3213             if (strEQ(d,"sqrt"))                return KEY_sqrt;
3214             break;
3215         case 'r':
3216             if (strEQ(d,"srand"))               return KEY_srand;
3217             break;
3218         case 't':
3219             if (strEQ(d,"stat"))                return KEY_stat;
3220             if (strEQ(d,"study"))               return KEY_study;
3221             break;
3222         case 'u':
3223             if (strEQ(d,"substr"))              return KEY_substr;
3224             if (strEQ(d,"sub"))                 return KEY_sub;
3225             break;
3226         case 'y':
3227             switch (len) {
3228             case 6:
3229                 if (strEQ(d,"system"))          return KEY_system;
3230                 break;
3231             case 7:
3232                 if (strEQ(d,"sysread"))         return KEY_sysread;
3233                 if (strEQ(d,"symlink"))         return KEY_symlink;
3234                 if (strEQ(d,"syscall"))         return KEY_syscall;
3235                 break;
3236             case 8:
3237                 if (strEQ(d,"syswrite"))        return KEY_syswrite;
3238                 break;
3239             }
3240             break;
3241         }
3242         break;
3243     case 't':
3244         switch (len) {
3245         case 2:
3246             if (strEQ(d,"tr"))                  return KEY_tr;
3247             break;
3248         case 3:
3249             if (strEQ(d,"tie"))                 return KEY_tie;
3250             break;
3251         case 4:
3252             if (strEQ(d,"tell"))                return KEY_tell;
3253             if (strEQ(d,"time"))                return KEY_time;
3254             break;
3255         case 5:
3256             if (strEQ(d,"times"))               return KEY_times;
3257             break;
3258         case 7:
3259             if (strEQ(d,"telldir"))             return KEY_telldir;
3260             break;
3261         case 8:
3262             if (strEQ(d,"truncate"))            return KEY_truncate;
3263             break;
3264         }
3265         break;
3266     case 'u':
3267         switch (len) {
3268         case 2:
3269             if (strEQ(d,"uc"))                  return KEY_uc;
3270             break;
3271         case 5:
3272             if (strEQ(d,"undef"))               return KEY_undef;
3273             if (strEQ(d,"until"))               return KEY_until;
3274             if (strEQ(d,"untie"))               return KEY_untie;
3275             if (strEQ(d,"utime"))               return KEY_utime;
3276             if (strEQ(d,"umask"))               return KEY_umask;
3277             break;
3278         case 6:
3279             if (strEQ(d,"unless"))              return KEY_unless;
3280             if (strEQ(d,"unpack"))              return KEY_unpack;
3281             if (strEQ(d,"unlink"))              return KEY_unlink;
3282             break;
3283         case 7:
3284             if (strEQ(d,"unshift"))             return KEY_unshift;
3285             if (strEQ(d,"ucfirst"))             return KEY_ucfirst;
3286             break;
3287         }
3288         break;
3289     case 'v':
3290         if (strEQ(d,"values"))                  return KEY_values;
3291         if (strEQ(d,"vec"))                     return KEY_vec;
3292         break;
3293     case 'w':
3294         switch (len) {
3295         case 4:
3296             if (strEQ(d,"warn"))                return KEY_warn;
3297             if (strEQ(d,"wait"))                return KEY_wait;
3298             break;
3299         case 5:
3300             if (strEQ(d,"while"))               return KEY_while;
3301             if (strEQ(d,"write"))               return KEY_write;
3302             break;
3303         case 7:
3304             if (strEQ(d,"waitpid"))             return KEY_waitpid;
3305             break;
3306         case 9:
3307             if (strEQ(d,"wantarray"))           return KEY_wantarray;
3308             break;
3309         }
3310         break;
3311     case 'x':
3312         if (len == 1)                           return KEY_x;
3313         break;
3314     case 'y':
3315         if (len == 1)                           return KEY_y;
3316         break;
3317     case 'z':
3318         break;
3319     }
3320     return 0;
3321 }
3322
3323 static void
3324 checkcomma(s,name,what)
3325 register char *s;
3326 char *name;
3327 char *what;
3328 {
3329     char *w;
3330
3331     if (dowarn && *s == ' ' && s[1] == '(') {   /* XXX gotta be a better way */
3332         w = strchr(s,')');
3333         if (w)
3334             for (w++; *w && isSPACE(*w); w++) ;
3335         if (!w || !*w || !strchr(";|}", *w))    /* an advisory hack only... */
3336             warn("%s (...) interpreted as function",name);
3337     }
3338     while (s < bufend && isSPACE(*s))
3339         s++;
3340     if (*s == '(')
3341         s++;
3342     while (s < bufend && isSPACE(*s))
3343         s++;
3344     if (isIDFIRST(*s)) {
3345         w = s++;
3346         while (isALNUM(*s))
3347             s++;
3348         while (s < bufend && isSPACE(*s))
3349             s++;
3350         if (*s == ',') {
3351             int kw;
3352             *s = '\0';
3353             kw = keyword(w, s - w);
3354             *s = ',';
3355             if (kw)
3356                 return;
3357             croak("No comma allowed after %s", what);
3358         }
3359     }
3360 }
3361
3362 static char *
3363 scan_word(s, dest, allow_package, slp)
3364 register char *s;
3365 char *dest;
3366 int allow_package;
3367 STRLEN *slp;
3368 {
3369     register char *d = dest;
3370     for (;;) {
3371         if (isALNUM(*s))
3372             *d++ = *s++;
3373         else if (*s == '\'' && allow_package && isIDFIRST(s[1])) {
3374             *d++ = ':';
3375             *d++ = ':';
3376             s++;
3377         }
3378         else if (*s == ':' && s[1] == ':' && allow_package && isIDFIRST(s[2])) {
3379             *d++ = *s++;
3380             *d++ = *s++;
3381         }
3382         else {
3383             *d = '\0';
3384             *slp = d - dest;
3385             return s;
3386         }
3387     }
3388 }
3389
3390 static char *
3391 scan_ident(s,send,dest,ck_uni)
3392 register char *s;
3393 register char *send;
3394 char *dest;
3395 I32 ck_uni;
3396 {
3397     register char *d;
3398     char *bracket = 0;
3399
3400     if (lex_brackets == 0)
3401         lex_fakebrack = 0;
3402     s++;
3403     d = dest;
3404     if (isDIGIT(*s)) {
3405         while (isDIGIT(*s))
3406             *d++ = *s++;
3407     }
3408     else {
3409         for (;;) {
3410             if (isALNUM(*s))
3411                 *d++ = *s++;
3412             else if (*s == '\'' && isIDFIRST(s[1])) {
3413                 *d++ = ':';
3414                 *d++ = ':';
3415                 s++;
3416             }
3417             else if (*s == ':' && s[1] == ':' && isIDFIRST(s[2])) {
3418                 *d++ = *s++;
3419                 *d++ = *s++;
3420             }
3421             else
3422                 break;
3423         }
3424     }
3425     *d = '\0';
3426     d = dest;
3427     if (*d) {
3428         if (lex_state != LEX_NORMAL)
3429             lex_state = LEX_INTERPENDMAYBE;
3430         return s;
3431     }
3432     if (isSPACE(*s) ||
3433         (*s == '$' && s[1] && (isALPHA(s[1]) || strchr("$_{", s[1]))))
3434             return s;
3435     if (*s == '{') {
3436         bracket = s;
3437         s++;
3438     }
3439     else if (ck_uni)
3440         check_uni();
3441     if (s < send)
3442         *d = *s++;
3443     d[1] = '\0';
3444     if (*d == '^' && (isUPPER(*s) || strchr("[\\]^_?", *s))) {
3445         *d = *s++ ^ 64;
3446     }
3447     if (bracket) {
3448         if (isALPHA(*d) || *d == '_') {
3449             d++;
3450             while (isALNUM(*s))
3451                 *d++ = *s++;
3452             *d = '\0';
3453             if (*s == '[' || *s == '{') {
3454                 if (lex_brackets)
3455                     croak("Can't use delimiter brackets within expression");
3456                 lex_fakebrack = TRUE;
3457                 bracket++;
3458                 lex_brackets++;
3459                 return s;
3460             }
3461         }
3462         if (*s == '}') {
3463             s++;
3464             if (lex_state == LEX_INTERPNORMAL && !lex_brackets)
3465                 lex_state = LEX_INTERPEND;
3466         }
3467         else {
3468             s = bracket;                /* let the parser handle it */
3469             *dest = '\0';
3470         }
3471     }
3472     else if (lex_state == LEX_INTERPNORMAL && !lex_brackets && !intuit_more(s))
3473         lex_state = LEX_INTERPEND;
3474     return s;
3475 }
3476
3477 void
3478 scan_prefix(pm,string,len)
3479 PMOP *pm;
3480 char *string;
3481 I32 len;
3482 {
3483     register SV *tmpstr;
3484     register char *t;
3485     register char *d;
3486     register char *e;
3487     char *origstring = string;
3488
3489     if (ninstr(string, string+len, vert, vert+1))
3490         return;
3491     if (*string == '^')
3492         string++, len--;
3493     tmpstr = NEWSV(86,len);
3494     sv_upgrade(tmpstr, SVt_PVBM);
3495     sv_setpvn(tmpstr,string,len);
3496     t = SvPVX(tmpstr);
3497     e = t + len;
3498     BmUSEFUL(tmpstr) = 100;
3499     for (d=t; d < e; ) {
3500         switch (*d) {
3501         case '{':
3502             if (isDIGIT(d[1]))
3503                 e = d;
3504             else
3505                 goto defchar;
3506             break;
3507         case '.': case '[': case '$': case '(': case ')': case '|': case '+':
3508         case '^':
3509             e = d;
3510             break;
3511         case '\\':
3512             if (d[1] && strchr("wWbB0123456789sSdDlLuUExc",d[1])) {
3513                 e = d;
3514                 break;
3515             }
3516             Move(d+1,d,e-d,char);
3517             e--;
3518             switch(*d) {
3519             case 'n':
3520                 *d = '\n';
3521                 break;
3522             case 't':
3523                 *d = '\t';
3524                 break;
3525             case 'f':
3526                 *d = '\f';
3527                 break;
3528             case 'r':
3529                 *d = '\r';
3530                 break;
3531             case 'e':
3532                 *d = '\033';
3533                 break;
3534             case 'a':
3535                 *d = '\007';
3536                 break;
3537             }
3538             /* FALL THROUGH */
3539         default:
3540           defchar:
3541             if (d[1] == '*' || (d[1] == '{' && d[2] == '0') || d[1] == '?') {
3542                 e = d;
3543                 break;
3544             }
3545             d++;
3546         }
3547     }
3548     if (d == t) {
3549         SvREFCNT_dec(tmpstr);
3550         return;
3551     }
3552     *d = '\0';
3553     SvCUR_set(tmpstr, d - t);
3554     if (d == t+len)
3555         pm->op_pmflags |= PMf_ALL;
3556     if (*origstring != '^')
3557         pm->op_pmflags |= PMf_SCANFIRST;
3558     pm->op_pmshort = tmpstr;
3559     pm->op_pmslen = d - t;
3560 }
3561
3562 static char *
3563 scan_pat(start)
3564 char *start;
3565 {
3566     PMOP *pm;
3567     char *s;
3568
3569     multi_start = curcop->cop_line;
3570
3571     s = scan_str(start);
3572     if (!s) {
3573         if (lex_stuff)
3574             SvREFCNT_dec(lex_stuff);
3575         lex_stuff = Nullsv;
3576         croak("Search pattern not terminated");
3577     }
3578     pm = (PMOP*)newPMOP(OP_MATCH, 0);
3579     if (*start == '?')
3580         pm->op_pmflags |= PMf_ONCE;
3581
3582     while (*s == 'i' || *s == 'o' || *s == 'g') {
3583         if (*s == 'i') {
3584             s++;
3585             sawi = TRUE;
3586             pm->op_pmflags |= PMf_FOLD;
3587         }
3588         if (*s == 'o') {
3589             s++;
3590             pm->op_pmflags |= PMf_KEEP;
3591         }
3592         if (*s == 'g') {
3593             s++;
3594             pm->op_pmflags |= PMf_GLOBAL;
3595         }
3596     }
3597
3598     lex_op = (OP*)pm;
3599     yylval.ival = OP_MATCH;
3600     return s;
3601 }
3602
3603 static char *
3604 scan_subst(start)
3605 char *start;
3606 {
3607     register char *s = start;
3608     register PMOP *pm;
3609     I32 es = 0;
3610
3611     multi_start = curcop->cop_line;
3612     yylval.ival = OP_NULL;
3613
3614     s = scan_str(s);
3615
3616     if (!s) {
3617         if (lex_stuff)
3618             SvREFCNT_dec(lex_stuff);
3619         lex_stuff = Nullsv;
3620         croak("Substitution pattern not terminated");
3621     }
3622
3623     if (s[-1] == *start)
3624         s--;
3625
3626     s = scan_str(s);
3627     if (!s) {
3628         if (lex_stuff)
3629             SvREFCNT_dec(lex_stuff);
3630         lex_stuff = Nullsv;
3631         if (lex_repl)
3632             SvREFCNT_dec(lex_repl);
3633         lex_repl = Nullsv;
3634         croak("Substitution replacement not terminated");
3635     }
3636
3637     pm = (PMOP*)newPMOP(OP_SUBST, 0);
3638     while (*s == 'g' || *s == 'i' || *s == 'e' || *s == 'o') {
3639         if (*s == 'e') {
3640             s++;
3641             es++;
3642         }
3643         if (*s == 'g') {
3644             s++;
3645             pm->op_pmflags |= PMf_GLOBAL;
3646         }
3647         if (*s == 'i') {
3648             s++;
3649             sawi = TRUE;
3650             pm->op_pmflags |= PMf_FOLD;
3651         }
3652         if (*s == 'o') {
3653             s++;
3654             pm->op_pmflags |= PMf_KEEP;
3655         }
3656     }
3657
3658     if (es) {
3659         SV *repl;
3660         pm->op_pmflags |= PMf_EVAL;
3661         repl = newSVpv("",0);
3662         while (es-- > 0)
3663             sv_catpvn(repl, "eval ", 5);
3664         sv_catpvn(repl, "{ ", 2);
3665         sv_catsv(repl, lex_repl);
3666         sv_catpvn(repl, " };", 2);
3667         SvCOMPILED_on(repl);
3668         SvREFCNT_dec(lex_repl);
3669         lex_repl = repl;
3670     }
3671
3672     lex_op = (OP*)pm;
3673     yylval.ival = OP_SUBST;
3674     return s;
3675 }
3676
3677 void
3678 hoistmust(pm)
3679 register PMOP *pm;
3680 {
3681     if (!pm->op_pmshort && pm->op_pmregexp->regstart &&
3682         (!pm->op_pmregexp->regmust || pm->op_pmregexp->reganch & ROPT_ANCH)
3683        ) {
3684         if (!(pm->op_pmregexp->reganch & ROPT_ANCH))
3685             pm->op_pmflags |= PMf_SCANFIRST;
3686         else if (pm->op_pmflags & PMf_FOLD)
3687             return;
3688         pm->op_pmshort = SvREFCNT_inc(pm->op_pmregexp->regstart);
3689     }
3690     else if (pm->op_pmregexp->regmust) {/* is there a better short-circuit? */
3691         if (pm->op_pmshort &&
3692           sv_eq(pm->op_pmshort,pm->op_pmregexp->regmust))
3693         {
3694             if (pm->op_pmflags & PMf_SCANFIRST) {
3695                 SvREFCNT_dec(pm->op_pmshort);
3696                 pm->op_pmshort = Nullsv;
3697             }
3698             else {
3699                 SvREFCNT_dec(pm->op_pmregexp->regmust);
3700                 pm->op_pmregexp->regmust = Nullsv;
3701                 return;
3702             }
3703         }
3704         if (!pm->op_pmshort ||  /* promote the better string */
3705           ((pm->op_pmflags & PMf_SCANFIRST) &&
3706            (SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)) )){
3707             SvREFCNT_dec(pm->op_pmshort);               /* ok if null */
3708             pm->op_pmshort = pm->op_pmregexp->regmust;
3709             pm->op_pmregexp->regmust = Nullsv;
3710             pm->op_pmflags |= PMf_SCANFIRST;
3711         }
3712     }
3713 }
3714
3715 static char *
3716 scan_trans(start)
3717 char *start;
3718 {
3719     register char *s = start;
3720     OP *op;
3721     short *tbl;
3722     I32 squash;
3723     I32 delete;
3724     I32 complement;
3725
3726     yylval.ival = OP_NULL;
3727
3728     s = scan_str(s);
3729     if (!s) {
3730         if (lex_stuff)
3731             SvREFCNT_dec(lex_stuff);
3732         lex_stuff = Nullsv;
3733         croak("Translation pattern not terminated");
3734     }
3735     if (s[-1] == *start)
3736         s--;
3737
3738     s = scan_str(s);
3739     if (!s) {
3740         if (lex_stuff)
3741             SvREFCNT_dec(lex_stuff);
3742         lex_stuff = Nullsv;
3743         if (lex_repl)
3744             SvREFCNT_dec(lex_repl);
3745         lex_repl = Nullsv;
3746         croak("Translation replacement not terminated");
3747     }
3748
3749     New(803,tbl,256,short);
3750     op = newPVOP(OP_TRANS, 0, (char*)tbl);
3751
3752     complement = delete = squash = 0;
3753     while (*s == 'c' || *s == 'd' || *s == 's') {
3754         if (*s == 'c')
3755             complement = OPpTRANS_COMPLEMENT;
3756         else if (*s == 'd')
3757             delete = OPpTRANS_DELETE;
3758         else
3759             squash = OPpTRANS_SQUASH;
3760         s++;
3761     }
3762     op->op_private = delete|squash|complement;
3763
3764     lex_op = op;
3765     yylval.ival = OP_TRANS;
3766     return s;
3767 }
3768
3769 static char *
3770 scan_heredoc(s)
3771 register char *s;
3772 {
3773     SV *herewas;
3774     I32 op_type = OP_SCALAR;
3775     I32 len;
3776     SV *tmpstr;
3777     char term;
3778     register char *d;
3779
3780     s += 2;
3781     d = tokenbuf;
3782     if (!rsfp)
3783         *d++ = '\n';
3784     if (*s && strchr("`'\"",*s)) {
3785         term = *s++;
3786         s = cpytill(d,s,bufend,term,&len);
3787         if (s < bufend)
3788             s++;
3789         d += len;
3790     }
3791     else {
3792         if (*s == '\\')
3793             s++, term = '\'';
3794         else
3795             term = '"';
3796         while (isALNUM(*s))
3797             *d++ = *s++;
3798     }                           /* assuming tokenbuf won't clobber */
3799     *d++ = '\n';
3800     *d = '\0';
3801     len = d - tokenbuf;
3802     d = "\n";
3803     if (rsfp || !(d=ninstr(s,bufend,d,d+1)))
3804         herewas = newSVpv(s,bufend-s);
3805     else
3806         s--, herewas = newSVpv(s,d-s);
3807     s += SvCUR(herewas);
3808     if (term == '\'')
3809         op_type = OP_CONST;
3810     if (term == '`')
3811         op_type = OP_BACKTICK;
3812
3813     CLINE;
3814     multi_start = curcop->cop_line;
3815     multi_open = multi_close = '<';
3816     tmpstr = NEWSV(87,80);
3817     term = *tokenbuf;
3818     if (!rsfp) {
3819         d = s;
3820         while (s < bufend &&
3821           (*s != term || bcmp(s,tokenbuf,len) != 0) ) {
3822             if (*s++ == '\n')
3823                 curcop->cop_line++;
3824         }
3825         if (s >= bufend) {
3826             curcop->cop_line = multi_start;
3827             missingterm(tokenbuf);
3828         }
3829         sv_setpvn(tmpstr,d+1,s-d);
3830         s += len - 1;
3831         sv_catpvn(herewas,s,bufend-s);
3832         sv_setsv(linestr,herewas);
3833         oldoldbufptr = oldbufptr = bufptr = s = SvPVX(linestr);
3834         bufend = SvPVX(linestr) + SvCUR(linestr);
3835     }
3836     else
3837         sv_setpvn(tmpstr,"",0);   /* avoid "uninitialized" warning */
3838     while (s >= bufend) {       /* multiple line string? */
3839         if (!rsfp ||
3840          !(oldoldbufptr = oldbufptr = s = sv_gets(linestr, rsfp, 0))) {
3841             curcop->cop_line = multi_start;
3842             missingterm(tokenbuf);
3843         }
3844         curcop->cop_line++;
3845         if (perldb && curstash != debstash) {
3846             SV *sv = NEWSV(88,0);
3847
3848             sv_upgrade(sv, SVt_PVMG);
3849             sv_setsv(sv,linestr);
3850             av_store(GvAV(curcop->cop_filegv),
3851               (I32)curcop->cop_line,sv);
3852         }
3853         bufend = SvPVX(linestr) + SvCUR(linestr);
3854         if (*s == term && bcmp(s,tokenbuf,len) == 0) {
3855             s = bufend - 1;
3856             *s = ' ';
3857             sv_catsv(linestr,herewas);
3858             bufend = SvPVX(linestr) + SvCUR(linestr);
3859         }
3860         else {
3861             s = bufend;
3862             sv_catsv(tmpstr,linestr);
3863         }
3864     }
3865     multi_end = curcop->cop_line;
3866     s++;
3867     if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
3868         SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
3869         Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
3870     }
3871     SvREFCNT_dec(herewas);
3872     lex_stuff = tmpstr;
3873     yylval.ival = op_type;
3874     return s;
3875 }
3876
3877 static char *
3878 scan_inputsymbol(start)
3879 char *start;
3880 {
3881     register char *s = start;
3882     register char *d;
3883     I32 len;
3884
3885     d = tokenbuf;
3886     s = cpytill(d, s+1, bufend, '>', &len);
3887     if (s < bufend)
3888         s++;
3889     else
3890         croak("Unterminated <> operator");
3891
3892     if (*d == '$') d++;
3893     while (*d && (isALNUM(*d) || *d == '\''))
3894         d++;
3895     if (d - tokenbuf != len) {
3896         yylval.ival = OP_GLOB;
3897         set_csh();
3898         s = scan_str(start);
3899         if (!s)
3900             croak("Glob not terminated");
3901         return s;
3902     }
3903     else {
3904         d = tokenbuf;
3905         if (!len)
3906             (void)strcpy(d,"ARGV");
3907         if (*d == '$') {
3908             GV *gv = gv_fetchpv(d+1,TRUE);
3909             lex_op = (OP*)newUNOP(OP_READLINE, 0,
3910                                     newUNOP(OP_RV2GV, 0,
3911                                         newUNOP(OP_RV2SV, 0,
3912                                             newGVOP(OP_GV, 0, gv))));
3913             yylval.ival = OP_NULL;
3914         }
3915         else {
3916             IO *io;
3917
3918             GV *gv = gv_fetchpv(d,TRUE);
3919             io = GvIOn(gv);
3920             if (strEQ(d,"ARGV")) {
3921                 GvAVn(gv);
3922                 IoFLAGS(io) |= IOf_ARGV|IOf_START;
3923             }
3924             lex_op = (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
3925             yylval.ival = OP_NULL;
3926         }
3927     }
3928     return s;
3929 }
3930
3931 static char *
3932 scan_str(start)
3933 char *start;
3934 {
3935     SV *sv;
3936     char *tmps;
3937     register char *s = start;
3938     register char term = *s;
3939     register char *to;
3940     I32 brackets = 1;
3941
3942     CLINE;
3943     multi_start = curcop->cop_line;
3944     multi_open = term;
3945     if (term && (tmps = strchr("([{< )]}> )]}>",term)))
3946         term = tmps[5];
3947     multi_close = term;
3948
3949     sv = NEWSV(87,80);
3950     sv_upgrade(sv, SVt_PVIV);
3951     SvIVX(sv) = term;
3952     SvPOK_only(sv);             /* validate pointer */
3953     s++;
3954     for (;;) {
3955         SvGROW(sv, SvCUR(sv) + (bufend - s) + 1);
3956         to = SvPVX(sv)+SvCUR(sv);
3957         if (multi_open == multi_close) {
3958             for (; s < bufend; s++,to++) {
3959                 if (*s == '\n' && !rsfp)
3960                     curcop->cop_line++;
3961                 if (*s == '\\' && s+1 < bufend && term != '\\')
3962                     *to++ = *s++;
3963                 else if (*s == term)
3964                     break;
3965                 *to = *s;
3966             }
3967         }
3968         else {
3969             for (; s < bufend; s++,to++) {
3970                 if (*s == '\n' && !rsfp)
3971                     curcop->cop_line++;
3972                 if (*s == '\\' && s+1 < bufend && term != '\\')
3973                     *to++ = *s++;
3974                 else if (*s == term && --brackets <= 0)
3975                     break;
3976                 else if (*s == multi_open)
3977                     brackets++;
3978                 *to = *s;
3979             }
3980         }
3981         *to = '\0';
3982         SvCUR_set(sv, to - SvPVX(sv));
3983
3984     if (s < bufend) break;      /* string ends on this line? */
3985
3986         if (!rsfp ||
3987          !(oldoldbufptr = oldbufptr = s = sv_gets(linestr, rsfp, 0))) {
3988             curcop->cop_line = multi_start;
3989             return Nullch;
3990         }
3991         curcop->cop_line++;
3992         if (perldb && curstash != debstash) {
3993             SV *sv = NEWSV(88,0);
3994
3995             sv_upgrade(sv, SVt_PVMG);
3996             sv_setsv(sv,linestr);
3997             av_store(GvAV(curcop->cop_filegv),
3998               (I32)curcop->cop_line, sv);
3999         }
4000         bufend = SvPVX(linestr) + SvCUR(linestr);
4001     }
4002     multi_end = curcop->cop_line;
4003     s++;
4004     if (SvCUR(sv) + 5 < SvLEN(sv)) {
4005         SvLEN_set(sv, SvCUR(sv) + 1);
4006         Renew(SvPVX(sv), SvLEN(sv), char);
4007     }
4008     if (lex_stuff)
4009         lex_repl = sv;
4010     else
4011         lex_stuff = sv;
4012     return s;
4013 }
4014
4015 char *
4016 scan_num(start)
4017 char *start;
4018 {
4019     register char *s = start;
4020     register char *d;
4021     I32 tryi32;
4022     double value;
4023     SV *sv;
4024     I32 floatit;
4025     char *lastub = 0;
4026
4027     switch (*s) {
4028     default:
4029         croak("panic: scan_num");
4030     case '0':
4031         {
4032             U32 i;
4033             I32 shift;
4034
4035             if (s[1] == 'x') {
4036                 shift = 4;
4037                 s += 2;
4038             }
4039             else if (s[1] == '.')
4040                 goto decimal;
4041             else
4042                 shift = 3;
4043             i = 0;
4044             for (;;) {
4045                 switch (*s) {
4046                 default:
4047                     goto out;
4048                 case '_':
4049                     s++;
4050                     break;
4051                 case '8': case '9':
4052                     if (shift != 4)
4053                         yyerror("Illegal octal digit");
4054                     /* FALL THROUGH */
4055                 case '0': case '1': case '2': case '3': case '4':
4056                 case '5': case '6': case '7':
4057                     i <<= shift;
4058                     i += *s++ & 15;
4059                     break;
4060                 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
4061                 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
4062                     if (shift != 4)
4063                         goto out;
4064                     i <<= 4;
4065                     i += (*s++ & 7) + 9;
4066                     break;
4067                 }
4068             }
4069           out:
4070             sv = NEWSV(92,0);
4071             tryi32 = i;
4072             if (tryi32 == i && tryi32 >= 0)
4073                 sv_setiv(sv,tryi32);
4074             else
4075                 sv_setnv(sv,(double)i);
4076         }
4077         break;
4078     case '1': case '2': case '3': case '4': case '5':
4079     case '6': case '7': case '8': case '9': case '.':
4080       decimal:
4081         d = tokenbuf;
4082         floatit = FALSE;
4083         while (isDIGIT(*s) || *s == '_') {
4084             if (*s == '_') {
4085                 if (dowarn && lastub && s - lastub != 3)
4086                     warn("Misplaced _ in number");
4087                 lastub = ++s;
4088             }
4089             else
4090                 *d++ = *s++;
4091         }
4092         if (dowarn && lastub && s - lastub != 3)
4093             warn("Misplaced _ in number");
4094         if (*s == '.' && s[1] != '.') {
4095             floatit = TRUE;
4096             *d++ = *s++;
4097             while (isDIGIT(*s) || *s == '_') {
4098                 if (*s == '_')
4099                     s++;
4100                 else
4101                     *d++ = *s++;
4102             }
4103         }
4104         if (*s && strchr("eE",*s) && strchr("+-0123456789",s[1])) {
4105             floatit = TRUE;
4106             s++;
4107             *d++ = 'e';         /* At least some Mach atof()s don't grok 'E' */
4108             if (*s == '+' || *s == '-')
4109                 *d++ = *s++;
4110             while (isDIGIT(*s))
4111                 *d++ = *s++;
4112         }
4113         *d = '\0';
4114         sv = NEWSV(92,0);
4115         value = atof(tokenbuf);
4116         tryi32 = I_32(value);
4117         if (!floatit && (double)tryi32 == value)
4118             sv_setiv(sv,tryi32);
4119         else
4120             sv_setnv(sv,value);
4121         break;
4122     }
4123
4124     yylval.opval = newSVOP(OP_CONST, 0, sv);
4125
4126     return s;
4127 }
4128
4129 static char *
4130 scan_formline(s)
4131 register char *s;
4132 {
4133     register char *eol;
4134     register char *t;
4135     SV *stuff = newSV(0);
4136     bool needargs = FALSE;
4137
4138     while (!needargs) {
4139         if (*s == '.') {
4140             /*SUPPRESS 530*/
4141             for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
4142             if (*t == '\n')
4143                 break;
4144         }
4145         if (in_eval && !rsfp) {
4146             eol = strchr(s,'\n');
4147             if (!eol++)
4148                 eol = bufend;
4149         }
4150         else
4151             eol = bufend = SvPVX(linestr) + SvCUR(linestr);
4152         if (*s != '#') {
4153             sv_catpvn(stuff, s, eol-s);
4154             while (s < eol) {
4155                 if (*s == '@' || *s == '^') {
4156                     needargs = TRUE;
4157                     break;
4158                 }
4159                 s++;
4160             }
4161         }
4162         s = eol;
4163         if (rsfp) {
4164             s = sv_gets(linestr, rsfp, 0);
4165             oldoldbufptr = oldbufptr = bufptr = SvPVX(linestr);
4166             if (!s) {
4167                 s = bufptr;
4168                 yyerror("Format not terminated");
4169                 break;
4170             }
4171         }
4172         incline(s);
4173     }
4174     if (SvPOK(stuff)) {
4175         expect = XTERM;
4176         if (needargs) {
4177             nextval[nexttoke].ival = 0;
4178             force_next(',');
4179         }
4180         else
4181             in_format = 2;
4182         nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, stuff);
4183         force_next(THING);
4184         nextval[nexttoke].ival = OP_FORMLINE;
4185         force_next(LSTOP);
4186     }
4187     else {
4188         SvREFCNT_dec(stuff);
4189         in_format = 0;
4190         bufptr = s;
4191     }
4192     return s;
4193 }
4194
4195 static void
4196 set_csh()
4197 {
4198 #ifdef CSH
4199     if (!cshlen)
4200         cshlen = strlen(cshname);
4201 #endif
4202 }
4203
4204 int
4205 start_subparse()
4206 {
4207     int oldsavestack_ix = savestack_ix;
4208
4209     save_I32(&subline);
4210     save_item(subname);
4211     SAVEINT(padix);
4212     SAVESPTR(curpad);
4213     SAVESPTR(comppad);
4214     SAVESPTR(comppad_name);
4215     SAVEINT(comppad_name_fill);
4216     SAVEINT(min_intro_pending);
4217     SAVEINT(max_intro_pending);
4218     comppad = newAV();
4219     comppad_name = newAV();
4220     comppad_name_fill = 0;
4221     min_intro_pending = 0;
4222     av_push(comppad, Nullsv);
4223     curpad = AvARRAY(comppad);
4224     padix = 0;
4225
4226     subline = curcop->cop_line;
4227     return oldsavestack_ix;
4228 }
4229
4230 int
4231 yywarn(s)
4232 char *s;
4233 {
4234     --error_count;
4235     return yyerror(s);
4236 }
4237
4238 int
4239 yyerror(s)
4240 char *s;
4241 {
4242     char tmpbuf[258];
4243     char tmp2buf[258];
4244     char *tname = tmpbuf;
4245
4246     if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
4247       oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
4248         while (isSPACE(*oldoldbufptr))
4249             oldoldbufptr++;
4250         cpy7bit(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr);
4251         sprintf(tname,"near \"%s\"",tmp2buf);
4252     }
4253     else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
4254       oldbufptr != bufptr) {
4255         while (isSPACE(*oldbufptr))
4256             oldbufptr++;
4257         cpy7bit(tmp2buf, oldbufptr, bufptr - oldbufptr);
4258         sprintf(tname,"near \"%s\"",tmp2buf);
4259     }
4260     else if (yychar > 255)
4261         tname = "next token ???";
4262     else if (!yychar || (yychar == ';' && !rsfp))
4263         (void)strcpy(tname,"at EOF");
4264     else if ((yychar & 127) == 127) {
4265         if (lex_state == LEX_NORMAL ||
4266            (lex_state == LEX_KNOWNEXT && lex_defer == LEX_NORMAL))
4267             (void)strcpy(tname,"at end of line");
4268         else
4269             (void)strcpy(tname,"at end of string");
4270     }
4271     else if (yychar < 32)
4272         (void)sprintf(tname,"next char ^%c",yychar+64);
4273     else
4274         (void)sprintf(tname,"next char %c",yychar);
4275     (void)sprintf(buf, "%s at %s line %d, %s\n",
4276       s,SvPVX(GvSV(curcop->cop_filegv)),curcop->cop_line,tname);
4277     if (curcop->cop_line == multi_end && multi_start < multi_end)
4278         sprintf(buf+strlen(buf),
4279           "  (Might be a runaway multi-line %c%c string starting on line %d)\n",
4280           multi_open,multi_close,multi_start);
4281     if (in_eval)
4282         sv_catpv(GvSV(gv_fetchpv("@",TRUE)),buf);
4283     else
4284         fputs(buf,stderr);
4285     if (++error_count >= 10)
4286         croak("%s has too many errors.\n",
4287         SvPVX(GvSV(curcop->cop_filegv)));
4288     return 0;
4289 }