toke.c

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