toke.c

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