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