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