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