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