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