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