toke.c

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