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