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