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