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