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