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                     if (minus_F){
1104                       char tmpbuf1[50];
1105                       if ( splitstr[0] == '/' ||
1106                            splitstr[0] == '\'' ||
1107                            splitstr[0] == '"' )
1108                             sprintf( tmpbuf1, "@F=split(%s);", splitstr );
1109                         else
1110                             sprintf( tmpbuf1, "@F=split('%s');", splitstr );
1111                         sv_catpv(linestr,tmpbuf1);
1112                     }
1113                     else
1114                         sv_catpv(linestr,"@F=split(' ');");
1115                 }
1116             }
1117             oldoldbufptr = oldbufptr = s = SvPVX(linestr);
1118             bufend = SvPVX(linestr) + SvCUR(linestr);
1119             goto retry;
1120         }
1121 #ifdef CRYPTSCRIPT
1122         cryptswitch();
1123 #endif /* CRYPTSCRIPT */
1124         do {
1125             if ((s = sv_gets(linestr, rsfp, 0)) == Nullch) {
1126               fake_eof:
1127                 if (rsfp) {
1128                     if (preprocess)
1129                         (void)my_pclose(rsfp);
1130                     else if ((FILE*)rsfp == stdin)
1131                         clearerr(stdin);
1132                     else
1133                         (void)fclose(rsfp);
1134                     rsfp = Nullfp;
1135                 }
1136                 if (minus_n || minus_p) {
1137                     sv_setpv(linestr,minus_p ? ";}continue{print" : "");
1138                     sv_catpv(linestr,";}");
1139                     oldoldbufptr = oldbufptr = s = SvPVX(linestr);
1140                     bufend = SvPVX(linestr) + SvCUR(linestr);
1141                     minus_n = minus_p = 0;
1142                     goto retry;
1143                 }
1144                 oldoldbufptr = oldbufptr = s = SvPVX(linestr);
1145                 sv_setpv(linestr,"");
1146                 TOKEN(';');     /* not infinite loop because rsfp is NULL now */
1147             }
1148             if (doextract && *s == '#')
1149                 doextract = FALSE;
1150             incline(s);
1151         } while (doextract);
1152         oldoldbufptr = oldbufptr = bufptr = s;
1153         if (perldb && curstash != debstash) {
1154             SV *sv = NEWSV(85,0);
1155
1156             sv_upgrade(sv, SVt_PVMG);
1157             sv_setsv(sv,linestr);
1158             av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv);
1159         }
1160         bufend = SvPVX(linestr) + SvCUR(linestr);
1161         if (curcop->cop_line == 1) {
1162             while (s < bufend && isSPACE(*s))
1163                 s++;
1164             if (*s == ':')      /* for csh's that have to exec sh scripts */
1165                 s++;
1166             if (*s == '#' && s[1] == '!') {
1167                 if (!in_eval && !instr(s,"perl") && !instr(s,"indir") &&
1168                         instr(origargv[0],"perl")) {
1169                     char **newargv;
1170                     char *cmd;
1171
1172                     s += 2;
1173                     if (*s == ' ')
1174                         s++;
1175                     cmd = s;
1176                     while (s < bufend && !isSPACE(*s))
1177                         s++;
1178                     *s++ = '\0';
1179                     while (s < bufend && isSPACE(*s))
1180                         s++;
1181                     if (s < bufend) {
1182                         Newz(899,newargv,origargc+3,char*);
1183                         newargv[1] = s;
1184                         while (s < bufend && !isSPACE(*s))
1185                             s++;
1186                         *s = '\0';
1187                         Copy(origargv+1, newargv+2, origargc+1, char*);
1188                     }
1189                     else
1190                         newargv = origargv;
1191                     newargv[0] = cmd;
1192                     execv(cmd,newargv);
1193                     croak("Can't exec %s", cmd);
1194                 }
1195                 if (d = instr(s, "perl -")) {
1196                     d += 6;
1197                     /*SUPPRESS 530*/
1198                     while (d = moreswitches(d)) ;
1199                 }
1200             }
1201         }
1202         if (in_format && lex_brackets <= 1) {
1203             s = scan_formline(s);
1204             if (!in_format)
1205                 goto rightbracket;
1206             OPERATOR(';');
1207         }
1208         goto retry;
1209     case ' ': case '\t': case '\f': case '\r': case 013:
1210         s++;
1211         goto retry;
1212     case '#':
1213     case '\n':
1214         if (lex_state != LEX_NORMAL || (in_eval && !rsfp)) {
1215             d = bufend;
1216             while (s < d && *s != '\n')
1217                 s++;
1218             if (s < d)
1219                 s++;
1220             incline(s);
1221             if (in_format && lex_brackets <= 1) {
1222                 s = scan_formline(s);
1223                 if (!in_format)
1224                     goto rightbracket;
1225                 OPERATOR(';');
1226             }
1227         }
1228         else {
1229             *s = '\0';
1230             bufend = s;
1231         }
1232         goto retry;
1233     case '-':
1234         if (s[1] && isALPHA(s[1]) && !isALNUM(s[2])) {
1235             s++;
1236             last_uni = oldbufptr;
1237             switch (*s++) {
1238             case 'r': FTST(OP_FTEREAD);
1239             case 'w': FTST(OP_FTEWRITE);
1240             case 'x': FTST(OP_FTEEXEC);
1241             case 'o': FTST(OP_FTEOWNED);
1242             case 'R': FTST(OP_FTRREAD);
1243             case 'W': FTST(OP_FTRWRITE);
1244             case 'X': FTST(OP_FTREXEC);
1245             case 'O': FTST(OP_FTROWNED);
1246             case 'e': FTST(OP_FTIS);
1247             case 'z': FTST(OP_FTZERO);
1248             case 's': FTST(OP_FTSIZE);
1249             case 'f': FTST(OP_FTFILE);
1250             case 'd': FTST(OP_FTDIR);
1251             case 'l': FTST(OP_FTLINK);
1252             case 'p': FTST(OP_FTPIPE);
1253             case 'S': FTST(OP_FTSOCK);
1254             case 'u': FTST(OP_FTSUID);
1255             case 'g': FTST(OP_FTSGID);
1256             case 'k': FTST(OP_FTSVTX);
1257             case 'b': FTST(OP_FTBLK);
1258             case 'c': FTST(OP_FTCHR);
1259             case 't': FTST(OP_FTTTY);
1260             case 'T': FTST(OP_FTTEXT);
1261             case 'B': FTST(OP_FTBINARY);
1262             case 'M': gv_fetchpv("\024",TRUE); FTST(OP_FTMTIME);
1263             case 'A': gv_fetchpv("\024",TRUE); FTST(OP_FTATIME);
1264             case 'C': gv_fetchpv("\024",TRUE); FTST(OP_FTCTIME);
1265             default:
1266                 s -= 2;
1267                 break;
1268             }
1269         }
1270         tmp = *s++;
1271         if (*s == tmp) {
1272             s++;
1273             if (expect == XOPERATOR)
1274                 TERM(POSTDEC);
1275             else
1276                 OPERATOR(PREDEC);
1277         }
1278         else if (*s == '>') {
1279             s++;
1280             s = skipspace(s);
1281             if (isIDFIRST(*s)) {
1282                 s = force_word(s,METHOD,FALSE,TRUE);
1283                 TOKEN(ARROW);
1284             }
1285             else
1286                 PREBLOCK(ARROW);
1287         }
1288         if (expect == XOPERATOR)
1289             Aop(OP_SUBTRACT);
1290         else {
1291             if (isSPACE(*s) || !isSPACE(*bufptr))
1292                 check_uni();
1293             OPERATOR('-');              /* unary minus */
1294         }
1295
1296     case '+':
1297         tmp = *s++;
1298         if (*s == tmp) {
1299             s++;
1300             if (expect == XOPERATOR)
1301                 TERM(POSTINC);
1302             else
1303                 OPERATOR(PREINC);
1304         }
1305         if (expect == XOPERATOR)
1306             Aop(OP_ADD);
1307         else {
1308             if (isSPACE(*s) || !isSPACE(*bufptr))
1309                 check_uni();
1310             OPERATOR('+');
1311         }
1312
1313     case '*':
1314         if (expect != XOPERATOR) {
1315             s = scan_ident(s, bufend, tokenbuf, TRUE);
1316             expect = XOPERATOR;
1317             force_ident(tokenbuf);
1318             TERM('*');
1319         }
1320         s++;
1321         if (*s == '*') {
1322             s++;
1323             PWop(OP_POW);
1324         }
1325         Mop(OP_MULTIPLY);
1326
1327     case '%':
1328         if (expect != XOPERATOR) {
1329             s = scan_ident(s, bufend, tokenbuf + 1, TRUE);
1330             if (tokenbuf[1]) {
1331                 expect = XOPERATOR;
1332                 tokenbuf[0] = '%';
1333                 if (in_my) {
1334                     if (strchr(tokenbuf,':'))
1335                         croak("\"my\" variable %s can't be in a package",tokenbuf);
1336                     nextval[nexttoke].opval = newOP(OP_PADANY, 0);
1337                     nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf);
1338                     force_next(PRIVATEREF);
1339                     TERM('%');
1340                 }
1341                 if (!strchr(tokenbuf,':')) {
1342                     if (tmp = pad_findmy(tokenbuf)) {
1343                         nextval[nexttoke].opval = newOP(OP_PADANY, 0);
1344                         nextval[nexttoke].opval->op_targ = tmp;
1345                         force_next(PRIVATEREF);
1346                         TERM('%');
1347                     }
1348                 }
1349                 force_ident(tokenbuf + 1);
1350             }
1351             else
1352                 PREREF('%');
1353             TERM('%');
1354         }
1355         ++s;
1356         Mop(OP_MODULO);
1357
1358     case '^':
1359         s++;
1360         BOop(OP_XOR);
1361     case '[':
1362         lex_brackets++;
1363         /* FALL THROUGH */
1364     case '~':
1365     case ',':
1366     case ':':
1367         tmp = *s++;
1368         OPERATOR(tmp);
1369     case '(':
1370         s++;
1371         if (last_lop == oldoldbufptr)
1372             oldbufptr = oldoldbufptr;           /* allow print(STDOUT 123) */
1373         OPERATOR('(');
1374     case ';':
1375         if (curcop->cop_line < copline)
1376             copline = curcop->cop_line;
1377         tmp = *s++;
1378         OPERATOR(tmp);
1379     case ')':
1380         tmp = *s++;
1381         TERM(tmp);
1382     case ']':
1383         s++;
1384         if (lex_brackets <= 0)
1385             yyerror("Unmatched right bracket");
1386         else
1387             --lex_brackets;
1388         if (lex_state == LEX_INTERPNORMAL) {
1389             if (lex_brackets == 0) {
1390                 if (*s != '-' || s[1] != '>')
1391                     lex_state = LEX_INTERPEND;
1392             }
1393         }
1394         TOKEN(']');
1395     case '{':
1396       leftbracket:
1397         if (in_format == 2)
1398             in_format = 0;
1399         s++;
1400         if (lex_brackets > 100) {
1401             char* newlb = (char*)realloc(lex_brackstack, lex_brackets + 1);
1402             if (newlb != lex_brackstack) {
1403                 SAVEFREEPV(newlb);
1404                 lex_brackstack = newlb;
1405             }
1406         }
1407         if (oldoldbufptr == last_lop)
1408             lex_brackstack[lex_brackets++] = XTERM;
1409         else
1410             lex_brackstack[lex_brackets++] = XOPERATOR;
1411         if (expect == XTERM)
1412             OPERATOR(HASHBRACK);
1413         else if (expect == XBLOCK || expect == XOPERATOR) {
1414             lex_brackstack[lex_brackets-1] = XSTATE;
1415             expect = XSTATE;
1416         }
1417         else {
1418             char *t;
1419             s = skipspace(s);
1420             if (*s == '}')
1421                 OPERATOR(HASHBRACK);
1422             for (t = s;
1423                 t < bufend &&
1424                     (isSPACE(*t) || isALPHA(*t) || *t == '"' || *t == '\'');
1425                 t++) ;
1426             if (*t == ',' || (*t == '=' && t[1] == '>'))
1427                 OPERATOR(HASHBRACK);
1428             if (expect == XREF)
1429                 expect = XTERM;
1430             else {
1431                 lex_brackstack[lex_brackets-1] = XSTATE;
1432                 expect = XSTATE;
1433             }
1434         }
1435         yylval.ival = curcop->cop_line;
1436         if (isSPACE(*s) || *s == '#')
1437             copline = NOLINE;   /* invalidate current command line number */
1438         TOKEN('{');
1439     case '}':
1440       rightbracket:
1441         s++;
1442         if (lex_brackets <= 0)
1443             yyerror("Unmatched right bracket");
1444         else
1445             expect = (expectation)lex_brackstack[--lex_brackets];
1446         if (lex_state == LEX_INTERPNORMAL) {
1447             if (lex_brackets == 0) {
1448                 if (lex_fakebrack) {
1449                     lex_state = LEX_INTERPEND;
1450                     bufptr = s;
1451                     return yylex();             /* ignore fake brackets */
1452                 }
1453                 if (*s != '-' || s[1] != '>')
1454                     lex_state = LEX_INTERPEND;
1455             }
1456         }
1457         force_next('}');
1458         TOKEN(';');
1459     case '&':
1460         s++;
1461         tmp = *s++;
1462         if (tmp == '&')
1463             OPERATOR(ANDAND);
1464         s--;
1465         if (expect == XOPERATOR) {
1466             if (dowarn && isALPHA(*s) && bufptr == SvPVX(linestr)) {
1467                 curcop->cop_line--;
1468                 warn(warn_nosemi);
1469                 curcop->cop_line++;
1470             }
1471             BAop(OP_BIT_AND);
1472         }
1473
1474         s = scan_ident(s-1, bufend, tokenbuf, TRUE);
1475         if (*tokenbuf) {
1476             expect = XOPERATOR;
1477             force_ident(tokenbuf);
1478         }
1479         else
1480             PREREF('&');
1481         TERM('&');
1482
1483     case '|':
1484         s++;
1485         tmp = *s++;
1486         if (tmp == '|')
1487             OPERATOR(OROR);
1488         s--;
1489         BOop(OP_BIT_OR);
1490     case '=':
1491         s++;
1492         tmp = *s++;
1493         if (tmp == '=')
1494             Eop(OP_EQ);
1495         if (tmp == '>')
1496             OPERATOR(',');
1497         if (tmp == '~')
1498             PMop(OP_MATCH);
1499         if (dowarn && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp))
1500             warn("Reversed %c= operator",tmp);
1501         s--;
1502         if (in_format == 2 && (tmp == '\n' || s[1] == '\n')) {
1503             in_format = 1;
1504             s--;
1505             expect = XBLOCK;
1506             goto leftbracket;
1507         }
1508         OPERATOR('=');
1509     case '!':
1510         s++;
1511         tmp = *s++;
1512         if (tmp == '=')
1513             Eop(OP_NE);
1514         if (tmp == '~')
1515             PMop(OP_NOT);
1516         s--;
1517         OPERATOR('!');
1518     case '<':
1519         if (expect != XOPERATOR) {
1520             if (s[1] != '<' && !strchr(s,'>'))
1521                 check_uni();
1522             if (s[1] == '<')
1523                 s = scan_heredoc(s);
1524             else
1525                 s = scan_inputsymbol(s);
1526             TERM(sublex_start());
1527         }
1528         s++;
1529         tmp = *s++;
1530         if (tmp == '<')
1531             SHop(OP_LEFT_SHIFT);
1532         if (tmp == '=') {
1533             tmp = *s++;
1534             if (tmp == '>')
1535                 Eop(OP_NCMP);
1536             s--;
1537             Rop(OP_LE);
1538         }
1539         s--;
1540         Rop(OP_LT);
1541     case '>':
1542         s++;
1543         tmp = *s++;
1544         if (tmp == '>')
1545             SHop(OP_RIGHT_SHIFT);
1546         if (tmp == '=')
1547             Rop(OP_GE);
1548         s--;
1549         Rop(OP_GT);
1550
1551     case '$':
1552         if (s[1] == '#'  && (isALPHA(s[2]) || s[2] == '_' || s[2] == '{')) {
1553             s = scan_ident(s+1, bufend, tokenbuf, FALSE);
1554             if (expect == XOPERATOR) {
1555                 if (in_format)
1556                     OPERATOR(','); /* grandfather non-comma-format format */
1557                 else
1558                     no_op("Array length",s);
1559             }
1560             expect = XOPERATOR;
1561             force_ident(tokenbuf);
1562             TOKEN(DOLSHARP);
1563         }
1564         s = scan_ident(s, bufend, tokenbuf+1, FALSE);
1565         if (expect == XOPERATOR) {
1566             if (in_format)
1567                 OPERATOR(',');  /* grandfather non-comma-format format */
1568             else
1569                 no_op("Scalar",s);
1570         }
1571         if (tokenbuf[1]) {
1572             tokenbuf[0] = '$';
1573             if (dowarn && *s == '[') {
1574                 char *t;
1575                 for (t = s+1; isSPACE(*t) || isALNUM(*t) || *t == '$'; t++) ;
1576                 if (*t++ == ',') {
1577                     bufptr = skipspace(bufptr);
1578                     while (t < bufend && *t != ']') t++;
1579                     warn("Multidimensional syntax %.*s not supported",
1580                         t-bufptr+1, bufptr);
1581                 }
1582             }
1583             expect = XOPERATOR;
1584             if (lex_state == LEX_NORMAL && isSPACE(*s)) {
1585                 bool islop = (last_lop == oldoldbufptr);
1586                 s = skipspace(s);
1587                 if (!islop)
1588                     expect = XOPERATOR;
1589                 else if (strchr("$@\"'`q", *s))
1590                     expect = XTERM;             /* e.g. print $fh "foo" */
1591                 else if (strchr("&*<%", *s) && isIDFIRST(s[1]))
1592                     expect = XTERM;             /* e.g. print $fh &sub */
1593                 else if (isDIGIT(*s))
1594                     expect = XTERM;             /* e.g. print $fh 3 */
1595                 else if (*s == '.' && isDIGIT(s[1]))
1596                     expect = XTERM;             /* e.g. print $fh .3 */
1597                 else if (strchr("/?-+", *s) && !isSPACE(s[1]))
1598                     expect = XTERM;             /* e.g. print $fh -1 */
1599                 else if (*s == '<' && s[1] == '<' && !isSPACE(s[2]))
1600                     expect = XTERM;             /* print $fh <<"EOF" */
1601             }
1602             if (in_my) {
1603                 if (strchr(tokenbuf,':'))
1604                     croak("\"my\" variable %s can't be in a package",tokenbuf);
1605                 nextval[nexttoke].opval = newOP(OP_PADANY, 0);
1606                 nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf);
1607                 force_next(PRIVATEREF);
1608             }
1609             else if (!strchr(tokenbuf,':')) {
1610                 if (*s == '[')
1611                     tokenbuf[0] = '@';
1612                 else if (*s == '{')
1613                     tokenbuf[0] = '%';
1614                 if (tmp = pad_findmy(tokenbuf)) {
1615                     nextval[nexttoke].opval = newOP(OP_PADANY, 0);
1616                     nextval[nexttoke].opval->op_targ = tmp;
1617                     force_next(PRIVATEREF);
1618                 }
1619                 else
1620                     force_ident(tokenbuf+1);
1621             }
1622             else
1623                 force_ident(tokenbuf+1);
1624         }
1625         else {
1626             if (s == bufend)
1627                 yyerror("Final $ should be \\$ or $name");
1628             PREREF('$');
1629         }
1630         TOKEN('$');
1631
1632     case '@':
1633         s = scan_ident(s, bufend, tokenbuf+1, FALSE);
1634         if (expect == XOPERATOR)
1635             no_op("Array",s);
1636         if (tokenbuf[1]) {
1637             tokenbuf[0] = '@';
1638             expect = XOPERATOR;
1639             if (in_my) {
1640                 if (strchr(tokenbuf,':'))
1641                     croak("\"my\" variable %s can't be in a package",tokenbuf);
1642                 nextval[nexttoke].opval = newOP(OP_PADANY, 0);
1643                 nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf);
1644                 force_next(PRIVATEREF);
1645                 TERM('@');
1646             }
1647             else if (!strchr(tokenbuf,':')) {
1648                 if (*s == '{')
1649                     tokenbuf[0] = '%';
1650                 if (tmp = pad_findmy(tokenbuf)) {
1651                     nextval[nexttoke].opval = newOP(OP_PADANY, 0);
1652                     nextval[nexttoke].opval->op_targ = tmp;
1653                     force_next(PRIVATEREF);
1654                     TERM('@');
1655                 }
1656             }
1657             if (dowarn && *s == '[') {
1658                 char *t;
1659                 for (t = s+1; *t && (isALNUM(*t) || strchr(" \t$#+-", *t)); t++)
1660                     ;
1661                 if (*t++ == ']') {
1662                     bufptr = skipspace(bufptr);
1663                     warn("Scalar value %.*s better written as $%.*s",
1664                         t-bufptr, bufptr, t-bufptr-1, bufptr+1);
1665                 }
1666             }
1667             force_ident(tokenbuf+1);
1668         }
1669         else {
1670             if (s == bufend)
1671                 yyerror("Final @ should be \\@ or @name");
1672             PREREF('@');
1673         }
1674         TERM('@');
1675
1676     case '/':                   /* may either be division or pattern */
1677     case '?':                   /* may either be conditional or pattern */
1678         if (expect != XOPERATOR) {
1679             check_uni();
1680             s = scan_pat(s);
1681             TERM(sublex_start());
1682         }
1683         tmp = *s++;
1684         if (tmp == '/')
1685             Mop(OP_DIVIDE);
1686         OPERATOR(tmp);
1687
1688     case '.':
1689         if (in_format == 2) {
1690             in_format = 0;
1691             expect = XSTATE;
1692             goto rightbracket;
1693         }
1694         if (expect == XOPERATOR || !isDIGIT(s[1])) {
1695             tmp = *s++;
1696             if (*s == tmp) {
1697                 s++;
1698                 if (*s == tmp) {
1699                     s++;
1700                     yylval.ival = OPf_SPECIAL;
1701                 }
1702                 else
1703                     yylval.ival = 0;
1704                 OPERATOR(DOTDOT);
1705             }
1706             if (expect != XOPERATOR)
1707                 check_uni();
1708             Aop(OP_CONCAT);
1709         }
1710         /* FALL THROUGH */
1711     case '0': case '1': case '2': case '3': case '4':
1712     case '5': case '6': case '7': case '8': case '9':
1713         s = scan_num(s);
1714         if (expect == XOPERATOR)
1715             no_op("Number",s);
1716         TERM(THING);
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_CONST;
1729         TERM(sublex_start());
1730
1731     case '"':
1732         s = scan_str(s);
1733         if (expect == XOPERATOR) {
1734             if (in_format)
1735                 OPERATOR(',');  /* grandfather non-comma-format format */
1736             else
1737                 no_op("String",s);
1738         }
1739         if (!s)
1740             missingterm(0);
1741         yylval.ival = OP_SCALAR;
1742         TERM(sublex_start());
1743
1744     case '`':
1745         s = scan_str(s);
1746         if (expect == XOPERATOR)
1747             no_op("Backticks",s);
1748         if (!s)
1749             missingterm(0);
1750         yylval.ival = OP_BACKTICK;
1751         set_csh();
1752         TERM(sublex_start());
1753
1754     case '\\':
1755         s++;
1756         if (expect == XOPERATOR)
1757             no_op("Backslash",s);
1758         OPERATOR(REFGEN);
1759
1760     case 'x':
1761         if (isDIGIT(s[1]) && expect == XOPERATOR) {
1762             s++;
1763             Mop(OP_REPEAT);
1764         }
1765         goto keylookup;
1766
1767     case '_':
1768     case 'a': case 'A':
1769     case 'b': case 'B':
1770     case 'c': case 'C':
1771     case 'd': case 'D':
1772     case 'e': case 'E':
1773     case 'f': case 'F':
1774     case 'g': case 'G':
1775     case 'h': case 'H':
1776     case 'i': case 'I':
1777     case 'j': case 'J':
1778     case 'k': case 'K':
1779     case 'l': case 'L':
1780     case 'm': case 'M':
1781     case 'n': case 'N':
1782     case 'o': case 'O':
1783     case 'p': case 'P':
1784     case 'q': case 'Q':
1785     case 'r': case 'R':
1786     case 's': case 'S':
1787     case 't': case 'T':
1788     case 'u': case 'U':
1789     case 'v': case 'V':
1790     case 'w': case 'W':
1791               case 'X':
1792     case 'y': case 'Y':
1793     case 'z': case 'Z':
1794
1795       keylookup:
1796         d = s;
1797         s = scan_word(s, tokenbuf, FALSE, &len);
1798
1799         switch (tmp = keyword(tokenbuf, len)) {
1800
1801         default:                        /* not a keyword */
1802           just_a_word: {
1803                 GV *gv;
1804
1805                 /* Get the rest if it looks like a package qualifier */
1806
1807                 if (*s == '\'' || *s == ':')
1808                     s = scan_word(s, tokenbuf + len, TRUE, &len);
1809
1810                 /* Do special processing at start of statement. */
1811
1812                 if (expect == XSTATE) {
1813                     while (isSPACE(*s)) s++;
1814                     if (*s == ':') {    /* It's a label. */
1815                         yylval.pval = savestr(tokenbuf);
1816                         s++;
1817                         CLINE;
1818                         TOKEN(LABEL);
1819                     }
1820                 }
1821                 else if (dowarn && expect == XOPERATOR) {
1822                     if (bufptr == SvPVX(linestr)) {
1823                         curcop->cop_line--;
1824                         warn(warn_nosemi);
1825                         curcop->cop_line++;
1826                     }
1827                     else
1828                         no_op("Bare word",s);
1829                 }
1830
1831                 /* Look for a subroutine with this name in current package. */
1832
1833                 gv = gv_fetchpv(tokenbuf,FALSE);
1834
1835                 /* See if it's the indirect object for a list operator. */
1836
1837                 if (oldoldbufptr && oldoldbufptr < bufptr) {
1838                     if (oldoldbufptr == last_lop &&
1839                         (!gv || !GvCV(gv) || last_lop_op == OP_SORT))
1840                     {
1841                         expect = XTERM;
1842                         CLINE;
1843                         yylval.opval = (OP*)newSVOP(OP_CONST, 0,
1844                             newSVpv(tokenbuf,0));
1845                         yylval.opval->op_private = OPpCONST_BARE;
1846                         for (d = tokenbuf; *d && isLOWER(*d); d++) ;
1847                         if (dowarn && !*d)
1848                             warn(warn_reserved, tokenbuf);
1849                         TOKEN(WORD);
1850                     }
1851                 }
1852
1853                 /* If followed by a paren, it's certainly a subroutine. */
1854
1855                 expect = XOPERATOR;
1856                 s = skipspace(s);
1857                 if (*s == '(') {
1858                     CLINE;
1859                     nextval[nexttoke].opval =
1860                         (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
1861                     nextval[nexttoke].opval->op_private = OPpCONST_BARE;
1862                     expect = XOPERATOR;
1863                     force_next(WORD);
1864                     TOKEN('&');
1865                 }
1866                 CLINE;
1867                 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
1868                 yylval.opval->op_private = OPpCONST_BARE;
1869
1870                 /* If followed by var or block, call it a method (maybe). */
1871
1872                 if ((*s == '$' || *s == '{') && (!gv || !GvCV(gv))) {
1873                     last_lop = oldbufptr;
1874                     last_lop_op = OP_METHOD;
1875                     PREBLOCK(METHOD);
1876                 }
1877
1878                 /* If followed by a bareword, see if it looks like indir obj. */
1879
1880                 if (isALPHA(*s)) {
1881                     char *olds = s;
1882                     char tmpbuf[1024];
1883                     GV* indirgv;
1884                     s = scan_word(s, tmpbuf, TRUE, &len);
1885                     if (!keyword(tmpbuf, len)) {
1886                         SV* tmpsv = newSVpv(tmpbuf,0);
1887                         indirgv = gv_fetchpv(tmpbuf,FALSE);
1888                         if (!indirgv || !GvCV(indirgv)) {
1889                             if (!gv || !GvCV(gv) || fetch_stash(tmpsv, FALSE)) {
1890                                 nextval[nexttoke].opval =
1891                                     (OP*)newSVOP(OP_CONST, 0, tmpsv);
1892                                 nextval[nexttoke].opval->op_private =
1893                                     OPpCONST_BARE;
1894                                 expect = XTERM;
1895                                 force_next(WORD);
1896                                 TOKEN(METHOD);
1897                             }
1898                         }
1899                         SvREFCNT_dec(tmpsv);
1900                     }
1901                     s = olds;
1902                 }
1903
1904                 /* Not a method, so call it a subroutine (if defined) */
1905
1906                 if (gv && GvCV(gv)) {
1907                     nextval[nexttoke].opval = yylval.opval;
1908                     if (*s == '(') {
1909                         expect = XTERM;
1910                         force_next(WORD);
1911                         TOKEN('&');
1912                     }
1913                     last_lop = oldbufptr;
1914                     last_lop_op = OP_ENTERSUBR;
1915                     expect = XTERM;
1916                     force_next(WORD);
1917                     TOKEN(NOAMP);
1918                 }
1919
1920                 /* Call it a bare word */
1921
1922                 for (d = tokenbuf; *d && isLOWER(*d); d++) ;
1923                 if (dowarn && !*d)
1924                     warn(warn_reserved, tokenbuf);
1925                 TOKEN(WORD);
1926             }
1927
1928         case KEY___LINE__:
1929         case KEY___FILE__: {
1930             if (tokenbuf[2] == 'L')
1931                 (void)sprintf(tokenbuf,"%ld",(long)curcop->cop_line);
1932             else
1933                 strcpy(tokenbuf, SvPVX(GvSV(curcop->cop_filegv)));
1934             yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
1935             TERM(THING);
1936         }
1937
1938         case KEY___END__: {
1939             GV *gv;
1940             int fd;
1941
1942             /*SUPPRESS 560*/
1943             if (!in_eval && (gv = gv_fetchpv("DATA",FALSE))) {
1944                 SvMULTI_on(gv);
1945                 if (!GvIO(gv))
1946                     GvIO(gv) = newIO();
1947                 IoIFP(GvIO(gv)) = rsfp;
1948 #if defined(HAS_FCNTL) && defined(FFt_SETFD)
1949                 fd = fileno(rsfp);
1950                 fcntl(fd,FFt_SETFD,fd >= 3);
1951 #endif
1952                 if (preprocess)
1953                     IoTYPE(GvIO(gv)) = '|';
1954                 else if ((FILE*)rsfp == stdin)
1955                     IoTYPE(GvIO(gv)) = '-';
1956                 else
1957                     IoTYPE(GvIO(gv)) = '<';
1958                 rsfp = Nullfp;
1959             }
1960             goto fake_eof;
1961         }
1962
1963         case KEY_AUTOLOAD:
1964         case KEY_DESTROY:
1965         case KEY_BEGIN:
1966         case KEY_END:
1967             s = skipspace(s);
1968             if (expect == XSTATE && (minus_p || minus_n || *s == '{' )) {
1969                 s = bufptr;
1970                 goto really_sub;
1971             }
1972             goto just_a_word;
1973
1974         case KEY_abs:
1975             UNI(OP_ABS);
1976
1977         case KEY_alarm:
1978             UNI(OP_ALARM);
1979
1980         case KEY_accept:
1981             LOP(OP_ACCEPT);
1982
1983         case KEY_and:
1984             OPERATOR(ANDOP);
1985
1986         case KEY_atan2:
1987             LOP(OP_ATAN2);
1988
1989         case KEY_bind:
1990             LOP(OP_BIND);
1991
1992         case KEY_binmode:
1993             UNI(OP_BINMODE);
1994
1995         case KEY_bless:
1996             LOP(OP_BLESS);
1997
1998         case KEY_chop:
1999             UNI(OP_CHOP);
2000
2001         case KEY_continue:
2002             PREBLOCK(CONTINUE);
2003
2004         case KEY_chdir:
2005             (void)gv_fetchpv("ENV",TRUE);       /* may use HOME */
2006             UNI(OP_CHDIR);
2007
2008         case KEY_close:
2009             UNI(OP_CLOSE);
2010
2011         case KEY_closedir:
2012             UNI(OP_CLOSEDIR);
2013
2014         case KEY_cmp:
2015             Eop(OP_SCMP);
2016
2017         case KEY_caller:
2018             UNI(OP_CALLER);
2019
2020         case KEY_crypt:
2021 #ifdef FCRYPT
2022             if (!cryptseen++)
2023                 init_des();
2024 #endif
2025             LOP(OP_CRYPT);
2026
2027         case KEY_chmod:
2028             s = skipspace(s);
2029             if (dowarn && *s != '0' && isDIGIT(*s))
2030                 yywarn("chmod: mode argument is missing initial 0");
2031             LOP(OP_CHMOD);
2032
2033         case KEY_chown:
2034             LOP(OP_CHOWN);
2035
2036         case KEY_connect:
2037             LOP(OP_CONNECT);
2038
2039         case KEY_chr:
2040             UNI(OP_CHR);
2041
2042         case KEY_cos:
2043             UNI(OP_COS);
2044
2045         case KEY_chroot:
2046             UNI(OP_CHROOT);
2047
2048         case KEY_do:
2049             s = skipspace(s);
2050             if (*s == '{')
2051                 PREBLOCK(DO);
2052             if (*s != '\'')
2053                 s = force_word(s,WORD,FALSE,TRUE);
2054             OPERATOR(DO);
2055
2056         case KEY_die:
2057             LOP(OP_DIE);
2058
2059         case KEY_defined:
2060             UNI(OP_DEFINED);
2061
2062         case KEY_delete:
2063             OPERATOR(DELETE);
2064
2065         case KEY_dbmopen:
2066             LOP(OP_DBMOPEN);
2067
2068         case KEY_dbmclose:
2069             UNI(OP_DBMCLOSE);
2070
2071         case KEY_dump:
2072             s = force_word(s,WORD,TRUE,FALSE);
2073             LOOPX(OP_DUMP);
2074
2075         case KEY_else:
2076             PREBLOCK(ELSE);
2077
2078         case KEY_elsif:
2079             yylval.ival = curcop->cop_line;
2080             OPERATOR(ELSIF);
2081
2082         case KEY_eq:
2083             Eop(OP_SEQ);
2084
2085         case KEY_exit:
2086             UNI(OP_EXIT);
2087
2088         case KEY_eval:
2089             s = skipspace(s);
2090             expect = (*s == '{') ? XBLOCK : XTERM;
2091             UNIBRACK(OP_ENTEREVAL);
2092
2093         case KEY_eof:
2094             UNI(OP_EOF);
2095
2096         case KEY_exp:
2097             UNI(OP_EXP);
2098
2099         case KEY_each:
2100             UNI(OP_EACH);
2101
2102         case KEY_exec:
2103             set_csh();
2104             LOP(OP_EXEC);
2105
2106         case KEY_endhostent:
2107             FUN0(OP_EHOSTENT);
2108
2109         case KEY_endnetent:
2110             FUN0(OP_ENETENT);
2111
2112         case KEY_endservent:
2113             FUN0(OP_ESERVENT);
2114
2115         case KEY_endprotoent:
2116             FUN0(OP_EPROTOENT);
2117
2118         case KEY_endpwent:
2119             FUN0(OP_EPWENT);
2120
2121         case KEY_endgrent:
2122             FUN0(OP_EGRENT);
2123
2124         case KEY_for:
2125         case KEY_foreach:
2126             yylval.ival = curcop->cop_line;
2127             while (s < bufend && isSPACE(*s))
2128                 s++;
2129             if (isIDFIRST(*s))
2130                 croak("Missing $ on loop variable");
2131             OPERATOR(FOR);
2132
2133         case KEY_formline:
2134             LOP(OP_FORMLINE);
2135
2136         case KEY_fork:
2137             FUN0(OP_FORK);
2138
2139         case KEY_fcntl:
2140             LOP(OP_FCNTL);
2141
2142         case KEY_fileno:
2143             UNI(OP_FILENO);
2144
2145         case KEY_flock:
2146             LOP(OP_FLOCK);
2147
2148         case KEY_gt:
2149             Rop(OP_SGT);
2150
2151         case KEY_ge:
2152             Rop(OP_SGE);
2153
2154         case KEY_grep:
2155             LOP(OP_GREPSTART);
2156
2157         case KEY_goto:
2158             s = force_word(s,WORD,TRUE,FALSE);
2159             LOOPX(OP_GOTO);
2160
2161         case KEY_gmtime:
2162             UNI(OP_GMTIME);
2163
2164         case KEY_getc:
2165             UNI(OP_GETC);
2166
2167         case KEY_getppid:
2168             FUN0(OP_GETPPID);
2169
2170         case KEY_getpgrp:
2171             UNI(OP_GETPGRP);
2172
2173         case KEY_getpriority:
2174             LOP(OP_GETPRIORITY);
2175
2176         case KEY_getprotobyname:
2177             UNI(OP_GPBYNAME);
2178
2179         case KEY_getprotobynumber:
2180             LOP(OP_GPBYNUMBER);
2181
2182         case KEY_getprotoent:
2183             FUN0(OP_GPROTOENT);
2184
2185         case KEY_getpwent:
2186             FUN0(OP_GPWENT);
2187
2188         case KEY_getpwnam:
2189             FUN1(OP_GPWNAM);
2190
2191         case KEY_getpwuid:
2192             FUN1(OP_GPWUID);
2193
2194         case KEY_getpeername:
2195             UNI(OP_GETPEERNAME);
2196
2197         case KEY_gethostbyname:
2198             UNI(OP_GHBYNAME);
2199
2200         case KEY_gethostbyaddr:
2201             LOP(OP_GHBYADDR);
2202
2203         case KEY_gethostent:
2204             FUN0(OP_GHOSTENT);
2205
2206         case KEY_getnetbyname:
2207             UNI(OP_GNBYNAME);
2208
2209         case KEY_getnetbyaddr:
2210             LOP(OP_GNBYADDR);
2211
2212         case KEY_getnetent:
2213             FUN0(OP_GNETENT);
2214
2215         case KEY_getservbyname:
2216             LOP(OP_GSBYNAME);
2217
2218         case KEY_getservbyport:
2219             LOP(OP_GSBYPORT);
2220
2221         case KEY_getservent:
2222             FUN0(OP_GSERVENT);
2223
2224         case KEY_getsockname:
2225             UNI(OP_GETSOCKNAME);
2226
2227         case KEY_getsockopt:
2228             LOP(OP_GSOCKOPT);
2229
2230         case KEY_getgrent:
2231             FUN0(OP_GGRENT);
2232
2233         case KEY_getgrnam:
2234             FUN1(OP_GGRNAM);
2235
2236         case KEY_getgrgid:
2237             FUN1(OP_GGRGID);
2238
2239         case KEY_getlogin:
2240             FUN0(OP_GETLOGIN);
2241
2242         case KEY_glob:
2243             UNI(OP_GLOB);
2244
2245         case KEY_hex:
2246             UNI(OP_HEX);
2247
2248         case KEY_if:
2249             yylval.ival = curcop->cop_line;
2250             OPERATOR(IF);
2251
2252         case KEY_index:
2253             LOP(OP_INDEX);
2254
2255         case KEY_int:
2256             UNI(OP_INT);
2257
2258         case KEY_ioctl:
2259             LOP(OP_IOCTL);
2260
2261         case KEY_join:
2262             LOP(OP_JOIN);
2263
2264         case KEY_keys:
2265             UNI(OP_KEYS);
2266
2267         case KEY_kill:
2268             LOP(OP_KILL);
2269
2270         case KEY_last:
2271             s = force_word(s,WORD,TRUE,FALSE);
2272             LOOPX(OP_LAST);
2273
2274         case KEY_lc:
2275             UNI(OP_LC);
2276
2277         case KEY_lcfirst:
2278             UNI(OP_LCFIRST);
2279
2280         case KEY_local:
2281             yylval.ival = 0;
2282             OPERATOR(LOCAL);
2283
2284         case KEY_length:
2285             UNI(OP_LENGTH);
2286
2287         case KEY_lt:
2288             Rop(OP_SLT);
2289
2290         case KEY_le:
2291             Rop(OP_SLE);
2292
2293         case KEY_localtime:
2294             UNI(OP_LOCALTIME);
2295
2296         case KEY_log:
2297             UNI(OP_LOG);
2298
2299         case KEY_link:
2300             LOP(OP_LINK);
2301
2302         case KEY_listen:
2303             LOP(OP_LISTEN);
2304
2305         case KEY_lstat:
2306             UNI(OP_LSTAT);
2307
2308         case KEY_m:
2309             s = scan_pat(s);
2310             TERM(sublex_start());
2311
2312         case KEY_mkdir:
2313             LOP(OP_MKDIR);
2314
2315         case KEY_msgctl:
2316             LOP(OP_MSGCTL);
2317
2318         case KEY_msgget:
2319             LOP(OP_MSGGET);
2320
2321         case KEY_msgrcv:
2322             LOP(OP_MSGRCV);
2323
2324         case KEY_msgsnd:
2325             LOP(OP_MSGSND);
2326
2327         case KEY_my:
2328             in_my = TRUE;
2329             yylval.ival = 1;
2330             OPERATOR(LOCAL);
2331
2332         case KEY_next:
2333             s = force_word(s,WORD,TRUE,FALSE);
2334             LOOPX(OP_NEXT);
2335
2336         case KEY_ne:
2337             Eop(OP_SNE);
2338
2339         case KEY_open:
2340             s = skipspace(s);
2341             if (isIDFIRST(*s)) {
2342                 char *t;
2343                 for (d = s; isALNUM(*d); d++) ;
2344                 t = skipspace(d);
2345                 if (strchr("|&*+-=!?:.", *t))
2346                     warn("Precedence problem: open %.*s should be open(%.*s)",
2347                         d-s,s, d-s,s);
2348             }
2349             LOP(OP_OPEN);
2350
2351         case KEY_or:
2352             OPERATOR(OROP);
2353
2354         case KEY_ord:
2355             UNI(OP_ORD);
2356
2357         case KEY_oct:
2358             UNI(OP_OCT);
2359
2360         case KEY_opendir:
2361             LOP(OP_OPEN_DIR);
2362
2363         case KEY_print:
2364             checkcomma(s,tokenbuf,"filehandle");
2365             LOP(OP_PRINT);
2366
2367         case KEY_printf:
2368             checkcomma(s,tokenbuf,"filehandle");
2369             LOP(OP_PRTF);
2370
2371         case KEY_push:
2372             LOP(OP_PUSH);
2373
2374         case KEY_pop:
2375             UNI(OP_POP);
2376
2377         case KEY_pack:
2378             LOP(OP_PACK);
2379
2380         case KEY_package:
2381             s = force_word(s,WORD,FALSE,TRUE);
2382             OPERATOR(PACKAGE);
2383
2384         case KEY_pipe:
2385             LOP(OP_PIPE_OP);
2386
2387         case KEY_q:
2388             s = scan_str(s);
2389             if (!s)
2390                 missingterm(0);
2391             yylval.ival = OP_CONST;
2392             TERM(sublex_start());
2393
2394         case KEY_qw:
2395             s = scan_str(s);
2396             if (!s)
2397                 missingterm(0);
2398             force_next(')');
2399             nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, q(lex_stuff));
2400             lex_stuff = Nullsv;
2401             force_next(THING);
2402             force_next(',');
2403             nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(" ",1));
2404             force_next(THING);
2405             force_next('(');
2406             LOP(OP_SPLIT);
2407
2408         case KEY_qq:
2409             s = scan_str(s);
2410             if (!s)
2411                 missingterm(0);
2412             yylval.ival = OP_SCALAR;
2413             if (SvIVX(lex_stuff) == '\'')
2414                 SvIVX(lex_stuff) = 0;   /* qq'$foo' should intepolate */
2415             TERM(sublex_start());
2416
2417         case KEY_qx:
2418             s = scan_str(s);
2419             if (!s)
2420                 missingterm(0);
2421             yylval.ival = OP_BACKTICK;
2422             set_csh();
2423             TERM(sublex_start());
2424
2425         case KEY_return:
2426             OLDLOP(OP_RETURN);
2427
2428         case KEY_require:
2429             s = force_word(s,WORD,TRUE,FALSE);
2430             UNI(OP_REQUIRE);
2431
2432         case KEY_reset:
2433             UNI(OP_RESET);
2434
2435         case KEY_redo:
2436             s = force_word(s,WORD,TRUE,FALSE);
2437             LOOPX(OP_REDO);
2438
2439         case KEY_rename:
2440             LOP(OP_RENAME);
2441
2442         case KEY_rand:
2443             UNI(OP_RAND);
2444
2445         case KEY_rmdir:
2446             UNI(OP_RMDIR);
2447
2448         case KEY_rindex:
2449             LOP(OP_RINDEX);
2450
2451         case KEY_read:
2452             LOP(OP_READ);
2453
2454         case KEY_readdir:
2455             UNI(OP_READDIR);
2456
2457         case KEY_readline:
2458             set_csh();
2459             UNI(OP_READLINE);
2460
2461         case KEY_readpipe:
2462             set_csh();
2463             UNI(OP_BACKTICK);
2464
2465         case KEY_rewinddir:
2466             UNI(OP_REWINDDIR);
2467
2468         case KEY_recv:
2469             LOP(OP_RECV);
2470
2471         case KEY_reverse:
2472             LOP(OP_REVERSE);
2473
2474         case KEY_readlink:
2475             UNI(OP_READLINK);
2476
2477         case KEY_ref:
2478             UNI(OP_REF);
2479
2480         case KEY_s:
2481             s = scan_subst(s);
2482             if (yylval.opval)
2483                 TERM(sublex_start());
2484             else
2485                 TOKEN(1);       /* force error */
2486
2487         case KEY_scalar:
2488             UNI(OP_SCALAR);
2489
2490         case KEY_select:
2491             LOP(OP_SELECT);
2492
2493         case KEY_seek:
2494             LOP(OP_SEEK);
2495
2496         case KEY_semctl:
2497             LOP(OP_SEMCTL);
2498
2499         case KEY_semget:
2500             LOP(OP_SEMGET);
2501
2502         case KEY_semop:
2503             LOP(OP_SEMOP);
2504
2505         case KEY_send:
2506             LOP(OP_SEND);
2507
2508         case KEY_setpgrp:
2509             LOP(OP_SETPGRP);
2510
2511         case KEY_setpriority:
2512             LOP(OP_SETPRIORITY);
2513
2514         case KEY_sethostent:
2515             FUN1(OP_SHOSTENT);
2516
2517         case KEY_setnetent:
2518             FUN1(OP_SNETENT);
2519
2520         case KEY_setservent:
2521             FUN1(OP_SSERVENT);
2522
2523         case KEY_setprotoent:
2524             FUN1(OP_SPROTOENT);
2525
2526         case KEY_setpwent:
2527             FUN0(OP_SPWENT);
2528
2529         case KEY_setgrent:
2530             FUN0(OP_SGRENT);
2531
2532         case KEY_seekdir:
2533             LOP(OP_SEEKDIR);
2534
2535         case KEY_setsockopt:
2536             LOP(OP_SSOCKOPT);
2537
2538         case KEY_shift:
2539             UNI(OP_SHIFT);
2540
2541         case KEY_shmctl:
2542             LOP(OP_SHMCTL);
2543
2544         case KEY_shmget:
2545             LOP(OP_SHMGET);
2546
2547         case KEY_shmread:
2548             LOP(OP_SHMREAD);
2549
2550         case KEY_shmwrite:
2551             LOP(OP_SHMWRITE);
2552
2553         case KEY_shutdown:
2554             LOP(OP_SHUTDOWN);
2555
2556         case KEY_sin:
2557             UNI(OP_SIN);
2558
2559         case KEY_sleep:
2560             UNI(OP_SLEEP);
2561
2562         case KEY_socket:
2563             LOP(OP_SOCKET);
2564
2565         case KEY_socketpair:
2566             LOP(OP_SOCKPAIR);
2567
2568         case KEY_sort:
2569             checkcomma(s,tokenbuf,"subroutine name");
2570             s = skipspace(s);
2571             if (*s == ';' || *s == ')')         /* probably a close */
2572                 croak("sort is now a reserved word");
2573             expect = XTERM;
2574             s = force_word(s,WORD,TRUE,TRUE);
2575             LOP(OP_SORT);
2576
2577         case KEY_split:
2578             LOP(OP_SPLIT);
2579
2580         case KEY_sprintf:
2581             LOP(OP_SPRINTF);
2582
2583         case KEY_splice:
2584             LOP(OP_SPLICE);
2585
2586         case KEY_sqrt:
2587             UNI(OP_SQRT);
2588
2589         case KEY_srand:
2590             UNI(OP_SRAND);
2591
2592         case KEY_stat:
2593             UNI(OP_STAT);
2594
2595         case KEY_study:
2596             sawstudy++;
2597             UNI(OP_STUDY);
2598
2599         case KEY_substr:
2600             LOP(OP_SUBSTR);
2601
2602         case KEY_format:
2603         case KEY_sub:
2604           really_sub:
2605             yylval.ival = start_subparse();
2606             s = skipspace(s);
2607             if (tmp == KEY_format)
2608                 expect = XTERM;
2609             else
2610                 expect = XBLOCK;
2611             if (isIDFIRST(*s) || *s == '\'' || *s == ':') {
2612                 char tmpbuf[128];
2613                 d = scan_word(s, tmpbuf, TRUE, &len);
2614                 if (strchr(tmpbuf, ':'))
2615                     sv_setpv(subname, tmpbuf);
2616                 else {
2617                     sv_setsv(subname,curstname);
2618                     sv_catpvn(subname,"::",2);
2619                     sv_catpvn(subname,tmpbuf,len);
2620                 }
2621                 s = force_word(s,WORD,FALSE,TRUE);
2622             }
2623             else
2624                 sv_setpv(subname,"?");
2625
2626             if (tmp != KEY_format)
2627                 PREBLOCK(SUB);
2628
2629             in_format = 2;
2630             lex_brackets = 0;
2631             OPERATOR(FORMAT);
2632
2633         case KEY_system:
2634             set_csh();
2635             LOP(OP_SYSTEM);
2636
2637         case KEY_symlink:
2638             LOP(OP_SYMLINK);
2639
2640         case KEY_syscall:
2641             LOP(OP_SYSCALL);
2642
2643         case KEY_sysread:
2644             LOP(OP_SYSREAD);
2645
2646         case KEY_syswrite:
2647             LOP(OP_SYSWRITE);
2648
2649         case KEY_tr:
2650             s = scan_trans(s);
2651             TERM(sublex_start());
2652
2653         case KEY_tell:
2654             UNI(OP_TELL);
2655
2656         case KEY_telldir:
2657             UNI(OP_TELLDIR);
2658
2659         case KEY_tie:
2660             LOP(OP_TIE);
2661
2662         case KEY_time:
2663             FUN0(OP_TIME);
2664
2665         case KEY_times:
2666             FUN0(OP_TMS);
2667
2668         case KEY_truncate:
2669             LOP(OP_TRUNCATE);
2670
2671         case KEY_uc:
2672             UNI(OP_UC);
2673
2674         case KEY_ucfirst:
2675             UNI(OP_UCFIRST);
2676
2677         case KEY_untie:
2678             UNI(OP_UNTIE);
2679
2680         case KEY_until:
2681             yylval.ival = curcop->cop_line;
2682             OPERATOR(UNTIL);
2683
2684         case KEY_unless:
2685             yylval.ival = curcop->cop_line;
2686             OPERATOR(UNLESS);
2687
2688         case KEY_unlink:
2689             LOP(OP_UNLINK);
2690
2691         case KEY_undef:
2692             UNI(OP_UNDEF);
2693
2694         case KEY_unpack:
2695             LOP(OP_UNPACK);
2696
2697         case KEY_utime:
2698             LOP(OP_UTIME);
2699
2700         case KEY_umask:
2701             s = skipspace(s);
2702             if (dowarn && *s != '0' && isDIGIT(*s))
2703                 warn("umask: argument is missing initial 0");
2704             UNI(OP_UMASK);
2705
2706         case KEY_unshift:
2707             LOP(OP_UNSHIFT);
2708
2709         case KEY_values:
2710             UNI(OP_VALUES);
2711
2712         case KEY_vec:
2713             sawvec = TRUE;
2714             LOP(OP_VEC);
2715
2716         case KEY_while:
2717             yylval.ival = curcop->cop_line;
2718             OPERATOR(WHILE);
2719
2720         case KEY_warn:
2721             LOP(OP_WARN);
2722
2723         case KEY_wait:
2724             FUN0(OP_WAIT);
2725
2726         case KEY_waitpid:
2727             LOP(OP_WAITPID);
2728
2729         case KEY_wantarray:
2730             FUN0(OP_WANTARRAY);
2731
2732         case KEY_write:
2733             UNI(OP_ENTERWRITE);
2734
2735         case KEY_x:
2736             if (expect == XOPERATOR)
2737                 Mop(OP_REPEAT);
2738             check_uni();
2739             goto just_a_word;
2740
2741         case KEY_y:
2742             s = scan_trans(s);
2743             TERM(sublex_start());
2744         }
2745     }
2746 }
2747
2748 I32
2749 keyword(d, len)
2750 register char *d;
2751 I32 len;
2752 {
2753     switch (*d) {
2754     case '_':
2755         if (d[1] == '_') {
2756             if (strEQ(d,"__LINE__"))            return KEY___LINE__;
2757             if (strEQ(d,"__FILE__"))            return KEY___FILE__;
2758             if (strEQ(d,"__END__"))             return KEY___END__;
2759         }
2760         break;
2761     case 'A':
2762         if (strEQ(d,"AUTOLOAD"))                return KEY_AUTOLOAD;
2763         break;
2764     case 'a':
2765         switch (len) {
2766         case 3:
2767             if (strEQ(d,"and"))                 return KEY_and;
2768             if (strEQ(d,"abs"))                 return KEY_abs;
2769             break;
2770         case 5:
2771             if (strEQ(d,"alarm"))               return KEY_alarm;
2772             if (strEQ(d,"atan2"))               return KEY_atan2;
2773             break;
2774         case 6:
2775             if (strEQ(d,"accept"))              return KEY_accept;
2776             break;
2777         }
2778         break;
2779     case 'B':
2780         if (strEQ(d,"BEGIN"))                   return KEY_BEGIN;
2781         break;
2782     case 'b':
2783         if (strEQ(d,"bless"))                   return KEY_bless;
2784         if (strEQ(d,"bind"))                    return KEY_bind;
2785         if (strEQ(d,"binmode"))                 return KEY_binmode;
2786         break;
2787     case 'c':
2788         switch (len) {
2789         case 3:
2790             if (strEQ(d,"cmp"))                 return KEY_cmp;
2791             if (strEQ(d,"chr"))                 return KEY_chr;
2792             if (strEQ(d,"cos"))                 return KEY_cos;
2793             break;
2794         case 4:
2795             if (strEQ(d,"chop"))                return KEY_chop;
2796             break;
2797         case 5:
2798             if (strEQ(d,"close"))               return KEY_close;
2799             if (strEQ(d,"chdir"))               return KEY_chdir;
2800             if (strEQ(d,"chmod"))               return KEY_chmod;
2801             if (strEQ(d,"chown"))               return KEY_chown;
2802             if (strEQ(d,"crypt"))               return KEY_crypt;
2803             break;
2804         case 6:
2805             if (strEQ(d,"chroot"))              return KEY_chroot;
2806             if (strEQ(d,"caller"))              return KEY_caller;
2807             break;
2808         case 7:
2809             if (strEQ(d,"connect"))             return KEY_connect;
2810             break;
2811         case 8:
2812             if (strEQ(d,"closedir"))            return KEY_closedir;
2813             if (strEQ(d,"continue"))            return KEY_continue;
2814             break;
2815         }
2816         break;
2817     case 'D':
2818         if (strEQ(d,"DESTROY"))                 return KEY_DESTROY;
2819         break;
2820     case 'd':
2821         switch (len) {
2822         case 2:
2823             if (strEQ(d,"do"))                  return KEY_do;
2824             break;
2825         case 3:
2826             if (strEQ(d,"die"))                 return KEY_die;
2827             break;
2828         case 4:
2829             if (strEQ(d,"dump"))                return KEY_dump;
2830             break;
2831         case 6:
2832             if (strEQ(d,"delete"))              return KEY_delete;
2833             break;
2834         case 7:
2835             if (strEQ(d,"defined"))             return KEY_defined;
2836             if (strEQ(d,"dbmopen"))             return KEY_dbmopen;
2837             break;
2838         case 8:
2839             if (strEQ(d,"dbmclose"))            return KEY_dbmclose;
2840             break;
2841         }
2842         break;
2843     case 'E':
2844         if (strEQ(d,"EQ"))                      return KEY_eq;
2845         if (strEQ(d,"END"))                     return KEY_END;
2846         break;
2847     case 'e':
2848         switch (len) {
2849         case 2:
2850             if (strEQ(d,"eq"))                  return KEY_eq;
2851             break;
2852         case 3:
2853             if (strEQ(d,"eof"))                 return KEY_eof;
2854             if (strEQ(d,"exp"))                 return KEY_exp;
2855             break;
2856         case 4:
2857             if (strEQ(d,"else"))                return KEY_else;
2858             if (strEQ(d,"exit"))                return KEY_exit;
2859             if (strEQ(d,"eval"))                return KEY_eval;
2860             if (strEQ(d,"exec"))                return KEY_exec;
2861             if (strEQ(d,"each"))                return KEY_each;
2862             break;
2863         case 5:
2864             if (strEQ(d,"elsif"))               return KEY_elsif;
2865             break;
2866         case 8:
2867             if (strEQ(d,"endgrent"))            return KEY_endgrent;
2868             if (strEQ(d,"endpwent"))            return KEY_endpwent;
2869             break;
2870         case 9:
2871             if (strEQ(d,"endnetent"))           return KEY_endnetent;
2872             break;
2873         case 10:
2874             if (strEQ(d,"endhostent"))          return KEY_endhostent;
2875             if (strEQ(d,"endservent"))          return KEY_endservent;
2876             break;
2877         case 11:
2878             if (strEQ(d,"endprotoent"))         return KEY_endprotoent;
2879             break;
2880         }
2881         break;
2882     case 'f':
2883         switch (len) {
2884         case 3:
2885             if (strEQ(d,"for"))                 return KEY_for;
2886             break;
2887         case 4:
2888             if (strEQ(d,"fork"))                return KEY_fork;
2889             break;
2890         case 5:
2891             if (strEQ(d,"fcntl"))               return KEY_fcntl;
2892             if (strEQ(d,"flock"))               return KEY_flock;
2893             break;
2894         case 6:
2895             if (strEQ(d,"format"))              return KEY_format;
2896             if (strEQ(d,"fileno"))              return KEY_fileno;
2897             break;
2898         case 7:
2899             if (strEQ(d,"foreach"))             return KEY_foreach;
2900             break;
2901         case 8:
2902             if (strEQ(d,"formline"))            return KEY_formline;
2903             break;
2904         }
2905         break;
2906     case 'G':
2907         if (len == 2) {
2908             if (strEQ(d,"GT"))                  return KEY_gt;
2909             if (strEQ(d,"GE"))                  return KEY_ge;
2910         }
2911         break;
2912     case 'g':
2913         if (strnEQ(d,"get",3)) {
2914             d += 3;
2915             if (*d == 'p') {
2916                 switch (len) {
2917                 case 7:
2918                     if (strEQ(d,"ppid"))        return KEY_getppid;
2919                     if (strEQ(d,"pgrp"))        return KEY_getpgrp;
2920                     break;
2921                 case 8:
2922                     if (strEQ(d,"pwent"))       return KEY_getpwent;
2923                     if (strEQ(d,"pwnam"))       return KEY_getpwnam;
2924                     if (strEQ(d,"pwuid"))       return KEY_getpwuid;
2925                     break;
2926                 case 11:
2927                     if (strEQ(d,"peername"))    return KEY_getpeername;
2928                     if (strEQ(d,"protoent"))    return KEY_getprotoent;
2929                     if (strEQ(d,"priority"))    return KEY_getpriority;
2930                     break;
2931                 case 14:
2932                     if (strEQ(d,"protobyname")) return KEY_getprotobyname;
2933                     break;
2934                 case 16:
2935                     if (strEQ(d,"protobynumber"))return KEY_getprotobynumber;
2936                     break;
2937                 }
2938             }
2939             else if (*d == 'h') {
2940                 if (strEQ(d,"hostbyname"))      return KEY_gethostbyname;
2941                 if (strEQ(d,"hostbyaddr"))      return KEY_gethostbyaddr;
2942                 if (strEQ(d,"hostent"))         return KEY_gethostent;
2943             }
2944             else if (*d == 'n') {
2945                 if (strEQ(d,"netbyname"))       return KEY_getnetbyname;
2946                 if (strEQ(d,"netbyaddr"))       return KEY_getnetbyaddr;
2947                 if (strEQ(d,"netent"))          return KEY_getnetent;
2948             }
2949             else if (*d == 's') {
2950                 if (strEQ(d,"servbyname"))      return KEY_getservbyname;
2951                 if (strEQ(d,"servbyport"))      return KEY_getservbyport;
2952                 if (strEQ(d,"servent"))         return KEY_getservent;
2953                 if (strEQ(d,"sockname"))        return KEY_getsockname;
2954                 if (strEQ(d,"sockopt"))         return KEY_getsockopt;
2955             }
2956             else if (*d == 'g') {
2957                 if (strEQ(d,"grent"))           return KEY_getgrent;
2958                 if (strEQ(d,"grnam"))           return KEY_getgrnam;
2959                 if (strEQ(d,"grgid"))           return KEY_getgrgid;
2960             }
2961             else if (*d == 'l') {
2962                 if (strEQ(d,"login"))           return KEY_getlogin;
2963             }
2964             else if (strEQ(d,"c"))              return KEY_getc;
2965             break;
2966         }
2967         switch (len) {
2968         case 2:
2969             if (strEQ(d,"gt"))                  return KEY_gt;
2970             if (strEQ(d,"ge"))                  return KEY_ge;
2971             break;
2972         case 4:
2973             if (strEQ(d,"grep"))                return KEY_grep;
2974             if (strEQ(d,"goto"))                return KEY_goto;
2975             if (strEQ(d,"glob"))                return KEY_glob;
2976             break;
2977         case 6:
2978             if (strEQ(d,"gmtime"))              return KEY_gmtime;
2979             break;
2980         }
2981         break;
2982     case 'h':
2983         if (strEQ(d,"hex"))                     return KEY_hex;
2984         break;
2985     case 'i':
2986         switch (len) {
2987         case 2:
2988             if (strEQ(d,"if"))                  return KEY_if;
2989             break;
2990         case 3:
2991             if (strEQ(d,"int"))                 return KEY_int;
2992             break;
2993         case 5:
2994             if (strEQ(d,"index"))               return KEY_index;
2995             if (strEQ(d,"ioctl"))               return KEY_ioctl;
2996             break;
2997         }
2998         break;
2999     case 'j':
3000         if (strEQ(d,"join"))                    return KEY_join;
3001         break;
3002     case 'k':
3003         if (len == 4) {
3004             if (strEQ(d,"keys"))                return KEY_keys;
3005             if (strEQ(d,"kill"))                return KEY_kill;
3006         }
3007         break;
3008     case 'L':
3009         if (len == 2) {
3010             if (strEQ(d,"LT"))                  return KEY_lt;
3011             if (strEQ(d,"LE"))                  return KEY_le;
3012         }
3013         break;
3014     case 'l':
3015         switch (len) {
3016         case 2:
3017             if (strEQ(d,"lt"))                  return KEY_lt;
3018             if (strEQ(d,"le"))                  return KEY_le;
3019             if (strEQ(d,"lc"))                  return KEY_lc;
3020             break;
3021         case 3:
3022             if (strEQ(d,"log"))                 return KEY_log;
3023             break;
3024         case 4:
3025             if (strEQ(d,"last"))                return KEY_last;
3026             if (strEQ(d,"link"))                return KEY_link;
3027             break;
3028         case 5:
3029             if (strEQ(d,"local"))               return KEY_local;
3030             if (strEQ(d,"lstat"))               return KEY_lstat;
3031             break;
3032         case 6:
3033             if (strEQ(d,"length"))              return KEY_length;
3034             if (strEQ(d,"listen"))              return KEY_listen;
3035             break;
3036         case 7:
3037             if (strEQ(d,"lcfirst"))             return KEY_lcfirst;
3038             break;
3039         case 9:
3040             if (strEQ(d,"localtime"))           return KEY_localtime;
3041             break;
3042         }
3043         break;
3044     case 'm':
3045         switch (len) {
3046         case 1:                                 return KEY_m;
3047         case 2:
3048             if (strEQ(d,"my"))                  return KEY_my;
3049             break;
3050         case 5:
3051             if (strEQ(d,"mkdir"))               return KEY_mkdir;
3052             break;
3053         case 6:
3054             if (strEQ(d,"msgctl"))              return KEY_msgctl;
3055             if (strEQ(d,"msgget"))              return KEY_msgget;
3056             if (strEQ(d,"msgrcv"))              return KEY_msgrcv;
3057             if (strEQ(d,"msgsnd"))              return KEY_msgsnd;
3058             break;
3059         }
3060         break;
3061     case 'N':
3062         if (strEQ(d,"NE"))                      return KEY_ne;
3063         break;
3064     case 'n':
3065         if (strEQ(d,"next"))                    return KEY_next;
3066         if (strEQ(d,"ne"))                      return KEY_ne;
3067         break;
3068     case 'o':
3069         switch (len) {
3070         case 2:
3071             if (strEQ(d,"or"))                  return KEY_or;
3072             break;
3073         case 3:
3074             if (strEQ(d,"ord"))                 return KEY_ord;
3075             if (strEQ(d,"oct"))                 return KEY_oct;
3076             break;
3077         case 4:
3078             if (strEQ(d,"open"))                return KEY_open;
3079             break;
3080         case 7:
3081             if (strEQ(d,"opendir"))             return KEY_opendir;
3082             break;
3083         }
3084         break;
3085     case 'p':
3086         switch (len) {
3087         case 3:
3088             if (strEQ(d,"pop"))                 return KEY_pop;
3089             break;
3090         case 4:
3091             if (strEQ(d,"push"))                return KEY_push;
3092             if (strEQ(d,"pack"))                return KEY_pack;
3093             if (strEQ(d,"pipe"))                return KEY_pipe;
3094             break;
3095         case 5:
3096             if (strEQ(d,"print"))               return KEY_print;
3097             break;
3098         case 6:
3099             if (strEQ(d,"printf"))              return KEY_printf;
3100             break;
3101         case 7:
3102             if (strEQ(d,"package"))             return KEY_package;
3103             break;
3104         }
3105         break;
3106     case 'q':
3107         if (len <= 2) {
3108             if (strEQ(d,"q"))                   return KEY_q;
3109             if (strEQ(d,"qq"))                  return KEY_qq;
3110             if (strEQ(d,"qw"))                  return KEY_qw;
3111             if (strEQ(d,"qx"))                  return KEY_qx;
3112         }
3113         break;
3114     case 'r':
3115         switch (len) {
3116         case 3:
3117             if (strEQ(d,"ref"))                 return KEY_ref;
3118             break;
3119         case 4:
3120             if (strEQ(d,"read"))                return KEY_read;
3121             if (strEQ(d,"rand"))                return KEY_rand;
3122             if (strEQ(d,"recv"))                return KEY_recv;
3123             if (strEQ(d,"redo"))                return KEY_redo;
3124             break;
3125         case 5:
3126             if (strEQ(d,"rmdir"))               return KEY_rmdir;
3127             if (strEQ(d,"reset"))               return KEY_reset;
3128             break;
3129         case 6:
3130             if (strEQ(d,"return"))              return KEY_return;
3131             if (strEQ(d,"rename"))              return KEY_rename;
3132             if (strEQ(d,"rindex"))              return KEY_rindex;
3133             break;
3134         case 7:
3135             if (strEQ(d,"require"))             return KEY_require;
3136             if (strEQ(d,"reverse"))             return KEY_reverse;
3137             if (strEQ(d,"readdir"))             return KEY_readdir;
3138             break;
3139         case 8:
3140             if (strEQ(d,"readlink"))            return KEY_readlink;
3141             if (strEQ(d,"readline"))            return KEY_readline;
3142             if (strEQ(d,"readpipe"))            return KEY_readpipe;
3143             break;
3144         case 9:
3145             if (strEQ(d,"rewinddir"))           return KEY_rewinddir;
3146             break;
3147         }
3148         break;
3149     case 's':
3150         switch (d[1]) {
3151         case 0:                                 return KEY_s;
3152         case 'c':
3153             if (strEQ(d,"scalar"))              return KEY_scalar;
3154             break;
3155         case 'e':
3156             switch (len) {
3157             case 4:
3158                 if (strEQ(d,"seek"))            return KEY_seek;
3159                 if (strEQ(d,"send"))            return KEY_send;
3160                 break;
3161             case 5:
3162                 if (strEQ(d,"semop"))           return KEY_semop;
3163                 break;
3164             case 6:
3165                 if (strEQ(d,"select"))          return KEY_select;
3166                 if (strEQ(d,"semctl"))          return KEY_semctl;
3167                 if (strEQ(d,"semget"))          return KEY_semget;
3168                 break;
3169             case 7:
3170                 if (strEQ(d,"setpgrp"))         return KEY_setpgrp;
3171                 if (strEQ(d,"seekdir"))         return KEY_seekdir;
3172                 break;
3173             case 8:
3174                 if (strEQ(d,"setpwent"))        return KEY_setpwent;
3175                 if (strEQ(d,"setgrent"))        return KEY_setgrent;
3176                 break;
3177             case 9:
3178                 if (strEQ(d,"setnetent"))       return KEY_setnetent;
3179                 break;
3180             case 10:
3181                 if (strEQ(d,"setsockopt"))      return KEY_setsockopt;
3182                 if (strEQ(d,"sethostent"))      return KEY_sethostent;
3183                 if (strEQ(d,"setservent"))      return KEY_setservent;
3184                 break;
3185             case 11:
3186                 if (strEQ(d,"setpriority"))     return KEY_setpriority;
3187                 if (strEQ(d,"setprotoent"))     return KEY_setprotoent;
3188                 break;
3189             }
3190             break;
3191         case 'h':
3192             switch (len) {
3193             case 5:
3194                 if (strEQ(d,"shift"))           return KEY_shift;
3195                 break;
3196             case 6:
3197                 if (strEQ(d,"shmctl"))          return KEY_shmctl;
3198                 if (strEQ(d,"shmget"))          return KEY_shmget;
3199                 break;
3200             case 7:
3201                 if (strEQ(d,"shmread"))         return KEY_shmread;
3202                 break;
3203             case 8:
3204                 if (strEQ(d,"shmwrite"))        return KEY_shmwrite;
3205                 if (strEQ(d,"shutdown"))        return KEY_shutdown;
3206                 break;
3207             }
3208             break;
3209         case 'i':
3210             if (strEQ(d,"sin"))                 return KEY_sin;
3211             break;
3212         case 'l':
3213             if (strEQ(d,"sleep"))               return KEY_sleep;
3214             break;
3215         case 'o':
3216             if (strEQ(d,"sort"))                return KEY_sort;
3217             if (strEQ(d,"socket"))              return KEY_socket;
3218             if (strEQ(d,"socketpair"))          return KEY_socketpair;
3219             break;
3220         case 'p':
3221             if (strEQ(d,"split"))               return KEY_split;
3222             if (strEQ(d,"sprintf"))             return KEY_sprintf;
3223             if (strEQ(d,"splice"))              return KEY_splice;
3224             break;
3225         case 'q':
3226             if (strEQ(d,"sqrt"))                return KEY_sqrt;
3227             break;
3228         case 'r':
3229             if (strEQ(d,"srand"))               return KEY_srand;
3230             break;
3231         case 't':
3232             if (strEQ(d,"stat"))                return KEY_stat;
3233             if (strEQ(d,"study"))               return KEY_study;
3234             break;
3235         case 'u':
3236             if (strEQ(d,"substr"))              return KEY_substr;
3237             if (strEQ(d,"sub"))                 return KEY_sub;
3238             break;
3239         case 'y':
3240             switch (len) {
3241             case 6:
3242                 if (strEQ(d,"system"))          return KEY_system;
3243                 break;
3244             case 7:
3245                 if (strEQ(d,"sysread"))         return KEY_sysread;
3246                 if (strEQ(d,"symlink"))         return KEY_symlink;
3247                 if (strEQ(d,"syscall"))         return KEY_syscall;
3248                 break;
3249             case 8:
3250                 if (strEQ(d,"syswrite"))        return KEY_syswrite;
3251                 break;
3252             }
3253             break;
3254         }
3255         break;
3256     case 't':
3257         switch (len) {
3258         case 2:
3259             if (strEQ(d,"tr"))                  return KEY_tr;
3260             break;
3261         case 3:
3262             if (strEQ(d,"tie"))                 return KEY_tie;
3263             break;
3264         case 4:
3265             if (strEQ(d,"tell"))                return KEY_tell;
3266             if (strEQ(d,"time"))                return KEY_time;
3267             break;
3268         case 5:
3269             if (strEQ(d,"times"))               return KEY_times;
3270             break;
3271         case 7:
3272             if (strEQ(d,"telldir"))             return KEY_telldir;
3273             break;
3274         case 8:
3275             if (strEQ(d,"truncate"))            return KEY_truncate;
3276             break;
3277         }
3278         break;
3279     case 'u':
3280         switch (len) {
3281         case 2:
3282             if (strEQ(d,"uc"))                  return KEY_uc;
3283             break;
3284         case 5:
3285             if (strEQ(d,"undef"))               return KEY_undef;
3286             if (strEQ(d,"until"))               return KEY_until;
3287             if (strEQ(d,"untie"))               return KEY_untie;
3288             if (strEQ(d,"utime"))               return KEY_utime;
3289             if (strEQ(d,"umask"))               return KEY_umask;
3290             break;
3291         case 6:
3292             if (strEQ(d,"unless"))              return KEY_unless;
3293             if (strEQ(d,"unpack"))              return KEY_unpack;
3294             if (strEQ(d,"unlink"))              return KEY_unlink;
3295             break;
3296         case 7:
3297             if (strEQ(d,"unshift"))             return KEY_unshift;
3298             if (strEQ(d,"ucfirst"))             return KEY_ucfirst;
3299             break;
3300         }
3301         break;
3302     case 'v':
3303         if (strEQ(d,"values"))                  return KEY_values;
3304         if (strEQ(d,"vec"))                     return KEY_vec;
3305         break;
3306     case 'w':
3307         switch (len) {
3308         case 4:
3309             if (strEQ(d,"warn"))                return KEY_warn;
3310             if (strEQ(d,"wait"))                return KEY_wait;
3311             break;
3312         case 5:
3313             if (strEQ(d,"while"))               return KEY_while;
3314             if (strEQ(d,"write"))               return KEY_write;
3315             break;
3316         case 7:
3317             if (strEQ(d,"waitpid"))             return KEY_waitpid;
3318             break;
3319         case 9:
3320             if (strEQ(d,"wantarray"))           return KEY_wantarray;
3321             break;
3322         }
3323         break;
3324     case 'x':
3325         if (len == 1)                           return KEY_x;
3326         break;
3327     case 'y':
3328         if (len == 1)                           return KEY_y;
3329         break;
3330     case 'z':
3331         break;
3332     }
3333     return 0;
3334 }
3335
3336 static void
3337 checkcomma(s,name,what)
3338 register char *s;
3339 char *name;
3340 char *what;
3341 {
3342     char *w;
3343
3344     if (dowarn && *s == ' ' && s[1] == '(') {   /* XXX gotta be a better way */
3345         w = strchr(s,')');
3346         if (w)
3347             for (w++; *w && isSPACE(*w); w++) ;
3348         if (!w || !*w || !strchr(";|}", *w))    /* an advisory hack only... */
3349             warn("%s (...) interpreted as function",name);
3350     }
3351     while (s < bufend && isSPACE(*s))
3352         s++;
3353     if (*s == '(')
3354         s++;
3355     while (s < bufend && isSPACE(*s))
3356         s++;
3357     if (isIDFIRST(*s)) {
3358         w = s++;
3359         while (isALNUM(*s))
3360             s++;
3361         while (s < bufend && isSPACE(*s))
3362             s++;
3363         if (*s == ',') {
3364             int kw;
3365             *s = '\0';
3366             kw = keyword(w, s - w);
3367             *s = ',';
3368             if (kw)
3369                 return;
3370             croak("No comma allowed after %s", what);
3371         }
3372     }
3373 }
3374
3375 static char *
3376 scan_word(s, dest, allow_package, slp)
3377 register char *s;
3378 char *dest;
3379 int allow_package;
3380 STRLEN *slp;
3381 {
3382     register char *d = dest;
3383     for (;;) {
3384         if (isALNUM(*s))
3385             *d++ = *s++;
3386         else if (*s == '\'' && allow_package && isIDFIRST(s[1])) {
3387             *d++ = ':';
3388             *d++ = ':';
3389             s++;
3390         }
3391         else if (*s == ':' && s[1] == ':' && allow_package && isIDFIRST(s[2])) {
3392             *d++ = *s++;
3393             *d++ = *s++;
3394         }
3395         else {
3396             *d = '\0';
3397             *slp = d - dest;
3398             return s;
3399         }
3400     }
3401 }
3402
3403 static char *
3404 scan_ident(s,send,dest,ck_uni)
3405 register char *s;
3406 register char *send;
3407 char *dest;
3408 I32 ck_uni;
3409 {
3410     register char *d;
3411     char *bracket = 0;
3412
3413     if (lex_brackets == 0)
3414         lex_fakebrack = 0;
3415     s++;
3416     d = dest;
3417     if (isDIGIT(*s)) {
3418         while (isDIGIT(*s))
3419             *d++ = *s++;
3420     }
3421     else {
3422         for (;;) {
3423             if (isALNUM(*s))
3424                 *d++ = *s++;
3425             else if (*s == '\'' && isIDFIRST(s[1])) {
3426                 *d++ = ':';
3427                 *d++ = ':';
3428                 s++;
3429             }
3430             else if (*s == ':' && s[1] == ':' && isIDFIRST(s[2])) {
3431                 *d++ = *s++;
3432                 *d++ = *s++;
3433             }
3434             else
3435                 break;
3436         }
3437     }
3438     *d = '\0';
3439     d = dest;
3440     if (*d) {
3441         if (lex_state != LEX_NORMAL)
3442             lex_state = LEX_INTERPENDMAYBE;
3443         return s;
3444     }
3445     if (isSPACE(*s) ||
3446         (*s == '$' && s[1] && (isALPHA(s[1]) || strchr("$_{", s[1]))))
3447             return s;
3448     if (*s == '{') {
3449         bracket = s;
3450         s++;
3451     }
3452     else if (ck_uni)
3453         check_uni();
3454     if (s < send)
3455         *d = *s++;
3456     d[1] = '\0';
3457     if (*d == '^' && (isUPPER(*s) || strchr("[\\]^_?", *s))) {
3458         *d = *s++ ^ 64;
3459     }
3460     if (bracket) {
3461         if (isALPHA(*d) || *d == '_') {
3462             d++;
3463             while (isALNUM(*s))
3464                 *d++ = *s++;
3465             *d = '\0';
3466             if (*s == '[' || *s == '{') {
3467                 if (lex_brackets)
3468                     croak("Can't use delimiter brackets within expression");
3469                 lex_fakebrack = TRUE;
3470                 bracket++;
3471                 lex_brackets++;
3472                 return s;
3473             }
3474         }
3475         if (*s == '}') {
3476             s++;
3477             if (lex_state == LEX_INTERPNORMAL && !lex_brackets)
3478                 lex_state = LEX_INTERPEND;
3479         }
3480         else {
3481             s = bracket;                /* let the parser handle it */
3482             *dest = '\0';
3483         }
3484     }
3485     else if (lex_state == LEX_INTERPNORMAL && !lex_brackets && !intuit_more(s))
3486         lex_state = LEX_INTERPEND;
3487     return s;
3488 }
3489
3490 void
3491 scan_prefix(pm,string,len)
3492 PMOP *pm;
3493 char *string;
3494 I32 len;
3495 {
3496     register SV *tmpstr;
3497     register char *t;
3498     register char *d;
3499     register char *e;
3500     char *origstring = string;
3501
3502     if (ninstr(string, string+len, vert, vert+1))
3503         return;
3504     if (*string == '^')
3505         string++, len--;
3506     tmpstr = NEWSV(86,len);
3507     sv_upgrade(tmpstr, SVt_PVBM);
3508     sv_setpvn(tmpstr,string,len);
3509     t = SvPVX(tmpstr);
3510     e = t + len;
3511     BmUSEFUL(tmpstr) = 100;
3512     for (d=t; d < e; ) {
3513         switch (*d) {
3514         case '{':
3515             if (isDIGIT(d[1]))
3516                 e = d;
3517             else
3518                 goto defchar;
3519             break;
3520         case '.': case '[': case '$': case '(': case ')': case '|': case '+':
3521         case '^':
3522             e = d;
3523             break;
3524         case '\\':
3525             if (d[1] && strchr("wWbB0123456789sSdDlLuUExc",d[1])) {
3526                 e = d;
3527                 break;
3528             }
3529             Move(d+1,d,e-d,char);
3530             e--;
3531             switch(*d) {
3532             case 'n':
3533                 *d = '\n';
3534                 break;
3535             case 't':
3536                 *d = '\t';
3537                 break;
3538             case 'f':
3539                 *d = '\f';
3540                 break;
3541             case 'r':
3542                 *d = '\r';
3543                 break;
3544             case 'e':
3545                 *d = '\033';
3546                 break;
3547             case 'a':
3548                 *d = '\007';
3549                 break;
3550             }
3551             /* FALL THROUGH */
3552         default:
3553           defchar:
3554             if (d[1] == '*' || (d[1] == '{' && d[2] == '0') || d[1] == '?') {
3555                 e = d;
3556                 break;
3557             }
3558             d++;
3559         }
3560     }
3561     if (d == t) {
3562         SvREFCNT_dec(tmpstr);
3563         return;
3564     }
3565     *d = '\0';
3566     SvCUR_set(tmpstr, d - t);
3567     if (d == t+len)
3568         pm->op_pmflags |= PMf_ALL;
3569     if (*origstring != '^')
3570         pm->op_pmflags |= PMf_SCANFIRST;
3571     pm->op_pmshort = tmpstr;
3572     pm->op_pmslen = d - t;
3573 }
3574
3575 static char *
3576 scan_pat(start)
3577 char *start;
3578 {
3579     PMOP *pm;
3580     char *s;
3581
3582     multi_start = curcop->cop_line;
3583
3584     s = scan_str(start);
3585     if (!s) {
3586         if (lex_stuff)
3587             SvREFCNT_dec(lex_stuff);
3588         lex_stuff = Nullsv;
3589         croak("Search pattern not terminated");
3590     }
3591     pm = (PMOP*)newPMOP(OP_MATCH, 0);
3592     if (*start == '?')
3593         pm->op_pmflags |= PMf_ONCE;
3594
3595     while (*s == 'i' || *s == 'o' || *s == 'g') {
3596         if (*s == 'i') {
3597             s++;
3598             sawi = TRUE;
3599             pm->op_pmflags |= PMf_FOLD;
3600         }
3601         if (*s == 'o') {
3602             s++;
3603             pm->op_pmflags |= PMf_KEEP;
3604         }
3605         if (*s == 'g') {
3606             s++;
3607             pm->op_pmflags |= PMf_GLOBAL;
3608         }
3609     }
3610
3611     lex_op = (OP*)pm;
3612     yylval.ival = OP_MATCH;
3613     return s;
3614 }
3615
3616 static char *
3617 scan_subst(start)
3618 char *start;
3619 {
3620     register char *s = start;
3621     register PMOP *pm;
3622     I32 es = 0;
3623
3624     multi_start = curcop->cop_line;
3625     yylval.ival = OP_NULL;
3626
3627     s = scan_str(s);
3628
3629     if (!s) {
3630         if (lex_stuff)
3631             SvREFCNT_dec(lex_stuff);
3632         lex_stuff = Nullsv;
3633         croak("Substitution pattern not terminated");
3634     }
3635
3636     if (s[-1] == *start)
3637         s--;
3638
3639     s = scan_str(s);
3640     if (!s) {
3641         if (lex_stuff)
3642             SvREFCNT_dec(lex_stuff);
3643         lex_stuff = Nullsv;
3644         if (lex_repl)
3645             SvREFCNT_dec(lex_repl);
3646         lex_repl = Nullsv;
3647         croak("Substitution replacement not terminated");
3648     }
3649
3650     pm = (PMOP*)newPMOP(OP_SUBST, 0);
3651     while (*s == 'g' || *s == 'i' || *s == 'e' || *s == 'o') {
3652         if (*s == 'e') {
3653             s++;
3654             es++;
3655         }
3656         if (*s == 'g') {
3657             s++;
3658             pm->op_pmflags |= PMf_GLOBAL;
3659         }
3660         if (*s == 'i') {
3661             s++;
3662             sawi = TRUE;
3663             pm->op_pmflags |= PMf_FOLD;
3664         }
3665         if (*s == 'o') {
3666             s++;
3667             pm->op_pmflags |= PMf_KEEP;
3668         }
3669     }
3670
3671     if (es) {
3672         SV *repl;
3673         pm->op_pmflags |= PMf_EVAL;
3674         repl = newSVpv("",0);
3675         while (es-- > 0)
3676             sv_catpvn(repl, "eval ", 5);
3677         sv_catpvn(repl, "{ ", 2);
3678         sv_catsv(repl, lex_repl);
3679         sv_catpvn(repl, " };", 2);
3680         SvCOMPILED_on(repl);
3681         SvREFCNT_dec(lex_repl);
3682         lex_repl = repl;
3683     }
3684
3685     lex_op = (OP*)pm;
3686     yylval.ival = OP_SUBST;
3687     return s;
3688 }
3689
3690 void
3691 hoistmust(pm)
3692 register PMOP *pm;
3693 {
3694     if (!pm->op_pmshort && pm->op_pmregexp->regstart &&
3695         (!pm->op_pmregexp->regmust || pm->op_pmregexp->reganch & ROPT_ANCH)
3696        ) {
3697         if (!(pm->op_pmregexp->reganch & ROPT_ANCH))
3698             pm->op_pmflags |= PMf_SCANFIRST;
3699         else if (pm->op_pmflags & PMf_FOLD)
3700             return;
3701         pm->op_pmshort = SvREFCNT_inc(pm->op_pmregexp->regstart);
3702     }
3703     else if (pm->op_pmregexp->regmust) {/* is there a better short-circuit? */
3704         if (pm->op_pmshort &&
3705           sv_eq(pm->op_pmshort,pm->op_pmregexp->regmust))
3706         {
3707             if (pm->op_pmflags & PMf_SCANFIRST) {
3708                 SvREFCNT_dec(pm->op_pmshort);
3709                 pm->op_pmshort = Nullsv;
3710             }
3711             else {
3712                 SvREFCNT_dec(pm->op_pmregexp->regmust);
3713                 pm->op_pmregexp->regmust = Nullsv;
3714                 return;
3715             }
3716         }
3717         if (!pm->op_pmshort ||  /* promote the better string */
3718           ((pm->op_pmflags & PMf_SCANFIRST) &&
3719            (SvCUR(pm->op_pmshort) < SvCUR(pm->op_pmregexp->regmust)) )){
3720             SvREFCNT_dec(pm->op_pmshort);               /* ok if null */
3721             pm->op_pmshort = pm->op_pmregexp->regmust;
3722             pm->op_pmregexp->regmust = Nullsv;
3723             pm->op_pmflags |= PMf_SCANFIRST;
3724         }
3725     }
3726 }
3727
3728 static char *
3729 scan_trans(start)
3730 char *start;
3731 {
3732     register char *s = start;
3733     OP *op;
3734     short *tbl;
3735     I32 squash;
3736     I32 delete;
3737     I32 complement;
3738
3739     yylval.ival = OP_NULL;
3740
3741     s = scan_str(s);
3742     if (!s) {
3743         if (lex_stuff)
3744             SvREFCNT_dec(lex_stuff);
3745         lex_stuff = Nullsv;
3746         croak("Translation pattern not terminated");
3747     }
3748     if (s[-1] == *start)
3749         s--;
3750
3751     s = scan_str(s);
3752     if (!s) {
3753         if (lex_stuff)
3754             SvREFCNT_dec(lex_stuff);
3755         lex_stuff = Nullsv;
3756         if (lex_repl)
3757             SvREFCNT_dec(lex_repl);
3758         lex_repl = Nullsv;
3759         croak("Translation replacement not terminated");
3760     }
3761
3762     New(803,tbl,256,short);
3763     op = newPVOP(OP_TRANS, 0, (char*)tbl);
3764
3765     complement = delete = squash = 0;
3766     while (*s == 'c' || *s == 'd' || *s == 's') {
3767         if (*s == 'c')
3768             complement = OPpTRANS_COMPLEMENT;
3769         else if (*s == 'd')
3770             delete = OPpTRANS_DELETE;
3771         else
3772             squash = OPpTRANS_SQUASH;
3773         s++;
3774     }
3775     op->op_private = delete|squash|complement;
3776
3777     lex_op = op;
3778     yylval.ival = OP_TRANS;
3779     return s;
3780 }
3781
3782 static char *
3783 scan_heredoc(s)
3784 register char *s;
3785 {
3786     SV *herewas;
3787     I32 op_type = OP_SCALAR;
3788     I32 len;
3789     SV *tmpstr;
3790     char term;
3791     register char *d;
3792
3793     s += 2;
3794     d = tokenbuf;
3795     if (!rsfp)
3796         *d++ = '\n';
3797     if (*s && strchr("`'\"",*s)) {
3798         term = *s++;
3799         s = cpytill(d,s,bufend,term,&len);
3800         if (s < bufend)
3801             s++;
3802         d += len;
3803     }
3804     else {
3805         if (*s == '\\')
3806             s++, term = '\'';
3807         else
3808             term = '"';
3809         while (isALNUM(*s))
3810             *d++ = *s++;
3811     }                           /* assuming tokenbuf won't clobber */
3812     *d++ = '\n';
3813     *d = '\0';
3814     len = d - tokenbuf;
3815     d = "\n";
3816     if (rsfp || !(d=ninstr(s,bufend,d,d+1)))
3817         herewas = newSVpv(s,bufend-s);
3818     else
3819         s--, herewas = newSVpv(s,d-s);
3820     s += SvCUR(herewas);
3821     if (term == '\'')
3822         op_type = OP_CONST;
3823     if (term == '`')
3824         op_type = OP_BACKTICK;
3825
3826     CLINE;
3827     multi_start = curcop->cop_line;
3828     multi_open = multi_close = '<';
3829     tmpstr = NEWSV(87,80);
3830     term = *tokenbuf;
3831     if (!rsfp) {
3832         d = s;
3833         while (s < bufend &&
3834           (*s != term || bcmp(s,tokenbuf,len) != 0) ) {
3835             if (*s++ == '\n')
3836                 curcop->cop_line++;
3837         }
3838         if (s >= bufend) {
3839             curcop->cop_line = multi_start;
3840             missingterm(tokenbuf);
3841         }
3842         sv_setpvn(tmpstr,d+1,s-d);
3843         s += len - 1;
3844         sv_catpvn(herewas,s,bufend-s);
3845         sv_setsv(linestr,herewas);
3846         oldoldbufptr = oldbufptr = bufptr = s = SvPVX(linestr);
3847         bufend = SvPVX(linestr) + SvCUR(linestr);
3848     }
3849     else
3850         sv_setpvn(tmpstr,"",0);   /* avoid "uninitialized" warning */
3851     while (s >= bufend) {       /* multiple line string? */
3852         if (!rsfp ||
3853          !(oldoldbufptr = oldbufptr = s = sv_gets(linestr, rsfp, 0))) {
3854             curcop->cop_line = multi_start;
3855             missingterm(tokenbuf);
3856         }
3857         curcop->cop_line++;
3858         if (perldb && curstash != debstash) {
3859             SV *sv = NEWSV(88,0);
3860
3861             sv_upgrade(sv, SVt_PVMG);
3862             sv_setsv(sv,linestr);
3863             av_store(GvAV(curcop->cop_filegv),
3864               (I32)curcop->cop_line,sv);
3865         }
3866         bufend = SvPVX(linestr) + SvCUR(linestr);
3867         if (*s == term && bcmp(s,tokenbuf,len) == 0) {
3868             s = bufend - 1;
3869             *s = ' ';
3870             sv_catsv(linestr,herewas);
3871             bufend = SvPVX(linestr) + SvCUR(linestr);
3872         }
3873         else {
3874             s = bufend;
3875             sv_catsv(tmpstr,linestr);
3876         }
3877     }
3878     multi_end = curcop->cop_line;
3879     s++;
3880     if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
3881         SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
3882         Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
3883     }
3884     SvREFCNT_dec(herewas);
3885     lex_stuff = tmpstr;
3886     yylval.ival = op_type;
3887     return s;
3888 }
3889
3890 static char *
3891 scan_inputsymbol(start)
3892 char *start;
3893 {
3894     register char *s = start;
3895     register char *d;
3896     I32 len;
3897
3898     d = tokenbuf;
3899     s = cpytill(d, s+1, bufend, '>', &len);
3900     if (s < bufend)
3901         s++;
3902     else
3903         croak("Unterminated <> operator");
3904
3905     if (*d == '$') d++;
3906     while (*d && (isALNUM(*d) || *d == '\''))
3907         d++;
3908     if (d - tokenbuf != len) {
3909         yylval.ival = OP_GLOB;
3910         set_csh();
3911         s = scan_str(start);
3912         if (!s)
3913             croak("Glob not terminated");
3914         return s;
3915     }
3916     else {
3917         d = tokenbuf;
3918         if (!len)
3919             (void)strcpy(d,"ARGV");
3920         if (*d == '$') {
3921             GV *gv = gv_fetchpv(d+1,TRUE);
3922             lex_op = (OP*)newUNOP(OP_READLINE, 0,
3923                                     newUNOP(OP_RV2GV, 0,
3924                                         newUNOP(OP_RV2SV, 0,
3925                                             newGVOP(OP_GV, 0, gv))));
3926             yylval.ival = OP_NULL;
3927         }
3928         else {
3929             IO *io;
3930
3931             GV *gv = gv_fetchpv(d,TRUE);
3932             io = GvIOn(gv);
3933             if (strEQ(d,"ARGV")) {
3934                 GvAVn(gv);
3935                 IoFLAGS(io) |= IOf_ARGV|IOf_START;
3936             }
3937             lex_op = (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
3938             yylval.ival = OP_NULL;
3939         }
3940     }
3941     return s;
3942 }
3943
3944 static char *
3945 scan_str(start)
3946 char *start;
3947 {
3948     SV *sv;
3949     char *tmps;
3950     register char *s = start;
3951     register char term = *s;
3952     register char *to;
3953     I32 brackets = 1;
3954
3955     CLINE;
3956     multi_start = curcop->cop_line;
3957     multi_open = term;
3958     if (term && (tmps = strchr("([{< )]}> )]}>",term)))
3959         term = tmps[5];
3960     multi_close = term;
3961
3962     sv = NEWSV(87,80);
3963     sv_upgrade(sv, SVt_PVIV);
3964     SvIVX(sv) = term;
3965     SvPOK_only(sv);             /* validate pointer */
3966     s++;
3967     for (;;) {
3968         SvGROW(sv, SvCUR(sv) + (bufend - s) + 1);
3969         to = SvPVX(sv)+SvCUR(sv);
3970         if (multi_open == multi_close) {
3971             for (; s < bufend; s++,to++) {
3972                 if (*s == '\n' && !rsfp)
3973                     curcop->cop_line++;
3974                 if (*s == '\\' && s+1 < bufend && term != '\\')
3975                     *to++ = *s++;
3976                 else if (*s == term)
3977                     break;
3978                 *to = *s;
3979             }
3980         }
3981         else {
3982             for (; s < bufend; s++,to++) {
3983                 if (*s == '\n' && !rsfp)
3984                     curcop->cop_line++;
3985                 if (*s == '\\' && s+1 < bufend && term != '\\')
3986                     *to++ = *s++;
3987                 else if (*s == term && --brackets <= 0)
3988                     break;
3989                 else if (*s == multi_open)
3990                     brackets++;
3991                 *to = *s;
3992             }
3993         }
3994         *to = '\0';
3995         SvCUR_set(sv, to - SvPVX(sv));
3996
3997     if (s < bufend) break;      /* string ends on this line? */
3998
3999         if (!rsfp ||
4000          !(oldoldbufptr = oldbufptr = s = sv_gets(linestr, rsfp, 0))) {
4001             curcop->cop_line = multi_start;
4002             return Nullch;
4003         }
4004         curcop->cop_line++;
4005         if (perldb && curstash != debstash) {
4006             SV *sv = NEWSV(88,0);
4007
4008             sv_upgrade(sv, SVt_PVMG);
4009             sv_setsv(sv,linestr);
4010             av_store(GvAV(curcop->cop_filegv),
4011               (I32)curcop->cop_line, sv);
4012         }
4013         bufend = SvPVX(linestr) + SvCUR(linestr);
4014     }
4015     multi_end = curcop->cop_line;
4016     s++;
4017     if (SvCUR(sv) + 5 < SvLEN(sv)) {
4018         SvLEN_set(sv, SvCUR(sv) + 1);
4019         Renew(SvPVX(sv), SvLEN(sv), char);
4020     }
4021     if (lex_stuff)
4022         lex_repl = sv;
4023     else
4024         lex_stuff = sv;
4025     return s;
4026 }
4027
4028 char *
4029 scan_num(start)
4030 char *start;
4031 {
4032     register char *s = start;
4033     register char *d;
4034     I32 tryi32;
4035     double value;
4036     SV *sv;
4037     I32 floatit;
4038     char *lastub = 0;
4039
4040     switch (*s) {
4041     default:
4042         croak("panic: scan_num");
4043     case '0':
4044         {
4045             U32 i;
4046             I32 shift;
4047
4048             if (s[1] == 'x') {
4049                 shift = 4;
4050                 s += 2;
4051             }
4052             else if (s[1] == '.')
4053                 goto decimal;
4054             else
4055                 shift = 3;
4056             i = 0;
4057             for (;;) {
4058                 switch (*s) {
4059                 default:
4060                     goto out;
4061                 case '_':
4062                     s++;
4063                     break;
4064                 case '8': case '9':
4065                     if (shift != 4)
4066                         yyerror("Illegal octal digit");
4067                     /* FALL THROUGH */
4068                 case '0': case '1': case '2': case '3': case '4':
4069                 case '5': case '6': case '7':
4070                     i <<= shift;
4071                     i += *s++ & 15;
4072                     break;
4073                 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
4074                 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
4075                     if (shift != 4)
4076                         goto out;
4077                     i <<= 4;
4078                     i += (*s++ & 7) + 9;
4079                     break;
4080                 }
4081             }
4082           out:
4083             sv = NEWSV(92,0);
4084             tryi32 = i;
4085             if (tryi32 == i && tryi32 >= 0)
4086                 sv_setiv(sv,tryi32);
4087             else
4088                 sv_setnv(sv,(double)i);
4089         }
4090         break;
4091     case '1': case '2': case '3': case '4': case '5':
4092     case '6': case '7': case '8': case '9': case '.':
4093       decimal:
4094         d = tokenbuf;
4095         floatit = FALSE;
4096         while (isDIGIT(*s) || *s == '_') {
4097             if (*s == '_') {
4098                 if (dowarn && lastub && s - lastub != 3)
4099                     warn("Misplaced _ in number");
4100                 lastub = ++s;
4101             }
4102             else
4103                 *d++ = *s++;
4104         }
4105         if (dowarn && lastub && s - lastub != 3)
4106             warn("Misplaced _ in number");
4107         if (*s == '.' && s[1] != '.') {
4108             floatit = TRUE;
4109             *d++ = *s++;
4110             while (isDIGIT(*s) || *s == '_') {
4111                 if (*s == '_')
4112                     s++;
4113                 else
4114                     *d++ = *s++;
4115             }
4116         }
4117         if (*s && strchr("eE",*s) && strchr("+-0123456789",s[1])) {
4118             floatit = TRUE;
4119             s++;
4120             *d++ = 'e';         /* At least some Mach atof()s don't grok 'E' */
4121             if (*s == '+' || *s == '-')
4122                 *d++ = *s++;
4123             while (isDIGIT(*s))
4124                 *d++ = *s++;
4125         }
4126         *d = '\0';
4127         sv = NEWSV(92,0);
4128         value = atof(tokenbuf);
4129         tryi32 = I_32(value);
4130         if (!floatit && (double)tryi32 == value)
4131             sv_setiv(sv,tryi32);
4132         else
4133             sv_setnv(sv,value);
4134         break;
4135     }
4136
4137     yylval.opval = newSVOP(OP_CONST, 0, sv);
4138
4139     return s;
4140 }
4141
4142 static char *
4143 scan_formline(s)
4144 register char *s;
4145 {
4146     register char *eol;
4147     register char *t;
4148     SV *stuff = newSV(0);
4149     bool needargs = FALSE;
4150
4151     while (!needargs) {
4152         if (*s == '.') {
4153             /*SUPPRESS 530*/
4154             for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
4155             if (*t == '\n')
4156                 break;
4157         }
4158         if (in_eval && !rsfp) {
4159             eol = strchr(s,'\n');
4160             if (!eol++)
4161                 eol = bufend;
4162         }
4163         else
4164             eol = bufend = SvPVX(linestr) + SvCUR(linestr);
4165         if (*s != '#') {
4166             sv_catpvn(stuff, s, eol-s);
4167             while (s < eol) {
4168                 if (*s == '@' || *s == '^') {
4169                     needargs = TRUE;
4170                     break;
4171                 }
4172                 s++;
4173             }
4174         }
4175         s = eol;
4176         if (rsfp) {
4177             s = sv_gets(linestr, rsfp, 0);
4178             oldoldbufptr = oldbufptr = bufptr = SvPVX(linestr);
4179             if (!s) {
4180                 s = bufptr;
4181                 yyerror("Format not terminated");
4182                 break;
4183             }
4184         }
4185         incline(s);
4186     }
4187     if (SvPOK(stuff)) {
4188         expect = XTERM;
4189         if (needargs) {
4190             nextval[nexttoke].ival = 0;
4191             force_next(',');
4192         }
4193         else
4194             in_format = 2;
4195         nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, stuff);
4196         force_next(THING);
4197         nextval[nexttoke].ival = OP_FORMLINE;
4198         force_next(LSTOP);
4199     }
4200     else {
4201         SvREFCNT_dec(stuff);
4202         in_format = 0;
4203         bufptr = s;
4204     }
4205     return s;
4206 }
4207
4208 static void
4209 set_csh()
4210 {
4211 #ifdef CSH
4212     if (!cshlen)
4213         cshlen = strlen(cshname);
4214 #endif
4215 }
4216
4217 int
4218 start_subparse()
4219 {
4220     int oldsavestack_ix = savestack_ix;
4221
4222     save_I32(&subline);
4223     save_item(subname);
4224     SAVEINT(padix);
4225     SAVESPTR(curpad);
4226     SAVESPTR(comppad);
4227     SAVESPTR(comppad_name);
4228     SAVEINT(comppad_name_fill);
4229     SAVEINT(min_intro_pending);
4230     SAVEINT(max_intro_pending);
4231     comppad = newAV();
4232     comppad_name = newAV();
4233     comppad_name_fill = 0;
4234     min_intro_pending = 0;
4235     av_push(comppad, Nullsv);
4236     curpad = AvARRAY(comppad);
4237     padix = 0;
4238
4239     subline = curcop->cop_line;
4240     return oldsavestack_ix;
4241 }
4242
4243 int
4244 yywarn(s)
4245 char *s;
4246 {
4247     --error_count;
4248     return yyerror(s);
4249 }
4250
4251 int
4252 yyerror(s)
4253 char *s;
4254 {
4255     char tmpbuf[258];
4256     char tmp2buf[258];
4257     char *tname = tmpbuf;
4258
4259     if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
4260       oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
4261         while (isSPACE(*oldoldbufptr))
4262             oldoldbufptr++;
4263         cpy7bit(tmp2buf, oldoldbufptr, bufptr - oldoldbufptr);
4264         sprintf(tname,"near \"%s\"",tmp2buf);
4265     }
4266     else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
4267       oldbufptr != bufptr) {
4268         while (isSPACE(*oldbufptr))
4269             oldbufptr++;
4270         cpy7bit(tmp2buf, oldbufptr, bufptr - oldbufptr);
4271         sprintf(tname,"near \"%s\"",tmp2buf);
4272     }
4273     else if (yychar > 255)
4274         tname = "next token ???";
4275     else if (!yychar || (yychar == ';' && !rsfp))
4276         (void)strcpy(tname,"at EOF");
4277     else if ((yychar & 127) == 127) {
4278         if (lex_state == LEX_NORMAL ||
4279            (lex_state == LEX_KNOWNEXT && lex_defer == LEX_NORMAL))
4280             (void)strcpy(tname,"at end of line");
4281         else
4282             (void)strcpy(tname,"at end of string");
4283     }
4284     else if (yychar < 32)
4285         (void)sprintf(tname,"next char ^%c",yychar+64);
4286     else
4287         (void)sprintf(tname,"next char %c",yychar);
4288     (void)sprintf(buf, "%s at %s line %d, %s\n",
4289       s,SvPVX(GvSV(curcop->cop_filegv)),curcop->cop_line,tname);
4290     if (curcop->cop_line == multi_end && multi_start < multi_end)
4291         sprintf(buf+strlen(buf),
4292           "  (Might be a runaway multi-line %c%c string starting on line %d)\n",
4293           multi_open,multi_close,multi_start);
4294     if (in_eval)
4295         sv_catpv(GvSV(gv_fetchpv("@",TRUE)),buf);
4296     else
4297         fputs(buf,stderr);
4298     if (++error_count >= 10)
4299         croak("%s has too many errors.\n",
4300         SvPVX(GvSV(curcop->cop_filegv)));
4301     return 0;
4302 }