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
update Changes and perlhist.pod
[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));
b3ac6de7 53static SV *new_constant _((char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type));
49d8d3a1
MB		 54static void restore_expect _((void *e));
55static void restore_lex_expect _((void *e));
76e3520e 56#endif /* PERL_OBJECT */
2f3197b3 57
fc36a67e 58static char ident_too_long[] = "Identifier too long";
8903cb82 59
79072805
LW		 60/* The following are arranged oddly so that the guard on the switch statement
61 * can get by with a single comparison (if the compiler is smart enough).
62 */
63
fb73857a 64/* #define LEX_NOTPARSING 11 is done in perl.h. */
65
55497cff 66#define LEX_NORMAL 10
67#define LEX_INTERPNORMAL 9
68#define LEX_INTERPCASEMOD 8
69#define LEX_INTERPPUSH 7
70#define LEX_INTERPSTART 6
71#define LEX_INTERPEND 5
72#define LEX_INTERPENDMAYBE 4
73#define LEX_INTERPCONCAT 3
74#define LEX_INTERPCONST 2
75#define LEX_FORMLINE 1
76#define LEX_KNOWNEXT 0
79072805 77
395c3793
LW		 78#ifdef I_FCNTL
79#include <fcntl.h>
80#endif
fe14fcc3
LW		 81#ifdef I_SYS_FILE
82#include <sys/file.h>
83#endif
395c3793 84
a790bc05 85/* XXX If this causes problems, set i_unistd=undef in the hint file. */
86#ifdef I_UNISTD
87# include <unistd.h> /* Needed for execv() */
88#endif
89
90
79072805
LW		 91#ifdef ff_next
92#undef ff_next
d48672a2
LW		 93#endif
94
79072805 95#include "keywords.h"
fe14fcc3 96
ae986130
LW		 97#ifdef CLINE
98#undef CLINE
99#endif
79072805 100#define CLINE (copline = (curcop->cop_line < copline ? curcop->cop_line : copline))
378cc40b 101
79072805
LW		 102#define TOKEN(retval) return (bufptr = s,(int)retval)
103#define OPERATOR(retval) return (expect = XTERM,bufptr = s,(int)retval)
a0d0e21e 104#define AOPERATOR(retval) return ao((expect = XTERM,bufptr = s,(int)retval))
79072805 105#define PREBLOCK(retval) return (expect = XBLOCK,bufptr = s,(int)retval)
a0d0e21e 106#define PRETERMBLOCK(retval) return (expect = XTERMBLOCK,bufptr = s,(int)retval)
79072805
LW		 107#define PREREF(retval) return (expect = XREF,bufptr = s,(int)retval)
108#define TERM(retval) return (CLINE, expect = XOPERATOR,bufptr = s,(int)retval)
463ee0b2 109#define LOOPX(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LOOPEX)
79072805
LW		 110#define FTST(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)UNIOP)
111#define FUN0(f) return(yylval.ival = f,expect = XOPERATOR,bufptr = s,(int)FUNC0)
112#define FUN1(f) return(yylval.ival = f,expect = XOPERATOR,bufptr = s,(int)FUNC1)
a0d0e21e
LW		 113#define BOop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)BITOROP))
114#define BAop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)BITANDOP))
115#define SHop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)SHIFTOP))
116#define PWop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)POWOP))
79072805 117#define PMop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)MATCHOP)
a0d0e21e
LW		 118#define Aop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)ADDOP))
119#define Mop(f) return ao((yylval.ival=f,expect = XTERM,bufptr = s,(int)MULOP))
79072805
LW		 120#define Eop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)EQOP)
121#define Rop(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)RELOP)
2f3197b3 122
a687059c
LW		 123/* This bit of chicanery makes a unary function followed by
124 * a parenthesis into a function with one argument, highest precedence.
125 */
2f3197b3 126#define UNI(f) return(yylval.ival = f, \
79072805 127 expect = XTERM, \
2f3197b3
LW		 128 bufptr = s, \
129 last_uni = oldbufptr, \
a0d0e21e 130 last_lop_op = f, \
a687059c
LW		 131 (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
132
79072805
LW		 133#define UNIBRACK(f) return(yylval.ival = f, \
134 bufptr = s, \
135 last_uni = oldbufptr, \
136 (*s == '(' || (s = skipspace(s), *s == '(') ? (int)FUNC1 : (int)UNIOP) )
137
9f68db38 138/* grandfather return to old style */
79072805
LW		 139#define OLDLOP(f) return(yylval.ival=f,expect = XTERM,bufptr = s,(int)LSTOP)
140
76e3520e 141STATIC int
8ac85365 142ao(int toketype)
a0d0e21e
LW		 143{
144 if (*bufptr == '=') {
145 bufptr++;
146 if (toketype == ANDAND)
147 yylval.ival = OP_ANDASSIGN;
148 else if (toketype == OROR)
149 yylval.ival = OP_ORASSIGN;
150 toketype = ASSIGNOP;
151 }
152 return toketype;
153}
154
76e3520e 155STATIC void
8ac85365 156no_op(char *what, char *s)
463ee0b2 157{
748a9306 158 char *oldbp = bufptr;
fd049845 159 bool is_first = (oldbufptr == linestart);
68dc0745 160
8990e307 161 bufptr = s;
46fc3d4c 162 yywarn(form("%s found where operator expected", what));
748a9306 163 if (is_first)
a0d0e21e 164 warn("\t(Missing semicolon on previous line?)\n");
748a9306
LW		 165 else if (oldoldbufptr && isIDFIRST(*oldoldbufptr)) {
166 char *t;
167 for (t = oldoldbufptr; *t && (isALNUM(*t) || *t == ':'); t++) ;
168 if (t < bufptr && isSPACE(*t))
169 warn("\t(Do you need to predeclare %.*s?)\n",
170 t - oldoldbufptr, oldoldbufptr);
171
172 }
173 else
174 warn("\t(Missing operator before %.*s?)\n", s - oldbp, oldbp);
175 bufptr = oldbp;
8990e307
LW		 176}
177
76e3520e 178STATIC void
8ac85365 179missingterm(char *s)
8990e307
LW		 180{
181 char tmpbuf[3];
182 char q;
183 if (s) {
184 char *nl = strrchr(s,'\n');
d2719217 185 if (nl)
8990e307
LW		 186 *nl = '\0';
187 }
188 else if (multi_close < 32 || multi_close == 127) {
189 *tmpbuf = '^';
bbce6d69 190 tmpbuf[1] = toCTRL(multi_close);
8990e307
LW		 191 s = "\\n";
192 tmpbuf[2] = '\0';
193 s = tmpbuf;
194 }
195 else {
196 *tmpbuf = multi_close;
197 tmpbuf[1] = '\0';
198 s = tmpbuf;
199 }
200 q = strchr(s,'"') ? '\'' : '"';
201 croak("Can't find string terminator %c%s%c anywhere before EOF",q,s,q);
463ee0b2 202}
79072805
LW		 203
204void
8ac85365 205deprecate(char *s)
a0d0e21e
LW		 206{
207 if (dowarn)
208 warn("Use of %s is deprecated", s);
209}
210
76e3520e 211STATIC void
8ac85365 212depcom(void)
a0d0e21e
LW		 213{
214 deprecate("comma-less variable list");
215}
216
a868473f
NIS		 217#ifdef WIN32
218
76e3520e 219STATIC I32
a868473f
NIS		 220win32_textfilter(int idx, SV *sv, int maxlen)
221{
222 I32 count = FILTER_READ(idx+1, sv, maxlen);
223 if (count > 0 && !maxlen)
224 win32_strip_return(sv);
225 return count;
226}
227#endif
228
229
a0d0e21e 230void
8ac85365 231lex_start(SV *line)
79072805 232{
0f15f207 233 dTHR;
8990e307
LW		 234 char *s;
235 STRLEN len;
236
55497cff 237 SAVEI32(lex_dojoin);
238 SAVEI32(lex_brackets);
239 SAVEI32(lex_fakebrack);
240 SAVEI32(lex_casemods);
241 SAVEI32(lex_starts);
242 SAVEI32(lex_state);
a0d0e21e 243 SAVESPTR(lex_inpat);
55497cff 244 SAVEI32(lex_inwhat);
245 SAVEI16(curcop->cop_line);
85e6fe83
LW		 246 SAVEPPTR(bufptr);
247 SAVEPPTR(bufend);
248 SAVEPPTR(oldbufptr);
249 SAVEPPTR(oldoldbufptr);
fd049845 250 SAVEPPTR(linestart);
463ee0b2 251 SAVESPTR(linestr);
85e6fe83 252 SAVEPPTR(lex_brackstack);
a0d0e21e 253 SAVEPPTR(lex_casestack);
565764a8 254 SAVEDESTRUCTOR(restore_rsfp, rsfp);
49d8d3a1
MB		 255 SAVESPTR(lex_stuff);
256 SAVEI32(lex_defer);
257 SAVESPTR(lex_repl);
258 SAVEDESTRUCTOR(restore_expect, tokenbuf + expect); /* encode as pointer */
259 SAVEDESTRUCTOR(restore_lex_expect, tokenbuf + expect);
463ee0b2 260
79072805
LW		 261 lex_state = LEX_NORMAL;
262 lex_defer = 0;
8990e307 263 expect = XSTATE;
79072805
LW		 264 lex_brackets = 0;
265 lex_fakebrack = 0;
8990e307 266 New(899, lex_brackstack, 120, char);
a0d0e21e 267 New(899, lex_casestack, 12, char);
8990e307 268 SAVEFREEPV(lex_brackstack);
a0d0e21e 269 SAVEFREEPV(lex_casestack);
79072805 270 lex_casemods = 0;
a0d0e21e 271 *lex_casestack = '\0';
79072805
LW		 272 lex_dojoin = 0;
273 lex_starts = 0;
79072805 274 lex_stuff = Nullsv;
79072805
LW		 275 lex_repl = Nullsv;
276 lex_inpat = 0;
277 lex_inwhat = 0;
8990e307
LW		 278 linestr = line;
279 if (SvREADONLY(linestr))
280 linestr = sv_2mortal(newSVsv(linestr));
281 s = SvPV(linestr, len);
282 if (len && s[len-1] != ';') {
a0d0e21e 283 if (!(SvFLAGS(linestr) & SVs_TEMP))
8990e307
LW		 284 linestr = sv_2mortal(newSVsv(linestr));
285 sv_catpvn(linestr, "\n;", 2);
286 }
287 SvTEMP_off(linestr);
fd049845 288 oldoldbufptr = oldbufptr = bufptr = linestart = SvPVX(linestr);
79072805 289 bufend = bufptr + SvCUR(linestr);
c07a80fd 290 SvREFCNT_dec(rs);
291 rs = newSVpv("\n", 1);
8990e307 292 rsfp = 0;
79072805 293}
a687059c 294
463ee0b2 295void
8ac85365 296lex_end(void)
463ee0b2 297{
6ca21dd3 298 doextract = FALSE;
463ee0b2
LW		 299}
300
76e3520e 301STATIC void
8ac85365 302restore_rsfp(void *f)
6d5fb7e3 303{
760ac839 304 PerlIO *fp = (PerlIO*)f;
6d5fb7e3 305
760ac839
LW		 306 if (rsfp == PerlIO_stdin())
307 PerlIO_clearerr(rsfp);
a5f75d66 308 else if (rsfp && (rsfp != fp))
760ac839 309 PerlIO_close(rsfp);
6d5fb7e3
CS		 310 rsfp = fp;
311}
312
76e3520e 313STATIC void
7fae4e64 314restore_expect(void *e)
49d8d3a1
MB		 315{
316 /* a safe way to store a small integer in a pointer */
317 expect = (expectation)((char *)e - tokenbuf);
318}
319
837485b6 320STATIC void
7fae4e64 321restore_lex_expect(void *e)
49d8d3a1
MB		 322{
323 /* a safe way to store a small integer in a pointer */
324 lex_expect = (expectation)((char *)e - tokenbuf);
325}
326
837485b6 327STATIC void
8ac85365 328incline(char *s)
463ee0b2 329{
0f15f207 330 dTHR;
463ee0b2
LW		 331 char *t;
332 char *n;
333 char ch;
334 int sawline = 0;
335
336 curcop->cop_line++;
337 if (*s++ != '#')
338 return;
339 while (*s == ' ' || *s == '\t') s++;
340 if (strnEQ(s, "line ", 5)) {
341 s += 5;
342 sawline = 1;
343 }
344 if (!isDIGIT(*s))
345 return;
346 n = s;
347 while (isDIGIT(*s))
348 s++;
349 while (*s == ' ' || *s == '\t')
350 s++;
351 if (*s == '"' && (t = strchr(s+1, '"')))
352 s++;
353 else {
354 if (!sawline)
355 return; /* false alarm */
356 for (t = s; !isSPACE(*t); t++) ;
357 }
358 ch = *t;
359 *t = '\0';
360 if (t - s > 0)
361 curcop->cop_filegv = gv_fetchfile(s);
362 else
363 curcop->cop_filegv = gv_fetchfile(origfilename);
364 *t = ch;
365 curcop->cop_line = atoi(n)-1;
366}
367
76e3520e 368STATIC char *
8ac85365 369skipspace(register char *s)
a687059c 370{
11343788 371 dTHR;
85e6fe83 372 if (lex_formbrack && lex_brackets <= lex_formbrack) {
463ee0b2
LW		 373 while (s < bufend && (*s == ' ' || *s == '\t'))
374 s++;
375 return s;
376 }
377 for (;;) {
fd049845 378 STRLEN prevlen;
463ee0b2
LW		 379 while (s < bufend && isSPACE(*s))
380 s++;
381 if (s < bufend && *s == '#') {
382 while (s < bufend && *s != '\n')
383 s++;
384 if (s < bufend)
385 s++;
386 }
a0d0e21e 387 if (s < bufend || !rsfp || lex_state != LEX_NORMAL)
463ee0b2 388 return s;
fd049845 389 if ((s = filter_gets(linestr, rsfp, (prevlen = SvCUR(linestr)))) == Nullch) {
a0d0e21e 390 if (minus_n || minus_p) {
08e9d68e
DD		 391 sv_setpv(linestr,minus_p ?
392 ";}continue{print or die qq(-p destination: $!\\n)" :
393 "");
a0d0e21e
LW		 394 sv_catpv(linestr,";}");
395 minus_n = minus_p = 0;
396 }
397 else
398 sv_setpv(linestr,";");
fd049845 399 oldoldbufptr = oldbufptr = bufptr = s = linestart = SvPVX(linestr);
a0d0e21e
LW		 400 bufend = SvPVX(linestr) + SvCUR(linestr);
401 if (preprocess && !in_eval)
6ad3d225 402 (void)PerlProc_pclose(rsfp);
760ac839
LW		 403 else if ((PerlIO*)rsfp == PerlIO_stdin())
404 PerlIO_clearerr(rsfp);
8990e307 405 else
760ac839 406 (void)PerlIO_close(rsfp);
8990e307 407 rsfp = Nullfp;
463ee0b2
LW		 408 return s;
409 }
fd049845 410 linestart = bufptr = s + prevlen;
411 bufend = s + SvCUR(linestr);
412 s = bufptr;
a0d0e21e 413 incline(s);
84902520 414 if (PERLDB_LINE && curstash != debstash) {
8990e307
LW		 415 SV *sv = NEWSV(85,0);
416
417 sv_upgrade(sv, SVt_PVMG);
fd049845 418 sv_setpvn(sv,bufptr,bufend-bufptr);
8990e307
LW		 419 av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv);
420 }
463ee0b2 421 }
a687059c 422}
378cc40b 423
76e3520e 424STATIC void
8ac85365 425check_uni(void) {
2f3197b3
LW		 426 char *s;
427 char ch;
a0d0e21e 428 char *t;
2f3197b3
LW		 429
430 if (oldoldbufptr != last_uni)
431 return;
432 while (isSPACE(*last_uni))
433 last_uni++;
e334a159 434 for (s = last_uni; isALNUM(*s) || *s == '-'; s++) ;
a0d0e21e
LW		 435 if ((t = strchr(s, '(')) && t < bufptr)
436 return;
2f3197b3
LW		 437 ch = *s;
438 *s = '\0';
439 warn("Warning: Use of \"%s\" without parens is ambiguous", last_uni);
440 *s = ch;
441}
442
ffed7fef
LW		 443#ifdef CRIPPLED_CC
444
445#undef UNI
ffed7fef 446#define UNI(f) return uni(f,s)
ffed7fef 447
76e3520e 448STATIC int
8ac85365 449uni(I32 f, char *s)
ffed7fef
LW		 450{
451 yylval.ival = f;
79072805 452 expect = XTERM;
ffed7fef 453 bufptr = s;
2f3197b3 454 last_uni = oldbufptr;
a0d0e21e 455 last_lop_op = f;
ffed7fef
LW		 456 if (*s == '(')
457 return FUNC1;
458 s = skipspace(s);
459 if (*s == '(')
460 return FUNC1;
461 else
462 return UNIOP;
463}
464
a0d0e21e
LW		 465#endif /* CRIPPLED_CC */
466
467#define LOP(f,x) return lop(f,x,s)
468
76e3520e 469STATIC I32
0fa19009 470lop(I32 f, expectation x, char *s)
ffed7fef 471{
0f15f207 472 dTHR;
79072805 473 yylval.ival = f;
35c8bce7 474 CLINE;
a0d0e21e 475 expect = x;
79072805 476 bufptr = s;
8990e307
LW		 477 last_lop = oldbufptr;
478 last_lop_op = f;
a0d0e21e
LW		 479 if (nexttoke)
480 return LSTOP;
79072805
LW		 481 if (*s == '(')
482 return FUNC;
483 s = skipspace(s);
484 if (*s == '(')
485 return FUNC;
486 else
487 return LSTOP;
488}
489
76e3520e 490STATIC void
8ac85365 491force_next(I32 type)
79072805
LW		 492{
493 nexttype[nexttoke] = type;
494 nexttoke++;
495 if (lex_state != LEX_KNOWNEXT) {
496 lex_defer = lex_state;
463ee0b2 497 lex_expect = expect;
79072805
LW		 498 lex_state = LEX_KNOWNEXT;
499 }
500}
501
76e3520e 502STATIC char *
15f0808c 503force_word(register char *start, int token, int check_keyword, int allow_pack, int allow_initial_tick)
79072805 504{
463ee0b2
LW		 505 register char *s;
506 STRLEN len;
507
508 start = skipspace(start);
509 s = start;
a0d0e21e
LW		 510 if (isIDFIRST(*s) ||
511 (allow_pack && *s == ':') ||
15f0808c 512 (allow_initial_tick && *s == '\'') )
a0d0e21e 513 {
8903cb82 514 s = scan_word(s, tokenbuf, sizeof tokenbuf, allow_pack, &len);
463ee0b2
LW		 515 if (check_keyword && keyword(tokenbuf, len))
516 return start;
517 if (token == METHOD) {
518 s = skipspace(s);
519 if (*s == '(')
520 expect = XTERM;
521 else {
522 expect = XOPERATOR;
523 force_next(')');
524 force_next('(');
525 }
79072805 526 }
463ee0b2 527 nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST,0, newSVpv(tokenbuf,0));
8990e307 528 nextval[nexttoke].opval->op_private |= OPpCONST_BARE;
79072805
LW		 529 force_next(token);
530 }
531 return s;
532}
533
76e3520e 534STATIC void
8ac85365 535force_ident(register char *s, int kind)
79072805
LW		 536{
537 if (s && *s) {
11343788
MB		 538 OP* o = (OP*)newSVOP(OP_CONST, 0, newSVpv(s,0));
539 nextval[nexttoke].opval = o;
79072805 540 force_next(WORD);
748a9306 541 if (kind) {
e858de61 542 dTHR; /* just for in_eval */
11343788 543 o->op_private = OPpCONST_ENTERED;
55497cff 544 /* XXX see note in pp_entereval() for why we forgo typo
545 warnings if the symbol must be introduced in an eval.
546 GSAR 96-10-12 */
93233ece 547 gv_fetchpv(s, in_eval ? (GV_ADDMULTI | 8) : TRUE,
a0d0e21e
LW		 548 kind == '$' ? SVt_PV :
549 kind == '@' ? SVt_PVAV :
550 kind == '%' ? SVt_PVHV :
551 SVt_PVGV
552 );
748a9306 553 }
79072805
LW		 554 }
555}
556
76e3520e 557STATIC char *
8ac85365 558force_version(char *s)
89bfa8cd 559{
560 OP *version = Nullop;
561
562 s = skipspace(s);
563
564 /* default VERSION number -- GBARR */
565
566 if(isDIGIT(*s)) {
567 char *d;
568 int c;
55497cff 569 for( d=s, c = 1; isDIGIT(*d) || *d == '_' || (*d == '.' && c--); d++);
89bfa8cd 570 if((*d == ';' || isSPACE(*d)) && *(skipspace(d)) != ',') {
571 s = scan_num(s);
572 /* real VERSION number -- GBARR */
573 version = yylval.opval;
574 }
575 }
576
577 /* NOTE: The parser sees the package name and the VERSION swapped */
578 nextval[nexttoke].opval = version;
579 force_next(WORD);
580
581 return (s);
582}
583
76e3520e
GS		 584STATIC SV *
585tokeq(SV *sv)
79072805
LW		 586{
587 register char *s;
588 register char *send;
589 register char *d;
b3ac6de7
IZ		 590 STRLEN len = 0;
591 SV *pv = sv;
79072805
LW		 592
593 if (!SvLEN(sv))
b3ac6de7 594 goto finish;
79072805 595
a0d0e21e 596 s = SvPV_force(sv, len);
748a9306 597 if (SvIVX(sv) == -1)
b3ac6de7 598 goto finish;
463ee0b2 599 send = s + len;
79072805
LW		 600 while (s < send && *s != '\\')
601 s++;
602 if (s == send)
b3ac6de7 603 goto finish;
79072805 604 d = s;
b3ac6de7
IZ		 605 if ( hints & HINT_NEW_STRING )
606 pv = sv_2mortal(newSVpv(SvPVX(pv), len));
79072805
LW		 607 while (s < send) {
608 if (*s == '\\') {
a0d0e21e 609 if (s + 1 < send && (s[1] == '\\'))
79072805
LW		 610 s++; /* all that, just for this */
611 }
612 *d++ = *s++;
613 }
614 *d = '\0';
463ee0b2 615 SvCUR_set(sv, d - SvPVX(sv));
b3ac6de7
IZ		 616 finish:
617 if ( hints & HINT_NEW_STRING )
618 return new_constant(NULL, 0, "q", sv, pv, "q");
79072805
LW		 619 return sv;
620}
621
76e3520e 622STATIC I32
8ac85365 623sublex_start(void)
79072805
LW		 624{
625 register I32 op_type = yylval.ival;
79072805
LW		 626
627 if (op_type == OP_NULL) {
628 yylval.opval = lex_op;
629 lex_op = Nullop;
630 return THING;
631 }
632 if (op_type == OP_CONST || op_type == OP_READLINE) {
76e3520e 633 SV *sv = tokeq(lex_stuff);
b3ac6de7
IZ		 634
635 if (SvTYPE(sv) == SVt_PVIV) {
636 /* Overloaded constants, nothing fancy: Convert to SVt_PV: */
637 STRLEN len;
638 char *p;
639 SV *nsv;
640
641 p = SvPV(sv, len);
642 nsv = newSVpv(p, len);
643 SvREFCNT_dec(sv);
644 sv = nsv;
645 }
646 yylval.opval = (OP*)newSVOP(op_type, 0, sv);
79072805
LW		 647 lex_stuff = Nullsv;
648 return THING;
649 }
650
55497cff 651 sublex_info.super_state = lex_state;
652 sublex_info.sub_inwhat = op_type;
653 sublex_info.sub_op = lex_op;
654 lex_state = LEX_INTERPPUSH;
655
656 expect = XTERM;
657 if (lex_op) {
658 yylval.opval = lex_op;
659 lex_op = Nullop;
660 return PMFUNC;
661 }
662 else
663 return FUNC;
664}
665
76e3520e 666STATIC I32
8ac85365 667sublex_push(void)
55497cff 668{
0f15f207 669 dTHR;
f46d017c 670 ENTER;
55497cff 671
672 lex_state = sublex_info.super_state;
673 SAVEI32(lex_dojoin);
674 SAVEI32(lex_brackets);
675 SAVEI32(lex_fakebrack);
676 SAVEI32(lex_casemods);
677 SAVEI32(lex_starts);
678 SAVEI32(lex_state);
a0d0e21e 679 SAVESPTR(lex_inpat);
55497cff 680 SAVEI32(lex_inwhat);
681 SAVEI16(curcop->cop_line);
85e6fe83
LW		 682 SAVEPPTR(bufptr);
683 SAVEPPTR(oldbufptr);
684 SAVEPPTR(oldoldbufptr);
fd049845 685 SAVEPPTR(linestart);
79072805 686 SAVESPTR(linestr);
85e6fe83 687 SAVEPPTR(lex_brackstack);
a0d0e21e 688 SAVEPPTR(lex_casestack);
79072805
LW		 689
690 linestr = lex_stuff;
691 lex_stuff = Nullsv;
692
fd049845 693 bufend = bufptr = oldbufptr = oldoldbufptr = linestart = SvPVX(linestr);
79072805 694 bufend += SvCUR(linestr);
8990e307 695 SAVEFREESV(linestr);
79072805
LW		 696
697 lex_dojoin = FALSE;
698 lex_brackets = 0;
699 lex_fakebrack = 0;
8990e307 700 New(899, lex_brackstack, 120, char);
a0d0e21e 701 New(899, lex_casestack, 12, char);
8990e307 702 SAVEFREEPV(lex_brackstack);
a0d0e21e 703 SAVEFREEPV(lex_casestack);
79072805 704 lex_casemods = 0;
a0d0e21e 705 *lex_casestack = '\0';
79072805
LW		 706 lex_starts = 0;
707 lex_state = LEX_INTERPCONCAT;
708 curcop->cop_line = multi_start;
709
55497cff 710 lex_inwhat = sublex_info.sub_inwhat;
711 if (lex_inwhat == OP_MATCH || lex_inwhat == OP_SUBST)
712 lex_inpat = sublex_info.sub_op;
79072805 713 else
55497cff 714 lex_inpat = Nullop;
79072805 715
55497cff 716 return '(';
79072805
LW		 717}
718
76e3520e 719STATIC I32
8ac85365 720sublex_done(void)
79072805
LW		 721{
722 if (!lex_starts++) {
723 expect = XOPERATOR;
93a17b20 724 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv("",0));
79072805
LW		 725 return THING;
726 }
727
728 if (lex_casemods) { /* oops, we've got some unbalanced parens */
729 lex_state = LEX_INTERPCASEMOD;
730 return yylex();
731 }
732
79072805
LW		 733 /* Is there a right-hand side to take care of? */
734 if (lex_repl && (lex_inwhat == OP_SUBST || lex_inwhat == OP_TRANS)) {
735 linestr = lex_repl;
736 lex_inpat = 0;
fd049845 737 bufend = bufptr = oldbufptr = oldoldbufptr = linestart = SvPVX(linestr);
79072805 738 bufend += SvCUR(linestr);
8990e307 739 SAVEFREESV(linestr);
79072805
LW		 740 lex_dojoin = FALSE;
741 lex_brackets = 0;
742 lex_fakebrack = 0;
743 lex_casemods = 0;
a0d0e21e 744 *lex_casestack = '\0';
79072805
LW		 745 lex_starts = 0;
746 if (SvCOMPILED(lex_repl)) {
747 lex_state = LEX_INTERPNORMAL;
748 lex_starts++;
749 }
750 else
751 lex_state = LEX_INTERPCONCAT;
752 lex_repl = Nullsv;
753 return ',';
ffed7fef
LW		 754 }
755 else {
f46d017c 756 LEAVE;
463ee0b2 757 bufend = SvPVX(linestr);
79072805
LW		 758 bufend += SvCUR(linestr);
759 expect = XOPERATOR;
760 return ')';
ffed7fef
LW		 761 }
762}
763
02aa26ce
NT		 764/*
765 scan_const
766
767 Extracts a pattern, double-quoted string, or transliteration. This
768 is terrifying code.
769
770 It looks at lex_inwhat and lex_inpat to find out whether it's
771 processing a pattern (lex_inpat is true), a transliteration
772 (lex_inwhat & OP_TRANS is true), or a double-quoted string.
773
9b599b2a
GS		 774 Returns a pointer to the character scanned up to. Iff this is
775 advanced from the start pointer supplied (ie if anything was
776 successfully parsed), will leave an OP for the substring scanned
777 in yylval. Caller must intuit reason for not parsing further
778 by looking at the next characters herself.
779
02aa26ce
NT		 780 In patterns:
781 backslashes:
782 double-quoted style: \r and \n
783 regexp special ones: \D \s
784 constants: \x3
785 backrefs: \1 (deprecated in substitution replacements)
786 case and quoting: \U \Q \E
787 stops on @ and $, but not for $ as tail anchor
788
789 In transliterations:
790 characters are VERY literal, except for - not at the start or end
791 of the string, which indicates a range. scan_const expands the
792 range to the full set of intermediate characters.
793
794 In double-quoted strings:
795 backslashes:
796 double-quoted style: \r and \n
797 constants: \x3
798 backrefs: \1 (deprecated)
799 case and quoting: \U \Q \E
800 stops on @ and $
801
802 scan_const does *not* construct ops to handle interpolated strings.
803 It stops processing as soon as it finds an embedded $ or @ variable
804 and leaves it to the caller to work out what's going on.
805
806 @ in pattern could be: @foo, @{foo}, @$foo, @'foo, @:foo.
807
808 $ in pattern could be $foo or could be tail anchor. Assumption:
809 it's a tail anchor if $ is the last thing in the string, or if it's
810 followed by one of ")| \n\t"
811
812 \1 (backreferences) are turned into $1
813
814 The structure of the code is
815 while (there's a character to process) {
816 handle transliteration ranges
817 skip regexp comments
818 skip # initiated comments in //x patterns
819 check for embedded @foo
820 check for embedded scalars
821 if (backslash) {
822 leave intact backslashes from leave (below)
823 deprecate \1 in strings and sub replacements
824 handle string-changing backslashes \l \U \Q \E, etc.
825 switch (what was escaped) {
826 handle - in a transliteration (becomes a literal -)
827 handle \132 octal characters
828 handle 0x15 hex characters
829 handle \cV (control V)
830 handle printf backslashes (\f, \r, \n, etc)
831 } (end switch)
832 } (end if backslash)
833 } (end while character to read)
834
835*/
836
76e3520e 837STATIC char *
8ac85365 838scan_const(char *start)
79072805 839{
02aa26ce
NT		 840 register char *send = bufend; /* end of the constant */
841 SV *sv = NEWSV(93, send - start); /* sv for the constant */
842 register char *s = start; /* start of the constant */
843 register char *d = SvPVX(sv); /* destination for copies */
844 bool dorange = FALSE; /* are we in a translit range? */
845 I32 len; /* ? */
846
9b599b2a 847 /* leaveit is the set of acceptably-backslashed characters */
72aaf631 848 char *leaveit =
79072805 849 lex_inpat
b85d18e9 850 ? "\\.^$@AGZdDwWsSbB+*?|()-nrtfeaxcz0123456789[{]} \t\n\r\f\v#"
9b599b2a 851 : "";
79072805
LW		 852
853 while (s < send || dorange) {
02aa26ce 854 /* get transliterations out of the way (they're most literal) */
79072805 855 if (lex_inwhat == OP_TRANS) {
02aa26ce 856 /* expand a range A-Z to the full set of characters. AIE! */
79072805 857 if (dorange) {
02aa26ce
NT		 858 I32 i; /* current expanded character */
859 I32 max; /* last character in range */
860
861 i = d - SvPVX(sv); /* remember current offset */
862 SvGROW(sv, SvLEN(sv) + 256); /* expand the sv -- there'll never be more'n 256 chars in a range for it to grow by */
863 d = SvPVX(sv) + i; /* restore d after the grow potentially has changed the ptr */
864 d -= 2; /* eat the first char and the - */
865
866 max = (U8)d[1]; /* last char in range */
867
91b7def8 868 for (i = (U8)*d; i <= max; i++)
79072805 869 *d++ = i;
02aa26ce
NT		 870
871 /* mark the range as done, and continue */
79072805
LW		 872 dorange = FALSE;
873 continue;
874 }
02aa26ce
NT		 875
876 /* range begins (ignore - as first or last char) */
79072805
LW		 877 else if (*s == '-' && s+1 < send && s != start) {
878 dorange = TRUE;
879 s++;
880 }
881 }
02aa26ce
NT		 882
883 /* if we get here, we're not doing a transliteration */
884
885 /* skip for regexp comments /(?#comment)/ */
cc6b7395
IZ		 886 else if (*s == '(' && lex_inpat && s[1] == '?') {
887 if (s[2] == '#') {
888 while (s < send && *s != ')')
889 *d++ = *s++;
890 } else if (s[2] == '{') { /* This should march regcomp.c */
891 I32 count = 1;
d9f97599 892 char *regparse = s + 3;
cc6b7395
IZ		 893 char c;
894
d9f97599
GS		 895 while (count && (c = *regparse)) {
896 if (c == '\\' && regparse[1])
897 regparse++;
cc6b7395
IZ		 898 else if (c == '{')
899 count++;
900 else if (c == '}')
901 count--;
d9f97599 902 regparse++;
cc6b7395 903 }
d9f97599
GS		 904 if (*regparse == ')')
905 regparse++;
cc6b7395
IZ		 906 else
907 yyerror("Sequence (?{...}) not terminated or not {}-balanced");
d9f97599 908 while (s < regparse && *s != ')')
cc6b7395
IZ		 909 *d++ = *s++;
910 }
748a9306 911 }
02aa26ce
NT		 912
913 /* likewise skip #-initiated comments in //x patterns */
748a9306
LW		 914 else if (*s == '#' && lex_inpat &&
915 ((PMOP*)lex_inpat)->op_pmflags & PMf_EXTENDED) {
916 while (s+1 < send && *s != '\n')
917 *d++ = *s++;
918 }
02aa26ce
NT		 919
920 /* check for embedded arrays (@foo, @:foo, @'foo, @{foo}, @$foo) */
a0d0e21e 921 else if (*s == '@' && s[1] && (isALNUM(s[1]) || strchr(":'{$", s[1])))
79072805 922 break;
02aa26ce
NT		 923
924 /* check for embedded scalars. only stop if we're sure it's a
925 variable.
926 */
79072805
LW		 927 else if (*s == '$') {
928 if (!lex_inpat) /* not a regexp, so $ must be var */
929 break;
c277df42 930 if (s + 1 < send && !strchr("()| \n\t", s[1]))
79072805
LW		 931 break; /* in regexp, $ might be tail anchor */
932 }
02aa26ce
NT		 933
934 /* backslashes */
79072805
LW		 935 if (*s == '\\' && s+1 < send) {
936 s++;
02aa26ce
NT		 937
938 /* some backslashes we leave behind */
72aaf631 939 if (*s && strchr(leaveit, *s)) {
79072805
LW		 940 *d++ = '\\';
941 *d++ = *s++;
942 continue;
943 }
02aa26ce
NT		 944
945 /* deprecate \1 in strings and substitution replacements */
79072805 946 if (lex_inwhat == OP_SUBST && !lex_inpat &&
a0d0e21e 947 isDIGIT(*s) && *s != '0' && !isDIGIT(s[1]))
79072805 948 {
a0d0e21e
LW		 949 if (dowarn)
950 warn("\\%c better written as $%c", *s, *s);
79072805
LW		 951 *--s = '$';
952 break;
953 }
02aa26ce
NT		 954
955 /* string-change backslash escapes */
a0d0e21e 956 if (lex_inwhat != OP_TRANS && *s && strchr("lLuUEQ", *s)) {
79072805
LW		 957 --s;
958 break;
959 }
02aa26ce
NT		 960
961 /* if we get here, it's either a quoted -, or a digit */
79072805 962 switch (*s) {
02aa26ce
NT		 963
964 /* quoted - in transliterations */
79072805
LW		 965 case '-':
966 if (lex_inwhat == OP_TRANS) {
967 *d++ = *s++;
968 continue;
969 }
970 /* FALL THROUGH */
02aa26ce 971 /* default action is to copy the quoted character */
79072805
LW		 972 default:
973 *d++ = *s++;
974 continue;
02aa26ce
NT		 975
976 /* \132 indicates an octal constant */
79072805
LW		 977 case '0': case '1': case '2': case '3':
978 case '4': case '5': case '6': case '7':
979 *d++ = scan_oct(s, 3, &len);
980 s += len;
981 continue;
02aa26ce
NT		 982
983 /* \x24 indicates a hex constant */
79072805
LW		 984 case 'x':
985 *d++ = scan_hex(++s, 2, &len);
986 s += len;
987 continue;
02aa26ce
NT		 988
989 /* \c is a control character */
79072805
LW		 990 case 'c':
991 s++;
bbce6d69 992 len = *s++;
993 *d++ = toCTRL(len);
79072805 994 continue;
02aa26ce
NT		 995
996 /* printf-style backslashes, formfeeds, newlines, etc */
79072805
LW		 997 case 'b':
998 *d++ = '\b';
999 break;
1000 case 'n':
1001 *d++ = '\n';
1002 break;
1003 case 'r':
1004 *d++ = '\r';
1005 break;
1006 case 'f':
1007 *d++ = '\f';
1008 break;
1009 case 't':
1010 *d++ = '\t';
1011 break;
1012 case 'e':
1013 *d++ = '\033';
1014 break;
1015 case 'a':
1016 *d++ = '\007';
1017 break;
02aa26ce
NT		 1018 } /* end switch */
1019
79072805
LW		 1020 s++;
1021 continue;
02aa26ce
NT		 1022 } /* end if (backslash) */
1023
79072805 1024 *d++ = *s++;
02aa26ce
NT		 1025 } /* while loop to process each character */
1026
1027 /* terminate the string and set up the sv */
79072805 1028 *d = '\0';
463ee0b2 1029 SvCUR_set(sv, d - SvPVX(sv));
79072805
LW		 1030 SvPOK_on(sv);
1031
02aa26ce 1032 /* shrink the sv if we allocated more than we used */
79072805
LW		 1033 if (SvCUR(sv) + 5 < SvLEN(sv)) {
1034 SvLEN_set(sv, SvCUR(sv) + 1);
463ee0b2 1035 Renew(SvPVX(sv), SvLEN(sv), char);
79072805 1036 }
02aa26ce 1037
9b599b2a 1038 /* return the substring (via yylval) only if we parsed anything */
b3ac6de7
IZ		 1039 if (s > bufptr) {
1040 if ( hints & ( lex_inpat ? HINT_NEW_RE : HINT_NEW_STRING ) )
1041 sv = new_constant(start, s - start, (lex_inpat ? "qr" : "q"),
1042 sv, Nullsv,
1043 ( lex_inwhat == OP_TRANS
1044 ? "tr"
1045 : ( (lex_inwhat == OP_SUBST && !lex_inpat)
1046 ? "s"
1047 : "qq")));
79072805 1048 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
b3ac6de7 1049 } else
8990e307 1050 SvREFCNT_dec(sv);
79072805
LW		 1051 return s;
1052}
1053
1054/* This is the one truly awful dwimmer necessary to conflate C and sed. */
76e3520e 1055STATIC int
8ac85365 1056intuit_more(register char *s)
79072805
LW		 1057{
1058 if (lex_brackets)
1059 return TRUE;
1060 if (*s == '-' && s[1] == '>' && (s[2] == '[' || s[2] == '{'))
1061 return TRUE;
1062 if (*s != '{' && *s != '[')
1063 return FALSE;
1064 if (!lex_inpat)
1065 return TRUE;
1066
1067 /* In a pattern, so maybe we have {n,m}. */
1068 if (*s == '{') {
1069 s++;
1070 if (!isDIGIT(*s))
1071 return TRUE;
1072 while (isDIGIT(*s))
1073 s++;
1074 if (*s == ',')
1075 s++;
1076 while (isDIGIT(*s))
1077 s++;
1078 if (*s == '}')
1079 return FALSE;
1080 return TRUE;
1081
1082 }
1083
1084 /* On the other hand, maybe we have a character class */
1085
1086 s++;
1087 if (*s == ']' || *s == '^')
1088 return FALSE;
1089 else {
1090 int weight = 2; /* let's weigh the evidence */
1091 char seen[256];
f27ffc4a 1092 unsigned char un_char = 255, last_un_char;
93a17b20 1093 char *send = strchr(s,']');
8903cb82 1094 char tmpbuf[sizeof tokenbuf * 4];
79072805
LW		 1095
1096 if (!send) /* has to be an expression */
1097 return TRUE;
1098
1099 Zero(seen,256,char);
1100 if (*s == '$')
1101 weight -= 3;
1102 else if (isDIGIT(*s)) {
1103 if (s[1] != ']') {
1104 if (isDIGIT(s[1]) && s[2] == ']')
1105 weight -= 10;
1106 }
1107 else
1108 weight -= 100;
1109 }
1110 for (; s < send; s++) {
1111 last_un_char = un_char;
1112 un_char = (unsigned char)*s;
1113 switch (*s) {
1114 case '@':
1115 case '&':
1116 case '$':
1117 weight -= seen[un_char] * 10;
1118 if (isALNUM(s[1])) {
8903cb82 1119 scan_ident(s, send, tmpbuf, sizeof tmpbuf, FALSE);
a0d0e21e 1120 if ((int)strlen(tmpbuf) > 1 && gv_fetchpv(tmpbuf,FALSE, SVt_PV))
79072805
LW		 1121 weight -= 100;
1122 else
1123 weight -= 10;
1124 }
1125 else if (*s == '$' && s[1] &&
93a17b20
LW		 1126 strchr("[#!%*<>()-=",s[1])) {
1127 if (/*{*/ strchr("])} =",s[2]))
79072805
LW		 1128 weight -= 10;
1129 else
1130 weight -= 1;
1131 }
1132 break;
1133 case '\\':
1134 un_char = 254;
1135 if (s[1]) {
93a17b20 1136 if (strchr("wds]",s[1]))
79072805
LW		 1137 weight += 100;
1138 else if (seen['\''] || seen['"'])
1139 weight += 1;
93a17b20 1140 else if (strchr("rnftbxcav",s[1]))
79072805
LW		 1141 weight += 40;
1142 else if (isDIGIT(s[1])) {
1143 weight += 40;
1144 while (s[1] && isDIGIT(s[1]))
1145 s++;
1146 }
1147 }
1148 else
1149 weight += 100;
1150 break;
1151 case '-':
1152 if (s[1] == '\\')
1153 weight += 50;
93a17b20 1154 if (strchr("aA01! ",last_un_char))
79072805 1155 weight += 30;
93a17b20 1156 if (strchr("zZ79~",s[1]))
79072805 1157 weight += 30;
f27ffc4a
GS		 1158 if (last_un_char == 255 && (isDIGIT(s[1]) || s[1] == '$'))
1159 weight -= 5; /* cope with negative subscript */
79072805
LW		 1160 break;
1161 default:
93a17b20 1162 if (!isALNUM(last_un_char) && !strchr("$@&",last_un_char) &&
79072805
LW		 1163 isALPHA(*s) && s[1] && isALPHA(s[1])) {
1164 char *d = tmpbuf;
1165 while (isALPHA(*s))
1166 *d++ = *s++;
1167 *d = '\0';
1168 if (keyword(tmpbuf, d - tmpbuf))
1169 weight -= 150;
1170 }
1171 if (un_char == last_un_char + 1)
1172 weight += 5;
1173 weight -= seen[un_char];
1174 break;
1175 }
1176 seen[un_char]++;
1177 }
1178 if (weight >= 0) /* probably a character class */
1179 return FALSE;
1180 }
1181
1182 return TRUE;
1183}
ffed7fef 1184
76e3520e 1185STATIC int
8ac85365 1186intuit_method(char *start, GV *gv)
a0d0e21e
LW		 1187{
1188 char *s = start + (*start == '$');
8903cb82 1189 char tmpbuf[sizeof tokenbuf];
a0d0e21e
LW		 1190 STRLEN len;
1191 GV* indirgv;
1192
1193 if (gv) {
b6c543e3 1194 CV *cv;
a0d0e21e
LW		 1195 if (GvIO(gv))
1196 return 0;
b6c543e3
IZ		 1197 if ((cv = GvCVu(gv))) {
1198 char *proto = SvPVX(cv);
1199 if (proto) {
1200 if (*proto == ';')
1201 proto++;
1202 if (*proto == '*')
1203 return 0;
1204 }
1205 } else
a0d0e21e
LW		 1206 gv = 0;
1207 }
8903cb82 1208 s = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
a0d0e21e
LW		 1209 if (*start == '$') {
1210 if (gv || last_lop_op == OP_PRINT || isUPPER(*tokenbuf))
1211 return 0;
1212 s = skipspace(s);
1213 bufptr = start;
1214 expect = XREF;
1215 return *s == '(' ? FUNCMETH : METHOD;
1216 }
1217 if (!keyword(tmpbuf, len)) {
c3e0f903
GS		 1218 if (len > 2 && tmpbuf[len - 2] == ':' && tmpbuf[len - 1] == ':') {
1219 len -= 2;
1220 tmpbuf[len] = '\0';
1221 goto bare_package;
1222 }
1223 indirgv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV);
8ebc5c01 1224 if (indirgv && GvCVu(indirgv))
a0d0e21e
LW		 1225 return 0;
1226 /* filehandle or package name makes it a method */
89bfa8cd 1227 if (!gv || GvIO(indirgv) || gv_stashpvn(tmpbuf, len, FALSE)) {
a0d0e21e 1228 s = skipspace(s);
55497cff 1229 if ((bufend - s) >= 2 && *s == '=' && *(s+1) == '>')
1230 return 0; /* no assumptions -- "=>" quotes bearword */
c3e0f903
GS		 1231 bare_package:
1232 nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0,
1233 newSVpv(tmpbuf,0));
1234 nextval[nexttoke].opval->op_private = OPpCONST_BARE;
a0d0e21e
LW		 1235 expect = XTERM;
1236 force_next(WORD);
1237 bufptr = s;
1238 return *s == '(' ? FUNCMETH : METHOD;
1239 }
1240 }
1241 return 0;
1242}
1243
76e3520e 1244STATIC char*
8ac85365 1245incl_perldb(void)
a0d0e21e
LW		 1246{
1247 if (perldb) {
76e3520e 1248 char *pdb = PerlEnv_getenv("PERL5DB");
a0d0e21e
LW		 1249
1250 if (pdb)
1251 return pdb;
61bb5906 1252 SETERRNO(0,SS$_NORMAL);
a0d0e21e
LW		 1253 return "BEGIN { require 'perl5db.pl' }";
1254 }
1255 return "";
1256}
1257
1258
16d20bd9
AD		 1259/* Encoded script support. filter_add() effectively inserts a
1260 * 'pre-processing' function into the current source input stream.
1261 * Note that the filter function only applies to the current source file
1262 * (e.g., it will not affect files 'require'd or 'use'd by this one).
1263 *
1264 * The datasv parameter (which may be NULL) can be used to pass
1265 * private data to this instance of the filter. The filter function
1266 * can recover the SV using the FILTER_DATA macro and use it to
1267 * store private buffers and state information.
1268 *
1269 * The supplied datasv parameter is upgraded to a PVIO type
1270 * and the IoDIRP field is used to store the function pointer.
1271 * Note that IoTOP_NAME, IoFMT_NAME, IoBOTTOM_NAME, if set for
1272 * private use must be set using malloc'd pointers.
1273 */
1274static int filter_debug = 0;
1275
1276SV *
8ac85365 1277filter_add(filter_t funcp, SV *datasv)
16d20bd9
AD		 1278{
1279 if (!funcp){ /* temporary handy debugging hack to be deleted */
1280 filter_debug = atoi((char*)datasv);
1281 return NULL;
1282 }
1283 if (!rsfp_filters)
1284 rsfp_filters = newAV();
1285 if (!datasv)
8c52afec 1286 datasv = NEWSV(255,0);
16d20bd9
AD		 1287 if (!SvUPGRADE(datasv, SVt_PVIO))
1288 die("Can't upgrade filter_add data to SVt_PVIO");
1289 IoDIRP(datasv) = (DIR*)funcp; /* stash funcp into spare field */
1290 if (filter_debug)
ff0cee69 1291 warn("filter_add func %p (%s)", funcp, SvPV(datasv,na));
e50aee73
AD		 1292 av_unshift(rsfp_filters, 1);
1293 av_store(rsfp_filters, 0, datasv) ;
16d20bd9
AD		 1294 return(datasv);
1295}
1296
1297
1298/* Delete most recently added instance of this filter function. */
a0d0e21e 1299void
8ac85365 1300filter_del(filter_t funcp)
16d20bd9
AD		 1301{
1302 if (filter_debug)
ff0cee69 1303 warn("filter_del func %p", funcp);
93965878 1304 if (!rsfp_filters || AvFILLp(rsfp_filters)<0)
16d20bd9
AD		 1305 return;
1306 /* if filter is on top of stack (usual case) just pop it off */
93965878 1307 if (IoDIRP(FILTER_DATA(AvFILLp(rsfp_filters))) == (void*)funcp){
ff2faa2b 1308 sv_free(av_pop(rsfp_filters));
e50aee73 1309
16d20bd9
AD		 1310 return;
1311 }
1312 /* we need to search for the correct entry and clear it */
1313 die("filter_del can only delete in reverse order (currently)");
1314}
1315
1316
1317/* Invoke the n'th filter function for the current rsfp. */
1318I32
8ac85365
NIS		 1319filter_read(int idx, SV *buf_sv, int maxlen)
1320
1321
1322 /* 0 = read one text line */
a0d0e21e 1323{
16d20bd9
AD		 1324 filter_t funcp;
1325 SV *datasv = NULL;
e50aee73 1326
16d20bd9
AD		 1327 if (!rsfp_filters)
1328 return -1;
93965878 1329 if (idx > AvFILLp(rsfp_filters)){ /* Any more filters? */
16d20bd9
AD		 1330 /* Provide a default input filter to make life easy. */
1331 /* Note that we append to the line. This is handy. */
16d20bd9
AD		 1332 if (filter_debug)
1333 warn("filter_read %d: from rsfp\n", idx);
1334 if (maxlen) {
1335 /* Want a block */
1336 int len ;
1337 int old_len = SvCUR(buf_sv) ;
1338
1339 /* ensure buf_sv is large enough */
1340 SvGROW(buf_sv, old_len + maxlen) ;
760ac839
LW		 1341 if ((len = PerlIO_read(rsfp, SvPVX(buf_sv) + old_len, maxlen)) <= 0){
1342 if (PerlIO_error(rsfp))
37120919
AD		 1343 return -1; /* error */
1344 else
1345 return 0 ; /* end of file */
1346 }
16d20bd9
AD		 1347 SvCUR_set(buf_sv, old_len + len) ;
1348 } else {
1349 /* Want a line */
37120919 1350 if (sv_gets(buf_sv, rsfp, SvCUR(buf_sv)) == NULL) {
760ac839 1351 if (PerlIO_error(rsfp))
37120919
AD		 1352 return -1; /* error */
1353 else
1354 return 0 ; /* end of file */
1355 }
16d20bd9
AD		 1356 }
1357 return SvCUR(buf_sv);
1358 }
1359 /* Skip this filter slot if filter has been deleted */
1360 if ( (datasv = FILTER_DATA(idx)) == &sv_undef){
1361 if (filter_debug)
1362 warn("filter_read %d: skipped (filter deleted)\n", idx);
1363 return FILTER_READ(idx+1, buf_sv, maxlen); /* recurse */
1364 }
1365 /* Get function pointer hidden within datasv */
1366 funcp = (filter_t)IoDIRP(datasv);
1367 if (filter_debug)
ff0cee69 1368 warn("filter_read %d: via function %p (%s)\n",
16d20bd9
AD		 1369 idx, funcp, SvPV(datasv,na));
1370 /* Call function. The function is expected to */
1371 /* call "FILTER_READ(idx+1, buf_sv)" first. */
37120919 1372 /* Return: <0:error, =0:eof, >0:not eof */
1d583055 1373 return (*funcp)(PERL_OBJECT_THIS_ idx, buf_sv, maxlen);
16d20bd9
AD		 1374}
1375
76e3520e
GS		 1376STATIC char *
1377filter_gets(register SV *sv, register PerlIO *fp, STRLEN append)
16d20bd9 1378{
a868473f
NIS		 1379#ifdef WIN32FILTER
1380 if (!rsfp_filters) {
1381 filter_add(win32_textfilter,NULL);
1382 }
1383#endif
16d20bd9
AD		 1384 if (rsfp_filters) {
1385
55497cff 1386 if (!append)
1387 SvCUR_set(sv, 0); /* start with empty line */
16d20bd9
AD		 1388 if (FILTER_READ(0, sv, 0) > 0)
1389 return ( SvPVX(sv) ) ;
1390 else
1391 return Nullch ;
1392 }
1393 else
fd049845 1394 return (sv_gets(sv, fp, append));
a0d0e21e
LW		 1395}
1396
1397
748a9306
LW		 1398#ifdef DEBUGGING
1399 static char* exp_name[] =
a0d0e21e 1400 { "OPERATOR", "TERM", "REF", "STATE", "BLOCK", "TERMBLOCK" };
748a9306 1401#endif
463ee0b2 1402
71be2cbc 1403EXT int yychar; /* last token */
463ee0b2 1404
02aa26ce
NT		 1405/*
1406 yylex
1407
1408 Works out what to call the token just pulled out of the input
1409 stream. The yacc parser takes care of taking the ops we return and
1410 stitching them into a tree.
1411
1412 Returns:
1413 PRIVATEREF
1414
1415 Structure:
1416 if read an identifier
1417 if we're in a my declaration
1418 croak if they tried to say my($foo::bar)
1419 build the ops for a my() declaration
1420 if it's an access to a my() variable
1421 are we in a sort block?
1422 croak if my($a); $a <=> $b
1423 build ops for access to a my() variable
1424 if in a dq string, and they've said @foo and we can't find @foo
1425 croak
1426 build ops for a bareword
1427 if we already built the token before, use it.
1428*/
1429
2f3197b3 1430int
8ac85365 1431yylex(void)
378cc40b 1432{
11343788 1433 dTHR;
79072805 1434 register char *s;
378cc40b 1435 register char *d;
79072805 1436 register I32 tmp;
463ee0b2 1437 STRLEN len;
161b471a
NIS		 1438 GV *gv = Nullgv;
1439 GV **gvp = 0;
a687059c 1440
02aa26ce 1441 /* check if there's an identifier for us to look at */
bbce6d69 1442 if (pending_ident) {
02aa26ce 1443 /* pit holds the identifier we read and pending_ident is reset */
bbce6d69 1444 char pit = pending_ident;
1445 pending_ident = 0;
1446
02aa26ce
NT		 1447 /* if we're in a my(), we can't allow dynamics here.
1448 $foo'bar has already been turned into $foo::bar, so
1449 just check for colons.
1450
1451 if it's a legal name, the OP is a PADANY.
1452 */
bbce6d69 1453 if (in_my) {
1454 if (strchr(tokenbuf,':'))
1455 croak(no_myglob,tokenbuf);
02aa26ce 1456
bbce6d69 1457 yylval.opval = newOP(OP_PADANY, 0);
1458 yylval.opval->op_targ = pad_allocmy(tokenbuf);
1459 return PRIVATEREF;
1460 }
1461
02aa26ce
NT		 1462 /*
1463 build the ops for accesses to a my() variable.
1464
1465 Deny my($a) or my($b) in a sort block, *if* $a or $b is
1466 then used in a comparison. This catches most, but not
1467 all cases. For instance, it catches
1468 sort { my($a); $a <=> $b }
1469 but not
1470 sort { my($a); $a < $b ? -1 : $a == $b ? 0 : 1; }
1471 (although why you'd do that is anyone's guess).
1472 */
1473
a863c7d1
MB		 1474 if (!strchr(tokenbuf,':')) {
1475#ifdef USE_THREADS
54b9620d 1476 /* Check for single character per-thread SVs */
a863c7d1 1477 if (tokenbuf[0] == '$' && tokenbuf[2] == '\0'
54b9620d
MB		 1478 && !isALPHA(tokenbuf[1]) /* Rule out obvious non-threadsvs */
1479 && (tmp = find_threadsv(&tokenbuf[1])) != NOT_IN_PAD)
554b3eca 1480 {
2faa37cc 1481 yylval.opval = newOP(OP_THREADSV, 0);
a863c7d1
MB		 1482 yylval.opval->op_targ = tmp;
1483 return PRIVATEREF;
1484 }
1485#endif /* USE_THREADS */
1486 if ((tmp = pad_findmy(tokenbuf)) != NOT_IN_PAD) {
02aa26ce 1487 /* if it's a sort block and they're naming $a or $b */
a863c7d1
MB		 1488 if (last_lop_op == OP_SORT &&
1489 tokenbuf[0] == '$' &&
1490 (tokenbuf[1] == 'a' || tokenbuf[1] == 'b')
1491 && !tokenbuf[2])
bbce6d69 1492 {
a863c7d1
MB		 1493 for (d = in_eval ? oldoldbufptr : linestart;
1494 d < bufend && *d != '\n';
1495 d++)
1496 {
1497 if (strnEQ(d,"<=>",3) || strnEQ(d,"cmp",3)) {
1498 croak("Can't use \"my %s\" in sort comparison",
1499 tokenbuf);
1500 }
bbce6d69 1501 }
1502 }
bbce6d69 1503
a863c7d1
MB		 1504 yylval.opval = newOP(OP_PADANY, 0);
1505 yylval.opval->op_targ = tmp;
1506 return PRIVATEREF;
1507 }
bbce6d69 1508 }
1509
02aa26ce
NT		 1510 /*
1511 Whine if they've said @foo in a doublequoted string,
1512 and @foo isn't a variable we can find in the symbol
1513 table.
1514 */
bbce6d69 1515 if (pit == '@' && lex_state != LEX_NORMAL && !lex_brackets) {
1516 GV *gv = gv_fetchpv(tokenbuf+1, FALSE, SVt_PVAV);
46fc3d4c 1517 if (!gv || ((tokenbuf[0] == '@') ? !GvAV(gv) : !GvHV(gv)))
1518 yyerror(form("In string, %s now must be written as \\%s",
1519 tokenbuf, tokenbuf));
bbce6d69 1520 }
1521
02aa26ce 1522 /* build ops for a bareword */
bbce6d69 1523 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf+1, 0));
1524 yylval.opval->op_private = OPpCONST_ENTERED;
93233ece 1525 gv_fetchpv(tokenbuf+1, in_eval ? (GV_ADDMULTI | 8) : TRUE,
bbce6d69 1526 ((tokenbuf[0] == '$') ? SVt_PV
1527 : (tokenbuf[0] == '@') ? SVt_PVAV
1528 : SVt_PVHV));
1529 return WORD;
1530 }
1531
02aa26ce
NT		 1532 /* no identifier pending identification */
1533
79072805
LW		 1534 switch (lex_state) {
1535#ifdef COMMENTARY
1536 case LEX_NORMAL: /* Some compilers will produce faster */
1537 case LEX_INTERPNORMAL: /* code if we comment these out. */
1538 break;
1539#endif
1540
02aa26ce 1541 /* when we're already built the next token, just pull it out the queue */
79072805
LW		 1542 case LEX_KNOWNEXT:
1543 nexttoke--;
1544 yylval = nextval[nexttoke];
463ee0b2 1545 if (!nexttoke) {
79072805 1546 lex_state = lex_defer;
463ee0b2 1547 expect = lex_expect;
a0d0e21e 1548 lex_defer = LEX_NORMAL;
463ee0b2 1549 }
79072805
LW		 1550 return(nexttype[nexttoke]);
1551
02aa26ce
NT		 1552 /* interpolated case modifiers like \L \U, including \Q and \E.
1553 when we get here, bufptr is at the \
1554 */
79072805
LW		 1555 case LEX_INTERPCASEMOD:
1556#ifdef DEBUGGING
1557 if (bufptr != bufend && *bufptr != '\\')
463ee0b2 1558 croak("panic: INTERPCASEMOD");
79072805 1559#endif
02aa26ce
NT		 1560 /* handle \E or end of string */
1561 if (bufptr == bufend || bufptr[1] == 'E') {
a0d0e21e 1562 char oldmod;
02aa26ce
NT		 1563
1564 /* if at a \E */
79072805 1565 if (lex_casemods) {
a0d0e21e
LW		 1566 oldmod = lex_casestack[--lex_casemods];
1567 lex_casestack[lex_casemods] = '\0';
02aa26ce 1568
a0d0e21e
LW		 1569 if (bufptr != bufend && strchr("LUQ", oldmod)) {
1570 bufptr += 2;
1571 lex_state = LEX_INTERPCONCAT;
1572 }
79072805
LW		 1573 return ')';
1574 }
a0d0e21e
LW		 1575 if (bufptr != bufend)
1576 bufptr += 2;
1577 lex_state = LEX_INTERPCONCAT;
79072805
LW		 1578 return yylex();
1579 }
1580 else {
1581 s = bufptr + 1;
1582 if (strnEQ(s, "L\\u", 3) || strnEQ(s, "U\\l", 3))
1583 tmp = *s, *s = s[2], s[2] = tmp; /* misordered... */
a0d0e21e
LW		 1584 if (strchr("LU", *s) &&
1585 (strchr(lex_casestack, 'L') || strchr(lex_casestack, 'U')))
1586 {
1587 lex_casestack[--lex_casemods] = '\0';
1588 return ')';
1589 }
1590 if (lex_casemods > 10) {
89bfa8cd 1591 char* newlb = Renew(lex_casestack, lex_casemods + 2, char);
a0d0e21e
LW		 1592 if (newlb != lex_casestack) {
1593 SAVEFREEPV(newlb);
1594 lex_casestack = newlb;
1595 }
1596 }
1597 lex_casestack[lex_casemods++] = *s;
1598 lex_casestack[lex_casemods] = '\0';
79072805
LW		 1599 lex_state = LEX_INTERPCONCAT;
1600 nextval[nexttoke].ival = 0;
1601 force_next('(');
1602 if (*s == 'l')
1603 nextval[nexttoke].ival = OP_LCFIRST;
1604 else if (*s == 'u')
1605 nextval[nexttoke].ival = OP_UCFIRST;
1606 else if (*s == 'L')
1607 nextval[nexttoke].ival = OP_LC;
1608 else if (*s == 'U')
1609 nextval[nexttoke].ival = OP_UC;
a0d0e21e
LW		 1610 else if (*s == 'Q')
1611 nextval[nexttoke].ival = OP_QUOTEMETA;
79072805 1612 else
463ee0b2 1613 croak("panic: yylex");
79072805
LW		 1614 bufptr = s + 1;
1615 force_next(FUNC);
1616 if (lex_starts) {
1617 s = bufptr;
463ee0b2 1618 lex_starts = 0;
79072805
LW		 1619 Aop(OP_CONCAT);
1620 }
1621 else
1622 return yylex();
1623 }
1624
55497cff 1625 case LEX_INTERPPUSH:
1626 return sublex_push();
1627
79072805
LW		 1628 case LEX_INTERPSTART:
1629 if (bufptr == bufend)
1630 return sublex_done();
1631 expect = XTERM;
1632 lex_dojoin = (*bufptr == '@');
1633 lex_state = LEX_INTERPNORMAL;
1634 if (lex_dojoin) {
1635 nextval[nexttoke].ival = 0;
1636 force_next(',');
554b3eca 1637#ifdef USE_THREADS
2faa37cc 1638 nextval[nexttoke].opval = newOP(OP_THREADSV, 0);
54b9620d 1639 nextval[nexttoke].opval->op_targ = find_threadsv("\"");
554b3eca
MB		 1640 force_next(PRIVATEREF);
1641#else
a0d0e21e 1642 force_ident("\"", '$');
554b3eca 1643#endif /* USE_THREADS */
79072805
LW		 1644 nextval[nexttoke].ival = 0;
1645 force_next('$');
1646 nextval[nexttoke].ival = 0;
1647 force_next('(');
1648 nextval[nexttoke].ival = OP_JOIN; /* emulate join($", ...) */
1649 force_next(FUNC);
1650 }
1651 if (lex_starts++) {
1652 s = bufptr;
1653 Aop(OP_CONCAT);
1654 }
68dc0745 1655 return yylex();
79072805
LW		 1656
1657 case LEX_INTERPENDMAYBE:
1658 if (intuit_more(bufptr)) {
1659 lex_state = LEX_INTERPNORMAL; /* false alarm, more expr */
1660 break;
1661 }
1662 /* FALL THROUGH */
1663
1664 case LEX_INTERPEND:
1665 if (lex_dojoin) {
1666 lex_dojoin = FALSE;
1667 lex_state = LEX_INTERPCONCAT;
1668 return ')';
1669 }
1670 /* FALLTHROUGH */
1671 case LEX_INTERPCONCAT:
1672#ifdef DEBUGGING
1673 if (lex_brackets)
463ee0b2 1674 croak("panic: INTERPCONCAT");
79072805
LW		 1675#endif
1676 if (bufptr == bufend)
1677 return sublex_done();
1678
ed6116ce 1679 if (SvIVX(linestr) == '\'') {
79072805
LW		 1680 SV *sv = newSVsv(linestr);
1681 if (!lex_inpat)
76e3520e 1682 sv = tokeq(sv);
b3ac6de7
IZ		 1683 else if ( hints & HINT_NEW_RE )
1684 sv = new_constant(NULL, 0, "qr", sv, sv, "q");
79072805
LW		 1685 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
1686 s = bufend;
1687 }
1688 else {
1689 s = scan_const(bufptr);
1690 if (*s == '\\')
1691 lex_state = LEX_INTERPCASEMOD;
1692 else
1693 lex_state = LEX_INTERPSTART;
1694 }
1695
1696 if (s != bufptr) {
1697 nextval[nexttoke] = yylval;
463ee0b2 1698 expect = XTERM;
79072805
LW		 1699 force_next(THING);
1700 if (lex_starts++)
1701 Aop(OP_CONCAT);
1702 else {
1703 bufptr = s;
1704 return yylex();
1705 }
1706 }
1707
1708 return yylex();
a0d0e21e
LW		 1709 case LEX_FORMLINE:
1710 lex_state = LEX_NORMAL;
1711 s = scan_formline(bufptr);
1712 if (!lex_formbrack)
1713 goto rightbracket;
1714 OPERATOR(';');
79072805
LW		 1715 }
1716
1717 s = bufptr;
a687059c
LW		 1718 oldoldbufptr = oldbufptr;
1719 oldbufptr = s;
79072805 1720 DEBUG_p( {
760ac839 1721 PerlIO_printf(PerlIO_stderr(), "### Tokener expecting %s at %s\n", exp_name[expect], s);
79072805 1722 } )
463ee0b2
LW		 1723
1724 retry:
378cc40b
LW		 1725 switch (*s) {
1726 default:
54310121 1727 croak("Unrecognized character \\%03o", *s & 255);
e929a76b
LW		 1728 case 4:
1729 case 26:
1730 goto fake_eof; /* emulate EOF on ^D or ^Z */
378cc40b 1731 case 0:
463ee0b2 1732 if (!rsfp) {
55497cff 1733 last_uni = 0;
1734 last_lop = 0;
463ee0b2
LW		 1735 if (lex_brackets)
1736 yyerror("Missing right bracket");
79072805 1737 TOKEN(0);
463ee0b2 1738 }
a687059c
LW		 1739 if (s++ < bufend)
1740 goto retry; /* ignore stray nulls */
2f3197b3 1741 last_uni = 0;
79072805 1742 last_lop = 0;
a0d0e21e 1743 if (!in_eval && !preambled) {
79072805 1744 preambled = TRUE;
a0d0e21e 1745 sv_setpv(linestr,incl_perldb());
91b7def8 1746 if (SvCUR(linestr))
1747 sv_catpv(linestr,";");
1748 if (preambleav){
93965878 1749 while(AvFILLp(preambleav) >= 0) {
91b7def8 1750 SV *tmpsv = av_shift(preambleav);
1751 sv_catsv(linestr, tmpsv);
1752 sv_catpv(linestr, ";");
1753 sv_free(tmpsv);
1754 }
1755 sv_free((SV*)preambleav);
1756 preambleav = NULL;
1757 }
79072805
LW		 1758 if (minus_n || minus_p) {
1759 sv_catpv(linestr, "LINE: while (<>) {");
1760 if (minus_l)
a0d0e21e 1761 sv_catpv(linestr,"chomp;");
8fd239a7
CS		 1762 if (minus_a) {
1763 GV* gv = gv_fetchpv("::F", TRUE, SVt_PVAV);
1764 if (gv)
1765 GvIMPORTED_AV_on(gv);
1766 if (minus_F) {
54310121 1767 if (strchr("/'\"", *splitstr)
1768 && strchr(splitstr + 1, *splitstr))
46fc3d4c 1769 sv_catpvf(linestr, "@F=split(%s);", splitstr);
54310121 1770 else {
1771 char delim;
1772 s = "'~#\200\1'"; /* surely one char is unused...*/
1773 while (s[1] && strchr(splitstr, *s)) s++;
1774 delim = *s;
46fc3d4c 1775 sv_catpvf(linestr, "@F=split(%s%c",
1776 "q" + (delim == '\''), delim);
1777 for (s = splitstr; *s; s++) {
54310121 1778 if (*s == '\\')
46fc3d4c 1779 sv_catpvn(linestr, "\\", 1);
1780 sv_catpvn(linestr, s, 1);
54310121 1781 }
46fc3d4c 1782 sv_catpvf(linestr, "%c);", delim);
54310121 1783 }
2304df62
AD		 1784 }
1785 else
1786 sv_catpv(linestr,"@F=split(' ');");
1787 }
79072805 1788 }
a0d0e21e 1789 sv_catpv(linestr, "\n");
fd049845 1790 oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
463ee0b2 1791 bufend = SvPVX(linestr) + SvCUR(linestr);
84902520 1792 if (PERLDB_LINE && curstash != debstash) {
a0d0e21e
LW		 1793 SV *sv = NEWSV(85,0);
1794
1795 sv_upgrade(sv, SVt_PVMG);
1796 sv_setsv(sv,linestr);
1797 av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv);
1798 }
79072805 1799 goto retry;
a687059c 1800 }
e929a76b 1801 do {
fd049845 1802 if ((s = filter_gets(linestr, rsfp, 0)) == Nullch) {
e929a76b 1803 fake_eof:
395c3793 1804 if (rsfp) {
a0d0e21e 1805 if (preprocess && !in_eval)
6ad3d225 1806 (void)PerlProc_pclose(rsfp);
760ac839
LW		 1807 else if ((PerlIO *)rsfp == PerlIO_stdin())
1808 PerlIO_clearerr(rsfp);
395c3793 1809 else
760ac839 1810 (void)PerlIO_close(rsfp);
395c3793
LW		 1811 rsfp = Nullfp;
1812 }
a0d0e21e 1813 if (!in_eval && (minus_n || minus_p)) {
79072805
LW		 1814 sv_setpv(linestr,minus_p ? ";}continue{print" : "");
1815 sv_catpv(linestr,";}");
fd049845 1816 oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
463ee0b2 1817 bufend = SvPVX(linestr) + SvCUR(linestr);
e929a76b
LW		 1818 minus_n = minus_p = 0;
1819 goto retry;
1820 }
fd049845 1821 oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
79072805
LW		 1822 sv_setpv(linestr,"");
1823 TOKEN(';'); /* not infinite loop because rsfp is NULL now */
378cc40b 1824 }
a0d0e21e
LW		 1825 if (doextract) {
1826 if (*s == '#' && s[1] == '!' && instr(s,"perl"))
1827 doextract = FALSE;
1828
1829 /* Incest with pod. */
1830 if (*s == '=' && strnEQ(s, "=cut", 4)) {
1831 sv_setpv(linestr, "");
fd049845 1832 oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
a0d0e21e
LW		 1833 bufend = SvPVX(linestr) + SvCUR(linestr);
1834 doextract = FALSE;
1835 }
1836 }
463ee0b2 1837 incline(s);
e929a76b 1838 } while (doextract);
fd049845 1839 oldoldbufptr = oldbufptr = bufptr = linestart = s;
84902520 1840 if (PERLDB_LINE && curstash != debstash) {
79072805 1841 SV *sv = NEWSV(85,0);
a687059c 1842
93a17b20 1843 sv_upgrade(sv, SVt_PVMG);
79072805
LW		 1844 sv_setsv(sv,linestr);
1845 av_store(GvAV(curcop->cop_filegv),(I32)curcop->cop_line,sv);
a687059c 1846 }
463ee0b2 1847 bufend = SvPVX(linestr) + SvCUR(linestr);
79072805
LW		 1848 if (curcop->cop_line == 1) {
1849 while (s < bufend && isSPACE(*s))
1850 s++;
a0d0e21e 1851 if (*s == ':' && s[1] != ':') /* for csh execing sh scripts */
79072805 1852 s++;
44a8e56a 1853 d = Nullch;
1854 if (!in_eval) {
1855 if (*s == '#' && *(s+1) == '!')
1856 d = s + 2;
1857#ifdef ALTERNATE_SHEBANG
1858 else {
1859 static char as[] = ALTERNATE_SHEBANG;
1860 if (*s == as[0] && strnEQ(s, as, sizeof(as) - 1))
1861 d = s + (sizeof(as) - 1);
1862 }
1863#endif /* ALTERNATE_SHEBANG */
1864 }
1865 if (d) {
b8378b72 1866 char *ipath;
774d564b 1867 char *ipathend;
b8378b72 1868
774d564b 1869 while (isSPACE(*d))
b8378b72
CS		 1870 d++;
1871 ipath = d;
774d564b 1872 while (*d && !isSPACE(*d))
1873 d++;
1874 ipathend = d;
1875
1876#ifdef ARG_ZERO_IS_SCRIPT
1877 if (ipathend > ipath) {
1878 /*
1879 * HP-UX (at least) sets argv[0] to the script name,
1880 * which makes $^X incorrect. And Digital UNIX and Linux,
1881 * at least, set argv[0] to the basename of the Perl
1882 * interpreter. So, having found "#!", we'll set it right.
1883 */
1884 SV *x = GvSV(gv_fetchpv("\030", TRUE, SVt_PV));
1885 assert(SvPOK(x) || SvGMAGICAL(x));
9607fc9c 1886 if (sv_eq(x, GvSV(curcop->cop_filegv))) {
774d564b 1887 sv_setpvn(x, ipath, ipathend - ipath);
9607fc9c 1888 SvSETMAGIC(x);
1889 }
774d564b 1890 TAINT_NOT; /* $^X is always tainted, but that's OK */
8ebc5c01 1891 }
774d564b 1892#endif /* ARG_ZERO_IS_SCRIPT */
b8378b72
CS		 1893
1894 /*
1895 * Look for options.
1896 */
748a9306
LW		 1897 d = instr(s,"perl -");
1898 if (!d)
1899 d = instr(s,"perl");
44a8e56a 1900#ifdef ALTERNATE_SHEBANG
1901 /*
1902 * If the ALTERNATE_SHEBANG on this system starts with a
1903 * character that can be part of a Perl expression, then if
1904 * we see it but not "perl", we're probably looking at the
1905 * start of Perl code, not a request to hand off to some
1906 * other interpreter. Similarly, if "perl" is there, but
1907 * not in the first 'word' of the line, we assume the line
1908 * contains the start of the Perl program.
44a8e56a 1909 */
1910 if (d && *s != '#') {
774d564b 1911 char *c = ipath;
44a8e56a 1912 while (*c && !strchr("; \t\r\n\f\v#", *c))
1913 c++;
1914 if (c < d)
1915 d = Nullch; /* "perl" not in first word; ignore */
1916 else
1917 *s = '#'; /* Don't try to parse shebang line */
1918 }
774d564b 1919#endif /* ALTERNATE_SHEBANG */
748a9306 1920 if (!d &&
44a8e56a 1921 *s == '#' &&
774d564b 1922 ipathend > ipath &&
748a9306
LW		 1923 !minus_c &&
1924 !instr(s,"indir") &&
1925 instr(origargv[0],"perl"))
1926 {
9f68db38 1927 char **newargv;
9f68db38 1928
774d564b 1929 *ipathend = '\0';
1930 s = ipathend + 1;
de3bb511 1931 while (s < bufend && isSPACE(*s))
9f68db38
LW		 1932 s++;
1933 if (s < bufend) {
1934 Newz(899,newargv,origargc+3,char*);
1935 newargv[1] = s;
de3bb511 1936 while (s < bufend && !isSPACE(*s))
9f68db38
LW		 1937 s++;
1938 *s = '\0';
1939 Copy(origargv+1, newargv+2, origargc+1, char*);
1940 }
1941 else
1942 newargv = origargv;
774d564b 1943 newargv[0] = ipath;
1944 execv(ipath, newargv);
1945 croak("Can't exec %s", ipath);
9f68db38 1946 }
748a9306 1947 if (d) {
ba6d6ac9
CS		 1948 U32 oldpdb = perldb;
1949 bool oldn = minus_n;
1950 bool oldp = minus_p;
748a9306
LW		 1951
1952 while (*d && !isSPACE(*d)) d++;
89bfa8cd 1953 while (*d == ' ' || *d == '\t') d++;
748a9306
LW		 1954
1955 if (*d++ == '-') {
8cc95fdb 1956 do {
1957 if (*d == 'M' || *d == 'm') {
1958 char *m = d;
1959 while (*d && !isSPACE(*d)) d++;
1960 croak("Too late for \"-%.*s\" option",
1961 (int)(d - m), m);
1962 }
1963 d = moreswitches(d);
1964 } while (d);
84902520 1965 if (PERLDB_LINE && !oldpdb ||
b084f20b 1966 ( minus_n || minus_p ) && !(oldn || oldp) )
1967 /* if we have already added "LINE: while (<>) {",
1968 we must not do it again */
748a9306
LW		 1969 {
1970 sv_setpv(linestr, "");
fd049845 1971 oldoldbufptr = oldbufptr = s = linestart = SvPVX(linestr);
748a9306
LW		 1972 bufend = SvPVX(linestr) + SvCUR(linestr);
1973 preambled = FALSE;
84902520 1974 if (PERLDB_LINE)
748a9306
LW		 1975 (void)gv_fetchfile(origfilename);
1976 goto retry;
1977 }
a0d0e21e 1978 }
79072805 1979 }
9f68db38 1980 }
79072805 1981 }
85e6fe83 1982 if (lex_formbrack && lex_brackets <= lex_formbrack) {
a0d0e21e
LW		 1983 bufptr = s;
1984 lex_state = LEX_FORMLINE;
1985 return yylex();
ae986130 1986 }
378cc40b 1987 goto retry;
4fdae800 1988 case '\r':
a868473f 1989#ifndef WIN32CHEAT
54310121 1990 warn("Illegal character \\%03o (carriage return)", '\r');
1991 croak(
1992 "(Maybe you didn't strip carriage returns after a network transfer?)\n");
a868473f 1993#endif
4fdae800 1994 case ' ': case '\t': case '\f': case 013:
378cc40b
LW		 1995 s++;
1996 goto retry;
378cc40b 1997 case '#':
e929a76b 1998 case '\n':
79072805 1999 if (lex_state != LEX_NORMAL || (in_eval && !rsfp)) {
a687059c
LW		 2000 d = bufend;
2001 while (s < d && *s != '\n')
378cc40b 2002 s++;
0f85fab0 2003 if (s < d)
378cc40b 2004 s++;
463ee0b2 2005 incline(s);
85e6fe83 2006 if (lex_formbrack && lex_brackets <= lex_formbrack) {
a0d0e21e
LW		 2007 bufptr = s;
2008 lex_state = LEX_FORMLINE;
2009 return yylex();
a687059c 2010 }
378cc40b 2011 }
a687059c 2012 else {
378cc40b 2013 *s = '\0';
a687059c
LW		 2014 bufend = s;
2015 }
378cc40b
LW		 2016 goto retry;
2017 case '-':
79072805 2018 if (s[1] && isALPHA(s[1]) && !isALNUM(s[2])) {
378cc40b 2019 s++;
748a9306
LW		 2020 bufptr = s;
2021 tmp = *s++;
2022
2023 while (s < bufend && (*s == ' ' || *s == '\t'))
2024 s++;
2025
2026 if (strnEQ(s,"=>",2)) {
748a9306
LW		 2027 s = force_word(bufptr,WORD,FALSE,FALSE,FALSE);
2028 OPERATOR('-'); /* unary minus */
2029 }
e334a159 2030 last_uni = oldbufptr;
a0d0e21e 2031 last_lop_op = OP_FTEREAD; /* good enough */
748a9306 2032 switch (tmp) {
79072805
LW		 2033 case 'r': FTST(OP_FTEREAD);
2034 case 'w': FTST(OP_FTEWRITE);
2035 case 'x': FTST(OP_FTEEXEC);
2036 case 'o': FTST(OP_FTEOWNED);
2037 case 'R': FTST(OP_FTRREAD);
2038 case 'W': FTST(OP_FTRWRITE);
2039 case 'X': FTST(OP_FTREXEC);
2040 case 'O': FTST(OP_FTROWNED);
2041 case 'e': FTST(OP_FTIS);
2042 case 'z': FTST(OP_FTZERO);
2043 case 's': FTST(OP_FTSIZE);
2044 case 'f': FTST(OP_FTFILE);
2045 case 'd': FTST(OP_FTDIR);
2046 case 'l': FTST(OP_FTLINK);
2047 case 'p': FTST(OP_FTPIPE);
2048 case 'S': FTST(OP_FTSOCK);
2049 case 'u': FTST(OP_FTSUID);
2050 case 'g': FTST(OP_FTSGID);
2051 case 'k': FTST(OP_FTSVTX);
2052 case 'b': FTST(OP_FTBLK);
2053 case 'c': FTST(OP_FTCHR);
2054 case 't': FTST(OP_FTTTY);
2055 case 'T': FTST(OP_FTTEXT);
2056 case 'B': FTST(OP_FTBINARY);
85e6fe83
LW		 2057 case 'M': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTMTIME);
2058 case 'A': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTATIME);
2059 case 'C': gv_fetchpv("\024",TRUE, SVt_PV); FTST(OP_FTCTIME);
378cc40b 2060 default:
ff0cee69 2061 croak("Unrecognized file test: -%c", (int)tmp);
378cc40b
LW		 2062 break;
2063 }
2064 }
a687059c
LW		 2065 tmp = *s++;
2066 if (*s == tmp) {
2067 s++;
79072805
LW		 2068 if (expect == XOPERATOR)
2069 TERM(POSTDEC);
2070 else
2071 OPERATOR(PREDEC);
2072 }
2073 else if (*s == '>') {
2074 s++;
2075 s = skipspace(s);
2076 if (isIDFIRST(*s)) {
a0d0e21e 2077 s = force_word(s,METHOD,FALSE,TRUE,FALSE);
463ee0b2 2078 TOKEN(ARROW);
79072805 2079 }
748a9306
LW		 2080 else if (*s == '$')
2081 OPERATOR(ARROW);
463ee0b2 2082 else
748a9306 2083 TERM(ARROW);
a687059c 2084 }
79072805
LW		 2085 if (expect == XOPERATOR)
2086 Aop(OP_SUBTRACT);
2087 else {
2f3197b3
LW		 2088 if (isSPACE(*s) || !isSPACE(*bufptr))
2089 check_uni();
79072805 2090 OPERATOR('-'); /* unary minus */
2f3197b3 2091 }
79072805 2092
378cc40b 2093 case '+':
a687059c
LW		 2094 tmp = *s++;
2095 if (*s == tmp) {
378cc40b 2096 s++;
79072805
LW		 2097 if (expect == XOPERATOR)
2098 TERM(POSTINC);
2099 else
2100 OPERATOR(PREINC);
378cc40b 2101 }
79072805
LW		 2102 if (expect == XOPERATOR)
2103 Aop(OP_ADD);
2104 else {
2f3197b3
LW		 2105 if (isSPACE(*s) || !isSPACE(*bufptr))
2106 check_uni();
a687059c 2107 OPERATOR('+');
2f3197b3 2108 }
a687059c 2109
378cc40b 2110 case '*':
79072805 2111 if (expect != XOPERATOR) {
8903cb82 2112 s = scan_ident(s, bufend, tokenbuf, sizeof tokenbuf, TRUE);
463ee0b2 2113 expect = XOPERATOR;
a0d0e21e
LW		 2114 force_ident(tokenbuf, '*');
2115 if (!*tokenbuf)
2116 PREREF('*');
79072805 2117 TERM('*');
a687059c 2118 }
79072805
LW		 2119 s++;
2120 if (*s == '*') {
a687059c 2121 s++;
79072805 2122 PWop(OP_POW);
a687059c 2123 }
79072805
LW		 2124 Mop(OP_MULTIPLY);
2125
378cc40b 2126 case '%':
bbce6d69 2127 if (expect == XOPERATOR) {
2128 ++s;
2129 Mop(OP_MODULO);
a687059c 2130 }
bbce6d69 2131 tokenbuf[0] = '%';
8903cb82 2132 s = scan_ident(s, bufend, tokenbuf + 1, sizeof tokenbuf - 1, TRUE);
bbce6d69 2133 if (!tokenbuf[1]) {
2134 if (s == bufend)
2135 yyerror("Final % should be \\% or %name");
2136 PREREF('%');
a687059c 2137 }
bbce6d69 2138 pending_ident = '%';
2139 TERM('%');
a687059c 2140
378cc40b 2141 case '^':
79072805 2142 s++;
a0d0e21e 2143 BOop(OP_BIT_XOR);
79072805
LW		 2144 case '[':
2145 lex_brackets++;
2146 /* FALL THROUGH */
378cc40b 2147 case '~':
378cc40b 2148 case ',':
378cc40b
LW		 2149 tmp = *s++;
2150 OPERATOR(tmp);
a0d0e21e
LW		 2151 case ':':
2152 if (s[1] == ':') {
2153 len = 0;
2154 goto just_a_word;
2155 }
2156 s++;
2157 OPERATOR(':');
8990e307
LW		 2158 case '(':
2159 s++;
a0d0e21e 2160 if (last_lop == oldoldbufptr || last_uni == oldoldbufptr)
8990e307 2161 oldbufptr = oldoldbufptr; /* allow print(STDOUT 123) */
a0d0e21e
LW		 2162 else
2163 expect = XTERM;
2164 TOKEN('(');
378cc40b 2165 case ';':
79072805
LW		 2166 if (curcop->cop_line < copline)
2167 copline = curcop->cop_line;
378cc40b
LW		 2168 tmp = *s++;
2169 OPERATOR(tmp);
2170 case ')':
378cc40b 2171 tmp = *s++;
16d20bd9
AD		 2172 s = skipspace(s);
2173 if (*s == '{')
2174 PREBLOCK(tmp);
378cc40b 2175 TERM(tmp);
79072805
LW		 2176 case ']':
2177 s++;
463ee0b2
LW		 2178 if (lex_brackets <= 0)
2179 yyerror("Unmatched right bracket");
2180 else
2181 --lex_brackets;
79072805 2182 if (lex_state == LEX_INTERPNORMAL) {
463ee0b2 2183 if (lex_brackets == 0) {
a0d0e21e 2184 if (*s != '[' && *s != '{' && (*s != '-' || s[1] != '>'))
79072805
LW		 2185 lex_state = LEX_INTERPEND;
2186 }
2187 }
4633a7c4 2188 TERM(']');
79072805
LW		 2189 case '{':
2190 leftbracket:
79072805 2191 s++;
8990e307 2192 if (lex_brackets > 100) {
89bfa8cd 2193 char* newlb = Renew(lex_brackstack, lex_brackets + 1, char);
8990e307
LW		 2194 if (newlb != lex_brackstack) {
2195 SAVEFREEPV(newlb);
2196 lex_brackstack = newlb;
2197 }
2198 }
a0d0e21e
LW		 2199 switch (expect) {
2200 case XTERM:
2201 if (lex_formbrack) {
2202 s--;
2203 PRETERMBLOCK(DO);
2204 }
2205 if (oldoldbufptr == last_lop)
2206 lex_brackstack[lex_brackets++] = XTERM;
2207 else
2208 lex_brackstack[lex_brackets++] = XOPERATOR;
79072805 2209 OPERATOR(HASHBRACK);
a0d0e21e 2210 case XOPERATOR:
748a9306
LW		 2211 while (s < bufend && (*s == ' ' || *s == '\t'))
2212 s++;
44a8e56a 2213 d = s;
2214 tokenbuf[0] = '\0';
2215 if (d < bufend && *d == '-') {
2216 tokenbuf[0] = '-';
2217 d++;
2218 while (d < bufend && (*d == ' ' || *d == '\t'))
2219 d++;
2220 }
2221 if (d < bufend && isIDFIRST(*d)) {
8903cb82 2222 d = scan_word(d, tokenbuf + 1, sizeof tokenbuf - 1,
2223 FALSE, &len);
748a9306
LW		 2224 while (d < bufend && (*d == ' ' || *d == '\t'))
2225 d++;
2226 if (*d == '}') {
44a8e56a 2227 char minus = (tokenbuf[0] == '-');
44a8e56a 2228 s = force_word(s + minus, WORD, FALSE, TRUE, FALSE);
2229 if (minus)
2230 force_next('-');
748a9306
LW		 2231 }
2232 }
2233 /* FALL THROUGH */
2234 case XBLOCK:
a0d0e21e 2235 lex_brackstack[lex_brackets++] = XSTATE;
2304df62 2236 expect = XSTATE;
a0d0e21e
LW		 2237 break;
2238 case XTERMBLOCK:
2239 lex_brackstack[lex_brackets++] = XOPERATOR;
2240 expect = XSTATE;
2241 break;
2242 default: {
2243 char *t;
2244 if (oldoldbufptr == last_lop)
2245 lex_brackstack[lex_brackets++] = XTERM;
2246 else
2247 lex_brackstack[lex_brackets++] = XOPERATOR;
2248 s = skipspace(s);
09ecc4b6 2249 if (*s == '}')
a0d0e21e 2250 OPERATOR(HASHBRACK);
b8a4b1be
GS		 2251 /* This hack serves to disambiguate a pair of curlies
2252 * as being a block or an anon hash. Normally, expectation
2253 * determines that, but in cases where we're not in a
2254 * position to expect anything in particular (like inside
2255 * eval"") we have to resolve the ambiguity. This code
2256 * covers the case where the first term in the curlies is a
2257 * quoted string. Most other cases need to be explicitly
2258 * disambiguated by prepending a `+' before the opening
2259 * curly in order to force resolution as an anon hash.
2260 *
2261 * XXX should probably propagate the outer expectation
2262 * into eval"" to rely less on this hack, but that could
2263 * potentially break current behavior of eval"".
2264 * GSAR 97-07-21
2265 */
2266 t = s;
2267 if (*s == '\'' || *s == '"' || *s == '`') {
2268 /* common case: get past first string, handling escapes */
2269 for (t++; t < bufend && *t != *s;)
2270 if (*t++ == '\\' && (*t == '\\' || *t == *s))
2271 t++;
2272 t++;
a0d0e21e 2273 }
b8a4b1be
GS		 2274 else if (*s == 'q') {
2275 if (++t < bufend
2276 && (!isALNUM(*t)
2277 || ((*t == 'q' || *t == 'x') && ++t < bufend
2278 && !isALNUM(*t)))) {
2279 char *tmps;
2280 char open, close, term;
2281 I32 brackets = 1;
2282
2283 while (t < bufend && isSPACE(*t))
2284 t++;
2285 term = *t;
2286 open = term;
2287 if (term && (tmps = strchr("([{< )]}> )]}>",term)))
2288 term = tmps[5];
2289 close = term;
2290 if (open == close)
2291 for (t++; t < bufend; t++) {
6d07e5e9 2292 if (*t == '\\' && t+1 < bufend && open != '\\')
b8a4b1be 2293 t++;
6d07e5e9 2294 else if (*t == open)
b8a4b1be
GS		 2295 break;
2296 }
2297 else
2298 for (t++; t < bufend; t++) {
6d07e5e9 2299 if (*t == '\\' && t+1 < bufend)
b8a4b1be 2300 t++;
6d07e5e9 2301 else if (*t == close && --brackets <= 0)
b8a4b1be
GS		 2302 break;
2303 else if (*t == open)
2304 brackets++;
2305 }
2306 }
2307 t++;
a0d0e21e 2308 }
b8a4b1be
GS		 2309 else if (isALPHA(*s)) {
2310 for (t++; t < bufend && isALNUM(*t); t++) ;
a0d0e21e 2311 }
a0d0e21e
LW		 2312 while (t < bufend && isSPACE(*t))
2313 t++;
b8a4b1be
GS		 2314 /* if comma follows first term, call it an anon hash */
2315 /* XXX it could be a comma expression with loop modifiers */
2316 if (t < bufend && ((*t == ',' && (*s == 'q' || !isLOWER(*s)))
2317 || (*t == '=' && t[1] == '>')))
a0d0e21e
LW		 2318 OPERATOR(HASHBRACK);
2319 if (expect == XREF)
2320 expect = XTERM;
2321 else {
2322 lex_brackstack[lex_brackets-1] = XSTATE;
2323 expect = XSTATE;
2324 }
8990e307 2325 }
a0d0e21e 2326 break;
463ee0b2 2327 }
79072805
LW		 2328 yylval.ival = curcop->cop_line;
2329 if (isSPACE(*s) || *s == '#')
2330 copline = NOLINE; /* invalidate current command line number */
79072805 2331 TOKEN('{');
378cc40b 2332 case '}':
79072805
LW		 2333 rightbracket:
2334 s++;
463ee0b2
LW		 2335 if (lex_brackets <= 0)
2336 yyerror("Unmatched right bracket");
2337 else
2338 expect = (expectation)lex_brackstack[--lex_brackets];
85e6fe83
LW		 2339 if (lex_brackets < lex_formbrack)
2340 lex_formbrack = 0;
79072805 2341 if (lex_state == LEX_INTERPNORMAL) {
463ee0b2 2342 if (lex_brackets == 0) {
79072805
LW		 2343 if (lex_fakebrack) {
2344 lex_state = LEX_INTERPEND;
2345 bufptr = s;
2346 return yylex(); /* ignore fake brackets */
2347 }
fa83b5b6 2348 if (*s == '-' && s[1] == '>')
2349 lex_state = LEX_INTERPENDMAYBE;
2350 else if (*s != '[' && *s != '{')
79072805
LW		 2351 lex_state = LEX_INTERPEND;
2352 }
2353 }
748a9306
LW		 2354 if (lex_brackets < lex_fakebrack) {
2355 bufptr = s;
2356 lex_fakebrack = 0;
2357 return yylex(); /* ignore fake brackets */
2358 }
79072805
LW		 2359 force_next('}');
2360 TOKEN(';');
378cc40b
LW		 2361 case '&':
2362 s++;
2363 tmp = *s++;
2364 if (tmp == '&')
a0d0e21e 2365 AOPERATOR(ANDAND);
378cc40b 2366 s--;
463ee0b2 2367 if (expect == XOPERATOR) {
fd049845 2368 if (dowarn && isALPHA(*s) && bufptr == linestart) {
463ee0b2
LW		 2369 curcop->cop_line--;
2370 warn(warn_nosemi);
2371 curcop->cop_line++;
2372 }
79072805 2373 BAop(OP_BIT_AND);
463ee0b2 2374 }
79072805 2375
8903cb82 2376 s = scan_ident(s - 1, bufend, tokenbuf, sizeof tokenbuf, TRUE);
463ee0b2
LW		 2377 if (*tokenbuf) {
2378 expect = XOPERATOR;
a0d0e21e 2379 force_ident(tokenbuf, '&');
463ee0b2 2380 }
79072805
LW		 2381 else
2382 PREREF('&');
c07a80fd 2383 yylval.ival = (OPpENTERSUB_AMPER<<8);
79072805
LW		 2384 TERM('&');
2385
378cc40b
LW		 2386 case '|':
2387 s++;
2388 tmp = *s++;
2389 if (tmp == '|')
a0d0e21e 2390 AOPERATOR(OROR);
378cc40b 2391 s--;
79072805 2392 BOop(OP_BIT_OR);
378cc40b
LW		 2393 case '=':
2394 s++;
2395 tmp = *s++;
2396 if (tmp == '=')
79072805
LW		 2397 Eop(OP_EQ);
2398 if (tmp == '>')
2399 OPERATOR(',');
378cc40b 2400 if (tmp == '~')
79072805 2401 PMop(OP_MATCH);
463ee0b2 2402 if (dowarn && tmp && isSPACE(*s) && strchr("+-*/%.^&|<",tmp))
ff0cee69 2403 warn("Reversed %c= operator",(int)tmp);
378cc40b 2404 s--;
748a9306 2405 if (expect == XSTATE && isALPHA(tmp) &&
fd049845 2406 (s == linestart+1 || s[-2] == '\n') )
748a9306 2407 {
a5f75d66
AD		 2408 if (in_eval && !rsfp) {
2409 d = bufend;
2410 while (s < d) {
2411 if (*s++ == '\n') {
2412 incline(s);
2413 if (strnEQ(s,"=cut",4)) {
2414 s = strchr(s,'\n');
2415 if (s)
2416 s++;
2417 else
2418 s = d;
2419 incline(s);
2420 goto retry;
2421 }
2422 }
2423 }
2424 goto retry;
2425 }
a0d0e21e
LW		 2426 s = bufend;
2427 doextract = TRUE;
2428 goto retry;
2429 }
2430 if (lex_brackets < lex_formbrack) {
2431 char *t;
2432 for (t = s; *t == ' ' || *t == '\t'; t++) ;
2433 if (*t == '\n' || *t == '#') {
2434 s--;
2435 expect = XBLOCK;
2436 goto leftbracket;
2437 }
79072805 2438 }
a0d0e21e
LW		 2439 yylval.ival = 0;
2440 OPERATOR(ASSIGNOP);
378cc40b
LW		 2441 case '!':
2442 s++;
2443 tmp = *s++;
2444 if (tmp == '=')
79072805 2445 Eop(OP_NE);
378cc40b 2446 if (tmp == '~')
79072805 2447 PMop(OP_NOT);
378cc40b
LW		 2448 s--;
2449 OPERATOR('!');
2450 case '<':
79072805 2451 if (expect != XOPERATOR) {
93a17b20 2452 if (s[1] != '<' && !strchr(s,'>'))
2f3197b3 2453 check_uni();
79072805
LW		 2454 if (s[1] == '<')
2455 s = scan_heredoc(s);
2456 else
2457 s = scan_inputsymbol(s);
2458 TERM(sublex_start());
378cc40b
LW		 2459 }
2460 s++;
2461 tmp = *s++;
2462 if (tmp == '<')
79072805 2463 SHop(OP_LEFT_SHIFT);
395c3793
LW		 2464 if (tmp == '=') {
2465 tmp = *s++;
2466 if (tmp == '>')
79072805 2467 Eop(OP_NCMP);
395c3793 2468 s--;
79072805 2469 Rop(OP_LE);
395c3793 2470 }
378cc40b 2471 s--;
79072805 2472 Rop(OP_LT);
378cc40b
LW		 2473 case '>':
2474 s++;
2475 tmp = *s++;
2476 if (tmp == '>')
79072805 2477 SHop(OP_RIGHT_SHIFT);
378cc40b 2478 if (tmp == '=')
79072805 2479 Rop(OP_GE);
378cc40b 2480 s--;
79072805 2481 Rop(OP_GT);
378cc40b
LW		 2482
2483 case '$':
bbce6d69 2484 CLINE;
2485
8990e307 2486 if (expect == XOPERATOR) {
a0d0e21e
LW		 2487 if (lex_formbrack && lex_brackets == lex_formbrack) {
2488 expect = XTERM;
2489 depcom();
bbce6d69 2490 return ','; /* grandfather non-comma-format format */
a0d0e21e 2491 }
8990e307 2492 }
a0d0e21e 2493
bbce6d69 2494 if (s[1] == '#' && (isALPHA(s[2]) || strchr("_{$:", s[2]))) {
2495 if (expect == XOPERATOR)
2496 no_op("Array length", bufptr);
2497 tokenbuf[0] = '@';
8903cb82 2498 s = scan_ident(s + 1, bufend, tokenbuf + 1, sizeof tokenbuf - 1,
2499 FALSE);
bbce6d69 2500 if (!tokenbuf[1])
a0d0e21e 2501 PREREF(DOLSHARP);
463ee0b2 2502 expect = XOPERATOR;
bbce6d69 2503 pending_ident = '#';
463ee0b2 2504 TOKEN(DOLSHARP);
79072805 2505 }
bbce6d69 2506
2507 if (expect == XOPERATOR)
2508 no_op("Scalar", bufptr);
2509 tokenbuf[0] = '$';
8903cb82 2510 s = scan_ident(s, bufend, tokenbuf + 1, sizeof tokenbuf - 1, FALSE);
bbce6d69 2511 if (!tokenbuf[1]) {
2512 if (s == bufend)
2513 yyerror("Final $ should be \\$ or $name");
2514 PREREF('$');
8990e307 2515 }
a0d0e21e 2516
bbce6d69 2517 /* This kludge not intended to be bulletproof. */
2518 if (tokenbuf[1] == '[' && !tokenbuf[2]) {
2519 yylval.opval = newSVOP(OP_CONST, 0,
2520 newSViv((IV)compiling.cop_arybase));
2521 yylval.opval->op_private = OPpCONST_ARYBASE;
2522 TERM(THING);
2523 }
2524
ff68c719 2525 d = s;
2526 if (lex_state == LEX_NORMAL)
2527 s = skipspace(s);
2528
bbce6d69 2529 if ((expect != XREF || oldoldbufptr == last_lop) && intuit_more(s)) {
2530 char *t;
2531 if (*s == '[') {
2532 tokenbuf[0] = '@';
2533 if (dowarn) {
2534 for(t = s + 1;
2535 isSPACE(*t) || isALNUM(*t) || *t == '$';
2536 t++) ;
a0d0e21e
LW		 2537 if (*t++ == ',') {
2538 bufptr = skipspace(bufptr);
bbce6d69 2539 while (t < bufend && *t != ']')
2540 t++;
a0d0e21e 2541 warn("Multidimensional syntax %.*s not supported",
bbce6d69 2542 (t - bufptr) + 1, bufptr);
a0d0e21e
LW		 2543 }
2544 }
bbce6d69 2545 }
2546 else if (*s == '{') {
2547 tokenbuf[0] = '%';
2548 if (dowarn && strEQ(tokenbuf+1, "SIG") &&
2549 (t = strchr(s, '}')) && (t = strchr(t, '=')))
2550 {
8903cb82 2551 char tmpbuf[sizeof tokenbuf];
a0d0e21e
LW		 2552 STRLEN len;
2553 for (t++; isSPACE(*t); t++) ;
748a9306 2554 if (isIDFIRST(*t)) {
8903cb82 2555 t = scan_word(t, tmpbuf, sizeof tmpbuf, TRUE, &len);
748a9306
LW		 2556 if (*t != '(' && perl_get_cv(tmpbuf, FALSE))
2557 warn("You need to quote \"%s\"", tmpbuf);
2558 }
93a17b20
LW		 2559 }
2560 }
2f3197b3 2561 }
bbce6d69 2562
2563 expect = XOPERATOR;
ff68c719 2564 if (lex_state == LEX_NORMAL && isSPACE(*d)) {
bbce6d69 2565 bool islop = (last_lop == oldoldbufptr);
bbce6d69 2566 if (!islop || last_lop_op == OP_GREPSTART)
2567 expect = XOPERATOR;
2568 else if (strchr("$@\"'`q", *s))
2569 expect = XTERM; /* e.g. print $fh "foo" */
2570 else if (strchr("&*<%", *s) && isIDFIRST(s[1]))
2571 expect = XTERM; /* e.g. print $fh &sub */
68dc0745 2572 else if (isIDFIRST(*s)) {
8903cb82 2573 char tmpbuf[sizeof tokenbuf];
2574 scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
84902520
TB		 2575 if (tmp = keyword(tmpbuf, len)) {
2576 /* binary operators exclude handle interpretations */
2577 switch (tmp) {
2578 case -KEY_x:
2579 case -KEY_eq:
2580 case -KEY_ne:
2581 case -KEY_gt:
2582 case -KEY_lt:
2583 case -KEY_ge:
2584 case -KEY_le:
2585 case -KEY_cmp:
2586 break;
2587 default:
2588 expect = XTERM; /* e.g. print $fh length() */
2589 break;
2590 }
2591 }
68dc0745 2592 else {
2593 GV *gv = gv_fetchpv(tmpbuf, FALSE, SVt_PVCV);
2594 if (gv && GvCVu(gv))
2595 expect = XTERM; /* e.g. print $fh subr() */
93a17b20 2596 }
93a17b20 2597 }
bbce6d69 2598 else if (isDIGIT(*s))
2599 expect = XTERM; /* e.g. print $fh 3 */
2600 else if (*s == '.' && isDIGIT(s[1]))
2601 expect = XTERM; /* e.g. print $fh .3 */
2602 else if (strchr("/?-+", *s) && !isSPACE(s[1]))
2603 expect = XTERM; /* e.g. print $fh -1 */
2604 else if (*s == '<' && s[1] == '<' && !isSPACE(s[2]))
2605 expect = XTERM; /* print $fh <<"EOF" */
2606 }
2607 pending_ident = '$';
79072805 2608 TOKEN('$');
378cc40b
LW		 2609
2610 case '@':
8990e307 2611 if (expect == XOPERATOR)
bbce6d69 2612 no_op("Array", s);
2613 tokenbuf[0] = '@';
8903cb82 2614 s = scan_ident(s, bufend, tokenbuf + 1, sizeof tokenbuf - 1, FALSE);
bbce6d69 2615 if (!tokenbuf[1]) {
2616 if (s == bufend)
2617 yyerror("Final @ should be \\@ or @name");
2618 PREREF('@');
2619 }
ff68c719 2620 if (lex_state == LEX_NORMAL)
2621 s = skipspace(s);
bbce6d69 2622 if ((expect != XREF || oldoldbufptr == last_lop) && intuit_more(s)) {
2623 if (*s == '{')
2624 tokenbuf[0] = '%';
a0d0e21e
LW		 2625
2626 /* Warn about @ where they meant $. */
2627 if (dowarn) {
2628 if (*s == '[' || *s == '{') {
2629 char *t = s + 1;
2630 while (*t && (isALNUM(*t) || strchr(" \t$#+-'\"", *t)))
2631 t++;
2632 if (*t == '}' || *t == ']') {
2633 t++;
2634 bufptr = skipspace(bufptr);
2635 warn("Scalar value %.*s better written as $%.*s",
2636 t-bufptr, bufptr, t-bufptr-1, bufptr+1);
2637 }
93a17b20
LW		 2638 }
2639 }
463ee0b2 2640 }
bbce6d69 2641 pending_ident = '@';
79072805 2642 TERM('@');
378cc40b
LW		 2643
2644 case '/': /* may either be division or pattern */
2645 case '?': /* may either be conditional or pattern */
79072805 2646 if (expect != XOPERATOR) {
c277df42
IZ		 2647 /* Disable warning on "study /blah/" */
2648 if (oldoldbufptr == last_uni
2649 && (*last_uni != 's' || s - last_uni < 5
2650 || memNE(last_uni, "study", 5) || isALNUM(last_uni[5])))
2651 check_uni();
79072805
LW		 2652 s = scan_pat(s);
2653 TERM(sublex_start());
378cc40b
LW		 2654 }
2655 tmp = *s++;
a687059c 2656 if (tmp == '/')
79072805 2657 Mop(OP_DIVIDE);
378cc40b
LW		 2658 OPERATOR(tmp);
2659
2660 case '.':
748a9306 2661 if (lex_formbrack && lex_brackets == lex_formbrack && s[1] == '\n' &&
fd049845 2662 (s == linestart || s[-1] == '\n') ) {
85e6fe83 2663 lex_formbrack = 0;
8990e307 2664 expect = XSTATE;
79072805
LW		 2665 goto rightbracket;
2666 }
2667 if (expect == XOPERATOR || !isDIGIT(s[1])) {
378cc40b 2668 tmp = *s++;
a687059c
LW		 2669 if (*s == tmp) {
2670 s++;
2f3197b3
LW		 2671 if (*s == tmp) {
2672 s++;
79072805 2673 yylval.ival = OPf_SPECIAL;
2f3197b3
LW		 2674 }
2675 else
79072805 2676 yylval.ival = 0;
378cc40b 2677 OPERATOR(DOTDOT);
a687059c 2678 }
79072805 2679 if (expect != XOPERATOR)
2f3197b3 2680 check_uni();
79072805 2681 Aop(OP_CONCAT);
378cc40b
LW		 2682 }
2683 /* FALL THROUGH */
2684 case '0': case '1': case '2': case '3': case '4':
2685 case '5': case '6': case '7': case '8': case '9':
79072805 2686 s = scan_num(s);
8990e307
LW		 2687 if (expect == XOPERATOR)
2688 no_op("Number",s);
79072805
LW		 2689 TERM(THING);
2690
2691 case '\'':
8990e307 2692 s = scan_str(s);
463ee0b2 2693 if (expect == XOPERATOR) {
a0d0e21e
LW		 2694 if (lex_formbrack && lex_brackets == lex_formbrack) {
2695 expect = XTERM;
2696 depcom();
2697 return ','; /* grandfather non-comma-format format */
2698 }
463ee0b2 2699 else
8990e307 2700 no_op("String",s);
463ee0b2 2701 }
79072805 2702 if (!s)
85e6fe83 2703 missingterm((char*)0);
79072805
LW		 2704 yylval.ival = OP_CONST;
2705 TERM(sublex_start());
2706
2707 case '"':
8990e307 2708 s = scan_str(s);
463ee0b2 2709 if (expect == XOPERATOR) {
a0d0e21e
LW		 2710 if (lex_formbrack && lex_brackets == lex_formbrack) {
2711 expect = XTERM;
2712 depcom();
2713 return ','; /* grandfather non-comma-format format */
2714 }
463ee0b2 2715 else
8990e307 2716 no_op("String",s);
463ee0b2 2717 }
79072805 2718 if (!s)
85e6fe83 2719 missingterm((char*)0);
4633a7c4
LW		 2720 yylval.ival = OP_CONST;
2721 for (d = SvPV(lex_stuff, len); len; len--, d++) {
2722 if (*d == '$' || *d == '@' || *d == '\\') {
2723 yylval.ival = OP_STRINGIFY;
2724 break;
2725 }
2726 }
79072805
LW		 2727 TERM(sublex_start());
2728
2729 case '`':
2730 s = scan_str(s);
8990e307
LW		 2731 if (expect == XOPERATOR)
2732 no_op("Backticks",s);
79072805 2733 if (!s)
85e6fe83 2734 missingterm((char*)0);
79072805
LW		 2735 yylval.ival = OP_BACKTICK;
2736 set_csh();
2737 TERM(sublex_start());
2738
2739 case '\\':
2740 s++;
748a9306
LW		 2741 if (dowarn && lex_inwhat && isDIGIT(*s))
2742 warn("Can't use \\%c to mean $%c in expression", *s, *s);
8990e307
LW		 2743 if (expect == XOPERATOR)
2744 no_op("Backslash",s);
79072805
LW		 2745 OPERATOR(REFGEN);
2746
2747 case 'x':
2748 if (isDIGIT(s[1]) && expect == XOPERATOR) {
2749 s++;
2750 Mop(OP_REPEAT);
2f3197b3 2751 }
79072805
LW		 2752 goto keylookup;
2753
378cc40b 2754 case '_':
79072805
LW		 2755 case 'a': case 'A':
2756 case 'b': case 'B':
2757 case 'c': case 'C':
2758 case 'd': case 'D':
2759 case 'e': case 'E':
2760 case 'f': case 'F':
2761 case 'g': case 'G':
2762 case 'h': case 'H':
2763 case 'i': case 'I':
2764 case 'j': case 'J':
2765 case 'k': case 'K':
2766 case 'l': case 'L':
2767 case 'm': case 'M':
2768 case 'n': case 'N':
2769 case 'o': case 'O':
2770 case 'p': case 'P':
2771 case 'q': case 'Q':
2772 case 'r': case 'R':
2773 case 's': case 'S':
2774 case 't': case 'T':
2775 case 'u': case 'U':
2776 case 'v': case 'V':
2777 case 'w': case 'W':
2778 case 'X':
2779 case 'y': case 'Y':
2780 case 'z': case 'Z':
2781
49dc05e3 2782 keylookup: {
161b471a
NIS		 2783 gv = Nullgv;
2784 gvp = 0;
49dc05e3 2785
748a9306 2786 bufptr = s;
8903cb82 2787 s = scan_word(s, tokenbuf, sizeof tokenbuf, FALSE, &len);
8ebc5c01 2788
2789 /* Some keywords can be followed by any delimiter, including ':' */
2790 tmp = (len == 1 && strchr("msyq", tokenbuf[0]) ||
2791 len == 2 && ((tokenbuf[0] == 't' && tokenbuf[1] == 'r') ||
2792 (tokenbuf[0] == 'q' &&
2793 strchr("qwx", tokenbuf[1]))));
2794
2795 /* x::* is just a word, unless x is "CORE" */
2796 if (!tmp && *s == ':' && s[1] == ':' && strNE(tokenbuf, "CORE"))
4633a7c4
LW		 2797 goto just_a_word;
2798
3643fb5f
CS		 2799 d = s;
2800 while (d < bufend && isSPACE(*d))
2801 d++; /* no comments skipped here, or s### is misparsed */
2802
2803 /* Is this a label? */
8ebc5c01 2804 if (!tmp && expect == XSTATE
2805 && d < bufend && *d == ':' && *(d + 1) != ':') {
2806 s = d + 1;
2807 yylval.pval = savepv(tokenbuf);
2808 CLINE;
2809 TOKEN(LABEL);
3643fb5f
CS		 2810 }
2811
2812 /* Check for keywords */
a0d0e21e 2813 tmp = keyword(tokenbuf, len);
748a9306
LW		 2814
2815 /* Is this a word before a => operator? */
748a9306
LW		 2816 if (strnEQ(d,"=>",2)) {
2817 CLINE;
748a9306
LW		 2818 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
2819 yylval.opval->op_private = OPpCONST_BARE;
2820 TERM(WORD);
2821 }
2822
a0d0e21e 2823 if (tmp < 0) { /* second-class keyword? */
49dc05e3
GS		 2824 if (expect != XOPERATOR && (*s != ':' || s[1] != ':') &&
2825 (((gv = gv_fetchpv(tokenbuf, FALSE, SVt_PVCV)) &&
2826 GvCVu(gv) && GvIMPORTED_CV(gv)) ||
2827 ((gvp = (GV**)hv_fetch(globalstash,tokenbuf,len,FALSE)) &&
2828 (gv = *gvp) != (GV*)&sv_undef &&
2829 GvCVu(gv) && GvIMPORTED_CV(gv))))
a0d0e21e 2830 {
6e7b2336
GS		 2831 tmp = 0; /* overridden by importation */
2832 }
2833 else if (gv && !gvp
2834 && -tmp==KEY_lock /* XXX generalizable kludge */
1d64a758 2835 && !hv_fetch(GvHVn(incgv), "Thread.pm", 9, FALSE))
6e7b2336
GS		 2836 {
2837 tmp = 0; /* any sub overrides "weak" keyword */
a0d0e21e 2838 }
49dc05e3
GS		 2839 else {
2840 tmp = -tmp; gv = Nullgv; gvp = 0;
2841 }
a0d0e21e
LW		 2842 }
2843
2844 reserved_word:
2845 switch (tmp) {
79072805
LW		 2846
2847 default: /* not a keyword */
93a17b20 2848 just_a_word: {
96e4d5b1 2849 SV *sv;
748a9306 2850 char lastchar = (bufptr == oldoldbufptr ? 0 : bufptr[-1]);
8990e307
LW		 2851
2852 /* Get the rest if it looks like a package qualifier */
2853
a0d0e21e 2854 if (*s == '\'' || *s == ':' && s[1] == ':') {
c3e0f903 2855 STRLEN morelen;
8903cb82 2856 s = scan_word(s, tokenbuf + len, sizeof tokenbuf - len,
c3e0f903
GS		 2857 TRUE, &morelen);
2858 if (!morelen)
ec2ab091
HM		 2859 croak("Bad name after %s%s", tokenbuf,
2860 *s == '\'' ? "'" : "::");
c3e0f903 2861 len += morelen;
a0d0e21e 2862 }
8990e307 2863
3643fb5f 2864 if (expect == XOPERATOR) {
fd049845 2865 if (bufptr == linestart) {
463ee0b2
LW		 2866 curcop->cop_line--;
2867 warn(warn_nosemi);
2868 curcop->cop_line++;
2869 }
2870 else
54310121 2871 no_op("Bareword",s);
463ee0b2 2872 }
8990e307 2873
c3e0f903
GS		 2874 /* Look for a subroutine with this name in current package,
2875 unless name is "Foo::", in which case Foo is a bearword
2876 (and a package name). */
2877
2878 if (len > 2 &&
2879 tokenbuf[len - 2] == ':' && tokenbuf[len - 1] == ':')
2880 {
2881 if (dowarn && ! gv_fetchpv(tokenbuf, FALSE, SVt_PVHV))
2882 warn("Bareword \"%s\" refers to nonexistent package",
2883 tokenbuf);
2884 len -= 2;
2885 tokenbuf[len] = '\0';
2886 gv = Nullgv;
2887 gvp = 0;
2888 }
2889 else {
2890 len = 0;
2891 if (!gv)
2892 gv = gv_fetchpv(tokenbuf, FALSE, SVt_PVCV);
2893 }
2894
2895 /* if we saw a global override before, get the right name */
8990e307 2896
49dc05e3
GS		 2897 if (gvp) {
2898 sv = newSVpv("CORE::GLOBAL::",14);
2899 sv_catpv(sv,tokenbuf);
2900 }
2901 else
2902 sv = newSVpv(tokenbuf,0);
8990e307 2903
a0d0e21e
LW		 2904 /* Presume this is going to be a bareword of some sort. */
2905
2906 CLINE;
49dc05e3 2907 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
a0d0e21e
LW		 2908 yylval.opval->op_private = OPpCONST_BARE;
2909
c3e0f903
GS		 2910 /* And if "Foo::", then that's what it certainly is. */
2911
2912 if (len)
2913 goto safe_bareword;
2914
8990e307
LW		 2915 /* See if it's the indirect object for a list operator. */
2916
a0d0e21e
LW		 2917 if (oldoldbufptr &&
2918 oldoldbufptr < bufptr &&
2919 (oldoldbufptr == last_lop || oldoldbufptr == last_uni) &&
2920 /* NO SKIPSPACE BEFORE HERE! */
2a841d13
IZ		 2921 (expect == XREF
2922 || ((opargs[last_lop_op] >> OASHIFT)& 7) == OA_FILEREF
2923 || (last_lop_op == OP_ENTERSUB
2924 && last_proto
2925 && last_proto[last_proto[0] == ';' ? 1 : 0] == '*')) )
a0d0e21e 2926 {
748a9306
LW		 2927 bool immediate_paren = *s == '(';
2928
a0d0e21e
LW		 2929 /* (Now we can afford to cross potential line boundary.) */
2930 s = skipspace(s);
2931
2932 /* Two barewords in a row may indicate method call. */
2933
2934 if ((isALPHA(*s) || *s == '$') && (tmp=intuit_method(s,gv)))
2935 return tmp;
2936
2937 /* If not a declared subroutine, it's an indirect object. */
2938 /* (But it's an indir obj regardless for sort.) */
2939
8e07c86e 2940 if ((last_lop_op == OP_SORT ||
8ebc5c01 2941 (!immediate_paren && (!gv || !GvCVu(gv))) ) &&
8e07c86e 2942 (last_lop_op != OP_MAPSTART && last_lop_op != OP_GREPSTART)){
748a9306
LW		 2943 expect = (last_lop == oldoldbufptr) ? XTERM : XOPERATOR;
2944 goto bareword;
93a17b20
LW		 2945 }
2946 }
8990e307
LW		 2947
2948 /* If followed by a paren, it's certainly a subroutine. */
2949
2950 expect = XOPERATOR;
2951 s = skipspace(s);
93a17b20 2952 if (*s == '(') {
79072805 2953 CLINE;
96e4d5b1 2954 if (gv && GvCVu(gv)) {
2955 for (d = s + 1; *d == ' ' || *d == '\t'; d++) ;
2956 if (*d == ')' && (sv = cv_const_sv(GvCV(gv)))) {
2957 s = d + 1;
2958 goto its_constant;
2959 }
2960 }
a0d0e21e 2961 nextval[nexttoke].opval = yylval.opval;
463ee0b2 2962 expect = XOPERATOR;
93a17b20 2963 force_next(WORD);
c07a80fd 2964 yylval.ival = 0;
463ee0b2 2965 TOKEN('&');
79072805 2966 }
93a17b20 2967
a0d0e21e 2968 /* If followed by var or block, call it a method (unless sub) */
8990e307 2969
8ebc5c01 2970 if ((*s == '$' || *s == '{') && (!gv || !GvCVu(gv))) {
463ee0b2 2971 last_lop = oldbufptr;
8990e307 2972 last_lop_op = OP_METHOD;
93a17b20 2973 PREBLOCK(METHOD);
463ee0b2
LW		 2974 }
2975
8990e307
LW		 2976 /* If followed by a bareword, see if it looks like indir obj. */
2977
a0d0e21e
LW		 2978 if ((isALPHA(*s) || *s == '$') && (tmp = intuit_method(s,gv)))
2979 return tmp;
93a17b20 2980
8990e307
LW		 2981 /* Not a method, so call it a subroutine (if defined) */
2982
8ebc5c01 2983 if (gv && GvCVu(gv)) {
46fc3d4c 2984 CV* cv;
748a9306 2985 if (lastchar == '-')
c2960299 2986 warn("Ambiguous use of -%s resolved as -&%s()",
748a9306 2987 tokenbuf, tokenbuf);
8990e307 2988 last_lop = oldbufptr;
a0d0e21e 2989 last_lop_op = OP_ENTERSUB;
89bfa8cd 2990 /* Check for a constant sub */
46fc3d4c 2991 cv = GvCV(gv);
96e4d5b1 2992 if ((sv = cv_const_sv(cv))) {
2993 its_constant:
2994 SvREFCNT_dec(((SVOP*)yylval.opval)->op_sv);
2995 ((SVOP*)yylval.opval)->op_sv = SvREFCNT_inc(sv);
2996 yylval.opval->op_private = 0;
2997 TOKEN(WORD);
89bfa8cd 2998 }
2999
a5f75d66
AD		 3000 /* Resolve to GV now. */
3001 op_free(yylval.opval);
3002 yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
4633a7c4
LW		 3003 /* Is there a prototype? */
3004 if (SvPOK(cv)) {
3005 STRLEN len;
2a841d13 3006 last_proto = SvPV((SV*)cv, len);
4633a7c4
LW		 3007 if (!len)
3008 TERM(FUNC0SUB);
2a841d13 3009 if (strEQ(last_proto, "$"))
4633a7c4 3010 OPERATOR(UNIOPSUB);
2a841d13 3011 if (*last_proto == '&' && *s == '{') {
4633a7c4
LW		 3012 sv_setpv(subname,"__ANON__");
3013 PREBLOCK(LSTOPSUB);
3014 }
2a841d13
IZ		 3015 } else
3016 last_proto = NULL;
a5f75d66 3017 nextval[nexttoke].opval = yylval.opval;
8990e307
LW		 3018 expect = XTERM;
3019 force_next(WORD);
3020 TOKEN(NOAMP);
3021 }
748a9306
LW		 3022
3023 if (hints & HINT_STRICT_SUBS &&
3024 lastchar != '-' &&
a0d0e21e 3025 strnNE(s,"->",2) &&
9b01e405 3026 last_lop_op != OP_TRUNCATE && /* S/F prototype in opcode.pl */
a0d0e21e
LW		 3027 last_lop_op != OP_ACCEPT &&
3028 last_lop_op != OP_PIPE_OP &&
3029 last_lop_op != OP_SOCKPAIR)
3030 {
3031 warn(
3032 "Bareword \"%s\" not allowed while \"strict subs\" in use",
85e6fe83
LW		 3033 tokenbuf);
3034 ++error_count;
3035 }
8990e307
LW		 3036
3037 /* Call it a bare word */
3038
748a9306
LW		 3039 bareword:
3040 if (dowarn) {
3041 if (lastchar != '-') {
3042 for (d = tokenbuf; *d && isLOWER(*d); d++) ;
3043 if (!*d)
3044 warn(warn_reserved, tokenbuf);
3045 }
3046 }
c3e0f903
GS		 3047
3048 safe_bareword:
748a9306
LW		 3049 if (lastchar && strchr("*%&", lastchar)) {
3050 warn("Operator or semicolon missing before %c%s",
3051 lastchar, tokenbuf);
c2960299 3052 warn("Ambiguous use of %c resolved as operator %c",
748a9306
LW		 3053 lastchar, lastchar);
3054 }
93a17b20 3055 TOKEN(WORD);
79072805 3056 }
79072805 3057
68dc0745 3058 case KEY___FILE__:
46fc3d4c 3059 yylval.opval = (OP*)newSVOP(OP_CONST, 0,
3060 newSVsv(GvSV(curcop->cop_filegv)));
3061 TERM(THING);
3062
79072805 3063 case KEY___LINE__:
46fc3d4c 3064 yylval.opval = (OP*)newSVOP(OP_CONST, 0,
3065 newSVpvf("%ld", (long)curcop->cop_line));
79072805 3066 TERM(THING);
68dc0745 3067
3068 case KEY___PACKAGE__:
3069 yylval.opval = (OP*)newSVOP(OP_CONST, 0,
3070 (curstash
3071 ? newSVsv(curstname)
3072 : &sv_undef));
79072805 3073 TERM(THING);
79072805 3074
e50aee73 3075 case KEY___DATA__:
79072805
LW		 3076 case KEY___END__: {
3077 GV *gv;
79072805
LW		 3078
3079 /*SUPPRESS 560*/
a5f75d66 3080 if (rsfp && (!in_eval || tokenbuf[2] == 'D')) {
e50aee73
AD		 3081 char *pname = "main";
3082 if (tokenbuf[2] == 'D')
3083 pname = HvNAME(curstash ? curstash : defstash);
46fc3d4c 3084 gv = gv_fetchpv(form("%s::DATA", pname), TRUE, SVt_PVIO);
a5f75d66 3085 GvMULTI_on(gv);
79072805 3086 if (!GvIO(gv))
a0d0e21e
LW		 3087 GvIOp(gv) = newIO();
3088 IoIFP(GvIOp(gv)) = rsfp;
3089#if defined(HAS_FCNTL) && defined(F_SETFD)
3090 {
760ac839 3091 int fd = PerlIO_fileno(rsfp);
a0d0e21e
LW		 3092 fcntl(fd,F_SETFD,fd >= 3);
3093 }
79072805 3094#endif
fd049845 3095 /* Mark this internal pseudo-handle as clean */
3096 IoFLAGS(GvIOp(gv)) |= IOf_UNTAINT;
79072805 3097 if (preprocess)
a0d0e21e 3098 IoTYPE(GvIOp(gv)) = '|';
760ac839 3099 else if ((PerlIO*)rsfp == PerlIO_stdin())
a0d0e21e 3100 IoTYPE(GvIOp(gv)) = '-';
79072805 3101 else
a0d0e21e 3102 IoTYPE(GvIOp(gv)) = '<';
79072805
LW		 3103 rsfp = Nullfp;
3104 }
3105 goto fake_eof;
e929a76b 3106 }
de3bb511 3107
8990e307 3108 case KEY_AUTOLOAD:
ed6116ce 3109 case KEY_DESTROY:
79072805
LW		 3110 case KEY_BEGIN:
3111 case KEY_END:
7d07dbc2 3112 case KEY_INIT:
a0d0e21e 3113 if (expect == XSTATE) {
93a17b20
LW		 3114 s = bufptr;
3115 goto really_sub;
79072805
LW		 3116 }
3117 goto just_a_word;
3118
a0d0e21e
LW		 3119 case KEY_CORE:
3120 if (*s == ':' && s[1] == ':') {
3121 s += 2;
748a9306 3122 d = s;
8903cb82 3123 s = scan_word(s, tokenbuf, sizeof tokenbuf, FALSE, &len);
a0d0e21e
LW		 3124 tmp = keyword(tokenbuf, len);
3125 if (tmp < 0)
3126 tmp = -tmp;
3127 goto reserved_word;
3128 }
3129 goto just_a_word;
3130
463ee0b2
LW		 3131 case KEY_abs:
3132 UNI(OP_ABS);
3133
79072805
LW		 3134 case KEY_alarm:
3135 UNI(OP_ALARM);
3136
3137 case KEY_accept:
a0d0e21e 3138 LOP(OP_ACCEPT,XTERM);
79072805 3139
463ee0b2
LW		 3140 case KEY_and:
3141 OPERATOR(ANDOP);
3142
79072805 3143 case KEY_atan2:
a0d0e21e 3144 LOP(OP_ATAN2,XTERM);
85e6fe83 3145
79072805 3146 case KEY_bind:
a0d0e21e 3147 LOP(OP_BIND,XTERM);
79072805
LW		 3148
3149 case KEY_binmode:
3150 UNI(OP_BINMODE);
3151
3152 case KEY_bless:
a0d0e21e 3153 LOP(OP_BLESS,XTERM);
79072805
LW		 3154
3155 case KEY_chop:
3156 UNI(OP_CHOP);
3157
3158 case KEY_continue:
3159 PREBLOCK(CONTINUE);
3160
3161 case KEY_chdir:
85e6fe83 3162 (void)gv_fetchpv("ENV",TRUE, SVt_PVHV); /* may use HOME */
79072805
LW		 3163 UNI(OP_CHDIR);
3164
3165 case KEY_close:
3166 UNI(OP_CLOSE);
3167
3168 case KEY_closedir:
3169 UNI(OP_CLOSEDIR);
3170
3171 case KEY_cmp:
3172 Eop(OP_SCMP);
3173
3174 case KEY_caller:
3175 UNI(OP_CALLER);
3176
3177 case KEY_crypt:
3178#ifdef FCRYPT
de3bb511
LW		 3179 if (!cryptseen++)
3180 init_des();
a687059c 3181#endif
a0d0e21e 3182 LOP(OP_CRYPT,XTERM);
79072805
LW		 3183
3184 case KEY_chmod:
748a9306
LW		 3185 if (dowarn) {
3186 for (d = s; d < bufend && (isSPACE(*d) || *d == '('); d++) ;
3187 if (*d != '0' && isDIGIT(*d))
3188 yywarn("chmod: mode argument is missing initial 0");
3189 }
a0d0e21e 3190 LOP(OP_CHMOD,XTERM);
79072805
LW		 3191
3192 case KEY_chown:
a0d0e21e 3193 LOP(OP_CHOWN,XTERM);
79072805
LW		 3194
3195 case KEY_connect:
a0d0e21e 3196 LOP(OP_CONNECT,XTERM);
79072805 3197
463ee0b2
LW		 3198 case KEY_chr:
3199 UNI(OP_CHR);
3200
79072805
LW		 3201 case KEY_cos:
3202 UNI(OP_COS);
3203
3204 case KEY_chroot:
3205 UNI(OP_CHROOT);
3206
3207 case KEY_do:
3208 s = skipspace(s);
3209 if (*s == '{')
a0d0e21e 3210 PRETERMBLOCK(DO);
79072805 3211 if (*s != '\'')
a0d0e21e 3212 s = force_word(s,WORD,FALSE,TRUE,FALSE);
378cc40b 3213 OPERATOR(DO);
79072805
LW		 3214
3215 case KEY_die:
a0d0e21e
LW		 3216 hints |= HINT_BLOCK_SCOPE;
3217 LOP(OP_DIE,XTERM);
79072805
LW		 3218
3219 case KEY_defined:
3220 UNI(OP_DEFINED);
3221
3222 case KEY_delete:
a0d0e21e 3223 UNI(OP_DELETE);
79072805
LW		 3224
3225 case KEY_dbmopen:
a0d0e21e
LW		 3226 gv_fetchpv("AnyDBM_File::ISA", GV_ADDMULTI, SVt_PVAV);
3227 LOP(OP_DBMOPEN,XTERM);
79072805
LW		 3228
3229 case KEY_dbmclose:
3230 UNI(OP_DBMCLOSE);
3231
3232 case KEY_dump:
a0d0e21e 3233 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3234 LOOPX(OP_DUMP);
3235
3236 case KEY_else:
3237 PREBLOCK(ELSE);
3238
3239 case KEY_elsif:
3240 yylval.ival = curcop->cop_line;
3241 OPERATOR(ELSIF);
3242
3243 case KEY_eq:
3244 Eop(OP_SEQ);
3245
a0d0e21e
LW		 3246 case KEY_exists:
3247 UNI(OP_EXISTS);
3248
79072805
LW		 3249 case KEY_exit:
3250 UNI(OP_EXIT);
3251
3252 case KEY_eval:
79072805 3253 s = skipspace(s);
a0d0e21e 3254 expect = (*s == '{') ? XTERMBLOCK : XTERM;
463ee0b2 3255 UNIBRACK(OP_ENTEREVAL);
79072805
LW		 3256
3257 case KEY_eof:
3258 UNI(OP_EOF);
3259
3260 case KEY_exp:
3261 UNI(OP_EXP);
3262
3263 case KEY_each:
3264 UNI(OP_EACH);
3265
3266 case KEY_exec:
3267 set_csh();
a0d0e21e 3268 LOP(OP_EXEC,XREF);
79072805
LW		 3269
3270 case KEY_endhostent:
3271 FUN0(OP_EHOSTENT);
3272
3273 case KEY_endnetent:
3274 FUN0(OP_ENETENT);
3275
3276 case KEY_endservent:
3277 FUN0(OP_ESERVENT);
3278
3279 case KEY_endprotoent:
3280 FUN0(OP_EPROTOENT);
3281
3282 case KEY_endpwent:
3283 FUN0(OP_EPWENT);
3284
3285 case KEY_endgrent:
3286 FUN0(OP_EGRENT);
3287
3288 case KEY_for:
3289 case KEY_foreach:
3290 yylval.ival = curcop->cop_line;
55497cff 3291 s = skipspace(s);
ecca16b0 3292 if (expect == XSTATE && isIDFIRST(*s)) {
55497cff 3293 char *p = s;
3294 if ((bufend - p) >= 3 &&
3295 strnEQ(p, "my", 2) && isSPACE(*(p + 2)))
3296 p += 2;
3297 p = skipspace(p);
3298 if (isIDFIRST(*p))
3299 croak("Missing $ on loop variable");
3300 }
79072805
LW		 3301 OPERATOR(FOR);
3302
3303 case KEY_formline:
a0d0e21e 3304 LOP(OP_FORMLINE,XTERM);
79072805
LW		 3305
3306 case KEY_fork:
3307 FUN0(OP_FORK);
3308
3309 case KEY_fcntl:
a0d0e21e 3310 LOP(OP_FCNTL,XTERM);
79072805
LW		 3311
3312 case KEY_fileno:
3313 UNI(OP_FILENO);
3314
3315 case KEY_flock:
a0d0e21e 3316 LOP(OP_FLOCK,XTERM);
79072805
LW		 3317
3318 case KEY_gt:
3319 Rop(OP_SGT);
3320
3321 case KEY_ge:
3322 Rop(OP_SGE);
3323
3324 case KEY_grep:
a0d0e21e 3325 LOP(OP_GREPSTART, *s == '(' ? XTERM : XREF);
79072805
LW		 3326
3327 case KEY_goto:
a0d0e21e 3328 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3329 LOOPX(OP_GOTO);
3330
3331 case KEY_gmtime:
3332 UNI(OP_GMTIME);
3333
3334 case KEY_getc:
3335 UNI(OP_GETC);
3336
3337 case KEY_getppid:
3338 FUN0(OP_GETPPID);
3339
3340 case KEY_getpgrp:
3341 UNI(OP_GETPGRP);
3342
3343 case KEY_getpriority:
a0d0e21e 3344 LOP(OP_GETPRIORITY,XTERM);
79072805
LW		 3345
3346 case KEY_getprotobyname:
3347 UNI(OP_GPBYNAME);
3348
3349 case KEY_getprotobynumber:
a0d0e21e 3350 LOP(OP_GPBYNUMBER,XTERM);
79072805
LW		 3351
3352 case KEY_getprotoent:
3353 FUN0(OP_GPROTOENT);
3354
3355 case KEY_getpwent:
3356 FUN0(OP_GPWENT);
3357
3358 case KEY_getpwnam:
ff68c719 3359 UNI(OP_GPWNAM);
79072805
LW		 3360
3361 case KEY_getpwuid:
ff68c719 3362 UNI(OP_GPWUID);
79072805
LW		 3363
3364 case KEY_getpeername:
3365 UNI(OP_GETPEERNAME);
3366
3367 case KEY_gethostbyname:
3368 UNI(OP_GHBYNAME);
3369
3370 case KEY_gethostbyaddr:
a0d0e21e 3371 LOP(OP_GHBYADDR,XTERM);
79072805
LW		 3372
3373 case KEY_gethostent:
3374 FUN0(OP_GHOSTENT);
3375
3376 case KEY_getnetbyname:
3377 UNI(OP_GNBYNAME);
3378
3379 case KEY_getnetbyaddr:
a0d0e21e 3380 LOP(OP_GNBYADDR,XTERM);
79072805
LW		 3381
3382 case KEY_getnetent:
3383 FUN0(OP_GNETENT);
3384
3385 case KEY_getservbyname:
a0d0e21e 3386 LOP(OP_GSBYNAME,XTERM);
79072805
LW		 3387
3388 case KEY_getservbyport:
a0d0e21e 3389 LOP(OP_GSBYPORT,XTERM);
79072805
LW		 3390
3391 case KEY_getservent:
3392 FUN0(OP_GSERVENT);
3393
3394 case KEY_getsockname:
3395 UNI(OP_GETSOCKNAME);
3396
3397 case KEY_getsockopt:
a0d0e21e 3398 LOP(OP_GSOCKOPT,XTERM);
79072805
LW		 3399
3400 case KEY_getgrent:
3401 FUN0(OP_GGRENT);
3402
3403 case KEY_getgrnam:
ff68c719 3404 UNI(OP_GGRNAM);
79072805
LW		 3405
3406 case KEY_getgrgid:
ff68c719 3407 UNI(OP_GGRGID);
79072805
LW		 3408
3409 case KEY_getlogin:
3410 FUN0(OP_GETLOGIN);
3411
93a17b20 3412 case KEY_glob:
a0d0e21e
LW		 3413 set_csh();
3414 LOP(OP_GLOB,XTERM);
93a17b20 3415
79072805
LW		 3416 case KEY_hex:
3417 UNI(OP_HEX);
3418
3419 case KEY_if:
3420 yylval.ival = curcop->cop_line;
3421 OPERATOR(IF);
3422
3423 case KEY_index:
a0d0e21e 3424 LOP(OP_INDEX,XTERM);
79072805
LW		 3425
3426 case KEY_int:
3427 UNI(OP_INT);
3428
3429 case KEY_ioctl:
a0d0e21e 3430 LOP(OP_IOCTL,XTERM);
79072805
LW		 3431
3432 case KEY_join:
a0d0e21e 3433 LOP(OP_JOIN,XTERM);
79072805
LW		 3434
3435 case KEY_keys:
3436 UNI(OP_KEYS);
3437
3438 case KEY_kill:
a0d0e21e 3439 LOP(OP_KILL,XTERM);
79072805
LW		 3440
3441 case KEY_last:
a0d0e21e 3442 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805 3443 LOOPX(OP_LAST);
a0d0e21e 3444
79072805
LW		 3445 case KEY_lc:
3446 UNI(OP_LC);
3447
3448 case KEY_lcfirst:
3449 UNI(OP_LCFIRST);
3450
3451 case KEY_local:
3452 OPERATOR(LOCAL);
3453
3454 case KEY_length:
3455 UNI(OP_LENGTH);
3456
3457 case KEY_lt:
3458 Rop(OP_SLT);
3459
3460 case KEY_le:
3461 Rop(OP_SLE);
3462
3463 case KEY_localtime:
3464 UNI(OP_LOCALTIME);
3465
3466 case KEY_log:
3467 UNI(OP_LOG);
3468
3469 case KEY_link:
a0d0e21e 3470 LOP(OP_LINK,XTERM);
79072805
LW		 3471
3472 case KEY_listen:
a0d0e21e 3473 LOP(OP_LISTEN,XTERM);
79072805 3474
c0329465
MB		 3475 case KEY_lock:
3476 UNI(OP_LOCK);
3477
79072805
LW		 3478 case KEY_lstat:
3479 UNI(OP_LSTAT);
3480
3481 case KEY_m:
3482 s = scan_pat(s);
3483 TERM(sublex_start());
3484
a0d0e21e
LW		 3485 case KEY_map:
3486 LOP(OP_MAPSTART,XREF);
3487
79072805 3488 case KEY_mkdir:
a0d0e21e 3489 LOP(OP_MKDIR,XTERM);
79072805
LW		 3490
3491 case KEY_msgctl:
a0d0e21e 3492 LOP(OP_MSGCTL,XTERM);
79072805
LW		 3493
3494 case KEY_msgget:
a0d0e21e 3495 LOP(OP_MSGGET,XTERM);
79072805
LW		 3496
3497 case KEY_msgrcv:
a0d0e21e 3498 LOP(OP_MSGRCV,XTERM);
79072805
LW		 3499
3500 case KEY_msgsnd:
a0d0e21e 3501 LOP(OP_MSGSND,XTERM);
79072805 3502
93a17b20
LW		 3503 case KEY_my:
3504 in_my = TRUE;
c750a3ec
MB		 3505 s = skipspace(s);
3506 if (isIDFIRST(*s)) {
97fcbf96 3507 s = scan_word(s, tokenbuf, sizeof tokenbuf, TRUE, &len);
c750a3ec
MB		 3508 in_my_stash = gv_stashpv(tokenbuf, FALSE);
3509 if (!in_my_stash) {
3510 char tmpbuf[1024];
3511 bufptr = s;
3512 sprintf(tmpbuf, "No such class %.1000s", tokenbuf);
3513 yyerror(tmpbuf);
3514 }
3515 }
55497cff 3516 OPERATOR(MY);
93a17b20 3517
79072805 3518 case KEY_next:
a0d0e21e 3519 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3520 LOOPX(OP_NEXT);
3521
3522 case KEY_ne:
3523 Eop(OP_SNE);
3524
a0d0e21e
LW		 3525 case KEY_no:
3526 if (expect != XSTATE)
3527 yyerror("\"no\" not allowed in expression");
3528 s = force_word(s,WORD,FALSE,TRUE,FALSE);
89bfa8cd 3529 s = force_version(s);
a0d0e21e
LW		 3530 yylval.ival = 0;
3531 OPERATOR(USE);
3532
3533 case KEY_not:
3534 OPERATOR(NOTOP);
3535
79072805 3536 case KEY_open:
93a17b20
LW		 3537 s = skipspace(s);
3538 if (isIDFIRST(*s)) {
3539 char *t;
3540 for (d = s; isALNUM(*d); d++) ;
3541 t = skipspace(d);
3542 if (strchr("|&*+-=!?:.", *t))
3543 warn("Precedence problem: open %.*s should be open(%.*s)",
3544 d-s,s, d-s,s);
3545 }
a0d0e21e 3546 LOP(OP_OPEN,XTERM);
79072805 3547
463ee0b2 3548 case KEY_or:
a0d0e21e 3549 yylval.ival = OP_OR;
463ee0b2
LW		 3550 OPERATOR(OROP);
3551
79072805
LW		 3552 case KEY_ord:
3553 UNI(OP_ORD);
3554
3555 case KEY_oct:
3556 UNI(OP_OCT);
3557
3558 case KEY_opendir:
a0d0e21e 3559 LOP(OP_OPEN_DIR,XTERM);
79072805
LW		 3560
3561 case KEY_print:
3562 checkcomma(s,tokenbuf,"filehandle");
a0d0e21e 3563 LOP(OP_PRINT,XREF);
79072805
LW		 3564
3565 case KEY_printf:
3566 checkcomma(s,tokenbuf,"filehandle");
a0d0e21e 3567 LOP(OP_PRTF,XREF);
79072805 3568
c07a80fd 3569 case KEY_prototype:
3570 UNI(OP_PROTOTYPE);
3571
79072805 3572 case KEY_push:
a0d0e21e 3573 LOP(OP_PUSH,XTERM);
79072805
LW		 3574
3575 case KEY_pop:
3576 UNI(OP_POP);
3577
a0d0e21e
LW		 3578 case KEY_pos:
3579 UNI(OP_POS);
3580
79072805 3581 case KEY_pack:
a0d0e21e 3582 LOP(OP_PACK,XTERM);
79072805
LW		 3583
3584 case KEY_package:
a0d0e21e 3585 s = force_word(s,WORD,FALSE,TRUE,FALSE);
79072805
LW		 3586 OPERATOR(PACKAGE);
3587
3588 case KEY_pipe:
a0d0e21e 3589 LOP(OP_PIPE_OP,XTERM);
79072805
LW		 3590
3591 case KEY_q:
3592 s = scan_str(s);
3593 if (!s)
85e6fe83 3594 missingterm((char*)0);
79072805
LW		 3595 yylval.ival = OP_CONST;
3596 TERM(sublex_start());
3597
a0d0e21e
LW		 3598 case KEY_quotemeta:
3599 UNI(OP_QUOTEMETA);
3600
8990e307
LW		 3601 case KEY_qw:
3602 s = scan_str(s);
3603 if (!s)
85e6fe83 3604 missingterm((char*)0);
55497cff 3605 if (dowarn && SvLEN(lex_stuff)) {
3606 d = SvPV_force(lex_stuff, len);
3607 for (; len; --len, ++d) {
3608 if (*d == ',') {
3609 warn("Possible attempt to separate words with commas");
3610 break;
3611 }
3612 if (*d == '#') {
3613 warn("Possible attempt to put comments in qw() list");
3614 break;
3615 }
3616 }
3617 }
8990e307 3618 force_next(')');
76e3520e 3619 nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, tokeq(lex_stuff));
8990e307
LW		 3620 lex_stuff = Nullsv;
3621 force_next(THING);
3622 force_next(',');
3623 nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(" ",1));
3624 force_next(THING);
3625 force_next('(');
a0d0e21e
LW		 3626 yylval.ival = OP_SPLIT;
3627 CLINE;
3628 expect = XTERM;
3629 bufptr = s;
3630 last_lop = oldbufptr;
3631 last_lop_op = OP_SPLIT;
3632 return FUNC;
8990e307 3633
79072805
LW		 3634 case KEY_qq:
3635 s = scan_str(s);
3636 if (!s)
85e6fe83 3637 missingterm((char*)0);
a0d0e21e 3638 yylval.ival = OP_STRINGIFY;
ed6116ce
LW		 3639 if (SvIVX(lex_stuff) == '\'')
3640 SvIVX(lex_stuff) = 0; /* qq'$foo' should intepolate */
79072805
LW		 3641 TERM(sublex_start());
3642
3643 case KEY_qx:
3644 s = scan_str(s);
3645 if (!s)
85e6fe83 3646 missingterm((char*)0);
79072805
LW		 3647 yylval.ival = OP_BACKTICK;
3648 set_csh();
3649 TERM(sublex_start());
3650
3651 case KEY_return:
3652 OLDLOP(OP_RETURN);
3653
3654 case KEY_require:
748a9306 3655 *tokenbuf = '\0';
a0d0e21e 3656 s = force_word(s,WORD,TRUE,TRUE,FALSE);
748a9306 3657 if (isIDFIRST(*tokenbuf))
89bfa8cd 3658 gv_stashpvn(tokenbuf, strlen(tokenbuf), TRUE);
748a9306 3659 else if (*s == '<')
a0d0e21e 3660 yyerror("<> should be quotes");
463ee0b2 3661 UNI(OP_REQUIRE);
79072805
LW		 3662
3663 case KEY_reset:
3664 UNI(OP_RESET);
3665
3666 case KEY_redo:
a0d0e21e 3667 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3668 LOOPX(OP_REDO);
3669
3670 case KEY_rename:
a0d0e21e 3671 LOP(OP_RENAME,XTERM);
79072805
LW		 3672
3673 case KEY_rand:
3674 UNI(OP_RAND);
3675
3676 case KEY_rmdir:
3677 UNI(OP_RMDIR);
3678
3679 case KEY_rindex:
a0d0e21e 3680 LOP(OP_RINDEX,XTERM);
79072805
LW		 3681
3682 case KEY_read:
a0d0e21e 3683 LOP(OP_READ,XTERM);
79072805
LW		 3684
3685 case KEY_readdir:
3686 UNI(OP_READDIR);
3687
93a17b20
LW		 3688 case KEY_readline:
3689 set_csh();
3690 UNI(OP_READLINE);
3691
3692 case KEY_readpipe:
3693 set_csh();
3694 UNI(OP_BACKTICK);
3695
79072805
LW		 3696 case KEY_rewinddir:
3697 UNI(OP_REWINDDIR);
3698
3699 case KEY_recv:
a0d0e21e 3700 LOP(OP_RECV,XTERM);
79072805
LW		 3701
3702 case KEY_reverse:
a0d0e21e 3703 LOP(OP_REVERSE,XTERM);
79072805
LW		 3704
3705 case KEY_readlink:
3706 UNI(OP_READLINK);
3707
3708 case KEY_ref:
3709 UNI(OP_REF);
3710
3711 case KEY_s:
3712 s = scan_subst(s);
3713 if (yylval.opval)
3714 TERM(sublex_start());
3715 else
3716 TOKEN(1); /* force error */
3717
a0d0e21e
LW		 3718 case KEY_chomp:
3719 UNI(OP_CHOMP);
3720
79072805
LW		 3721 case KEY_scalar:
3722 UNI(OP_SCALAR);
3723
3724 case KEY_select:
a0d0e21e 3725 LOP(OP_SELECT,XTERM);
79072805
LW		 3726
3727 case KEY_seek:
a0d0e21e 3728 LOP(OP_SEEK,XTERM);
79072805
LW		 3729
3730 case KEY_semctl:
a0d0e21e 3731 LOP(OP_SEMCTL,XTERM);
79072805
LW		 3732
3733 case KEY_semget:
a0d0e21e 3734 LOP(OP_SEMGET,XTERM);
79072805
LW		 3735
3736 case KEY_semop:
a0d0e21e 3737 LOP(OP_SEMOP,XTERM);
79072805
LW		 3738
3739 case KEY_send:
a0d0e21e 3740 LOP(OP_SEND,XTERM);
79072805
LW		 3741
3742 case KEY_setpgrp:
a0d0e21e 3743 LOP(OP_SETPGRP,XTERM);
79072805
LW		 3744
3745 case KEY_setpriority:
a0d0e21e 3746 LOP(OP_SETPRIORITY,XTERM);
79072805
LW		 3747
3748 case KEY_sethostent:
ff68c719 3749 UNI(OP_SHOSTENT);
79072805
LW		 3750
3751 case KEY_setnetent:
ff68c719 3752 UNI(OP_SNETENT);
79072805
LW		 3753
3754 case KEY_setservent:
ff68c719 3755 UNI(OP_SSERVENT);
79072805
LW		 3756
3757 case KEY_setprotoent:
ff68c719 3758 UNI(OP_SPROTOENT);
79072805
LW		 3759
3760 case KEY_setpwent:
3761 FUN0(OP_SPWENT);
3762
3763 case KEY_setgrent:
3764 FUN0(OP_SGRENT);
3765
3766 case KEY_seekdir:
a0d0e21e 3767 LOP(OP_SEEKDIR,XTERM);
79072805
LW		 3768
3769 case KEY_setsockopt:
a0d0e21e 3770 LOP(OP_SSOCKOPT,XTERM);
79072805
LW		 3771
3772 case KEY_shift:
3773 UNI(OP_SHIFT);
3774
3775 case KEY_shmctl:
a0d0e21e 3776 LOP(OP_SHMCTL,XTERM);
79072805
LW		 3777
3778 case KEY_shmget:
a0d0e21e 3779 LOP(OP_SHMGET,XTERM);
79072805
LW		 3780
3781 case KEY_shmread:
a0d0e21e 3782 LOP(OP_SHMREAD,XTERM);
79072805
LW		 3783
3784 case KEY_shmwrite:
a0d0e21e 3785 LOP(OP_SHMWRITE,XTERM);
79072805
LW		 3786
3787 case KEY_shutdown:
a0d0e21e 3788 LOP(OP_SHUTDOWN,XTERM);
79072805
LW		 3789
3790 case KEY_sin:
3791 UNI(OP_SIN);
3792
3793 case KEY_sleep:
3794 UNI(OP_SLEEP);
3795
3796 case KEY_socket:
a0d0e21e 3797 LOP(OP_SOCKET,XTERM);
79072805
LW		 3798
3799 case KEY_socketpair:
a0d0e21e 3800 LOP(OP_SOCKPAIR,XTERM);
79072805
LW		 3801
3802 case KEY_sort:
3803 checkcomma(s,tokenbuf,"subroutine name");
3804 s = skipspace(s);
3805 if (*s == ';' || *s == ')') /* probably a close */
463ee0b2
LW		 3806 croak("sort is now a reserved word");
3807 expect = XTERM;
15f0808c 3808 s = force_word(s,WORD,TRUE,TRUE,FALSE);
a0d0e21e 3809 LOP(OP_SORT,XREF);
79072805
LW		 3810
3811 case KEY_split:
a0d0e21e 3812 LOP(OP_SPLIT,XTERM);
79072805
LW		 3813
3814 case KEY_sprintf:
a0d0e21e 3815 LOP(OP_SPRINTF,XTERM);
79072805
LW		 3816
3817 case KEY_splice:
a0d0e21e 3818 LOP(OP_SPLICE,XTERM);
79072805
LW		 3819
3820 case KEY_sqrt:
3821 UNI(OP_SQRT);
3822
3823 case KEY_srand:
3824 UNI(OP_SRAND);
3825
3826 case KEY_stat:
3827 UNI(OP_STAT);
3828
3829 case KEY_study:
3830 sawstudy++;
3831 UNI(OP_STUDY);
3832
3833 case KEY_substr:
a0d0e21e 3834 LOP(OP_SUBSTR,XTERM);
79072805
LW		 3835
3836 case KEY_format:
3837 case KEY_sub:
93a17b20 3838 really_sub:
79072805 3839 s = skipspace(s);
4633a7c4 3840
463ee0b2 3841 if (isIDFIRST(*s) || *s == '\'' || *s == ':') {
8903cb82 3842 char tmpbuf[sizeof tokenbuf];
4633a7c4 3843 expect = XBLOCK;
8903cb82 3844 d = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
463ee0b2
LW		 3845 if (strchr(tmpbuf, ':'))
3846 sv_setpv(subname, tmpbuf);
3847 else {
3848 sv_setsv(subname,curstname);
8990e307 3849 sv_catpvn(subname,"::",2);
463ee0b2
LW		 3850 sv_catpvn(subname,tmpbuf,len);
3851 }
a0d0e21e 3852 s = force_word(s,WORD,FALSE,TRUE,TRUE);
4633a7c4 3853 s = skipspace(s);
79072805 3854 }
4633a7c4
LW		 3855 else {
3856 expect = XTERMBLOCK;
79072805 3857 sv_setpv(subname,"?");
4633a7c4
LW		 3858 }
3859
3860 if (tmp == KEY_format) {
3861 s = skipspace(s);
3862 if (*s == '=')
3863 lex_formbrack = lex_brackets + 1;
3864 OPERATOR(FORMAT);
3865 }
79072805 3866
4633a7c4
LW		 3867 /* Look for a prototype */
3868 if (*s == '(') {
68dc0745 3869 char *p;
3870
4633a7c4
LW		 3871 s = scan_str(s);
3872 if (!s) {
3873 if (lex_stuff)
3874 SvREFCNT_dec(lex_stuff);
3875 lex_stuff = Nullsv;
3876 croak("Prototype not terminated");
3877 }
68dc0745 3878 /* strip spaces */
3879 d = SvPVX(lex_stuff);
3880 tmp = 0;
3881 for (p = d; *p; ++p) {
3882 if (!isSPACE(*p))
3883 d[tmp++] = *p;
3884 }
3885 d[tmp] = '\0';
3886 SvCUR(lex_stuff) = tmp;
3887
4633a7c4
LW		 3888 nexttoke++;
3889 nextval[1] = nextval[0];
3890 nexttype[1] = nexttype[0];
3891 nextval[0].opval = (OP*)newSVOP(OP_CONST, 0, lex_stuff);
3892 nexttype[0] = THING;
3893 if (nexttoke == 1) {
3894 lex_defer = lex_state;
3895 lex_expect = expect;
3896 lex_state = LEX_KNOWNEXT;
3897 }
3898 lex_stuff = Nullsv;
3899 }
79072805 3900
4633a7c4
LW		 3901 if (*SvPV(subname,na) == '?') {
3902 sv_setpv(subname,"__ANON__");
3903 TOKEN(ANONSUB);
3904 }
3905 PREBLOCK(SUB);
79072805
LW		 3906
3907 case KEY_system:
3908 set_csh();
a0d0e21e 3909 LOP(OP_SYSTEM,XREF);
79072805
LW		 3910
3911 case KEY_symlink:
a0d0e21e 3912 LOP(OP_SYMLINK,XTERM);
79072805
LW		 3913
3914 case KEY_syscall:
a0d0e21e 3915 LOP(OP_SYSCALL,XTERM);
79072805 3916
c07a80fd 3917 case KEY_sysopen:
3918 LOP(OP_SYSOPEN,XTERM);
3919
137443ea 3920 case KEY_sysseek:
3921 LOP(OP_SYSSEEK,XTERM);
3922
79072805 3923 case KEY_sysread:
a0d0e21e 3924 LOP(OP_SYSREAD,XTERM);
79072805
LW		 3925
3926 case KEY_syswrite:
a0d0e21e 3927 LOP(OP_SYSWRITE,XTERM);
79072805
LW		 3928
3929 case KEY_tr:
3930 s = scan_trans(s);
3931 TERM(sublex_start());
3932
3933 case KEY_tell:
3934 UNI(OP_TELL);
3935
3936 case KEY_telldir:
3937 UNI(OP_TELLDIR);
3938
463ee0b2 3939 case KEY_tie:
a0d0e21e 3940 LOP(OP_TIE,XTERM);
463ee0b2 3941
c07a80fd 3942 case KEY_tied:
3943 UNI(OP_TIED);
3944
79072805
LW		 3945 case KEY_time:
3946 FUN0(OP_TIME);
3947
3948 case KEY_times:
3949 FUN0(OP_TMS);
3950
3951 case KEY_truncate:
a0d0e21e 3952 LOP(OP_TRUNCATE,XTERM);
79072805
LW		 3953
3954 case KEY_uc:
3955 UNI(OP_UC);
3956
3957 case KEY_ucfirst:
3958 UNI(OP_UCFIRST);
3959
463ee0b2
LW		 3960 case KEY_untie:
3961 UNI(OP_UNTIE);
3962
79072805
LW		 3963 case KEY_until:
3964 yylval.ival = curcop->cop_line;
3965 OPERATOR(UNTIL);
3966
3967 case KEY_unless:
3968 yylval.ival = curcop->cop_line;
3969 OPERATOR(UNLESS);
3970
3971 case KEY_unlink:
a0d0e21e 3972 LOP(OP_UNLINK,XTERM);
79072805
LW		 3973
3974 case KEY_undef:
3975 UNI(OP_UNDEF);
3976
3977 case KEY_unpack:
a0d0e21e 3978 LOP(OP_UNPACK,XTERM);
79072805
LW		 3979
3980 case KEY_utime:
a0d0e21e 3981 LOP(OP_UTIME,XTERM);
79072805
LW		 3982
3983 case KEY_umask:
748a9306
LW		 3984 if (dowarn) {
3985 for (d = s; d < bufend && (isSPACE(*d) || *d == '('); d++) ;
3986 if (*d != '0' && isDIGIT(*d))
3987 yywarn("umask: argument is missing initial 0");
3988 }
79072805
LW		 3989 UNI(OP_UMASK);
3990
3991 case KEY_unshift:
a0d0e21e
LW		 3992 LOP(OP_UNSHIFT,XTERM);
3993
3994 case KEY_use:
3995 if (expect != XSTATE)
3996 yyerror("\"use\" not allowed in expression");
89bfa8cd 3997 s = skipspace(s);
3998 if(isDIGIT(*s)) {
3999 s = force_version(s);
4000 if(*s == ';' || (s = skipspace(s), *s == ';')) {
4001 nextval[nexttoke].opval = Nullop;
4002 force_next(WORD);
4003 }
4004 }
4005 else {
4006 s = force_word(s,WORD,FALSE,TRUE,FALSE);
4007 s = force_version(s);
4008 }
a0d0e21e
LW		 4009 yylval.ival = 1;
4010 OPERATOR(USE);
79072805
LW		 4011
4012 case KEY_values:
4013 UNI(OP_VALUES);
4014
4015 case KEY_vec:
4016 sawvec = TRUE;
a0d0e21e 4017 LOP(OP_VEC,XTERM);
79072805
LW		 4018
4019 case KEY_while:
4020 yylval.ival = curcop->cop_line;
4021 OPERATOR(WHILE);
4022
4023 case KEY_warn:
a0d0e21e
LW		 4024 hints |= HINT_BLOCK_SCOPE;
4025 LOP(OP_WARN,XTERM);
79072805
LW		 4026
4027 case KEY_wait:
4028 FUN0(OP_WAIT);
4029
4030 case KEY_waitpid:
a0d0e21e 4031 LOP(OP_WAITPID,XTERM);
79072805
LW		 4032
4033 case KEY_wantarray:
4034 FUN0(OP_WANTARRAY);
4035
4036 case KEY_write:
85e6fe83 4037 gv_fetchpv("\f",TRUE, SVt_PV); /* Make sure $^L is defined */
79072805
LW		 4038 UNI(OP_ENTERWRITE);
4039
4040 case KEY_x:
4041 if (expect == XOPERATOR)
4042 Mop(OP_REPEAT);
4043 check_uni();
4044 goto just_a_word;
4045
a0d0e21e
LW		 4046 case KEY_xor:
4047 yylval.ival = OP_XOR;
4048 OPERATOR(OROP);
4049
79072805
LW		 4050 case KEY_y:
4051 s = scan_trans(s);
4052 TERM(sublex_start());
4053 }
49dc05e3 4054 }}
79072805
LW		 4055}
4056
4057I32
8ac85365 4058keyword(register char *d, I32 len)
79072805
LW		 4059{
4060 switch (*d) {
4061 case '_':
4062 if (d[1] == '_') {
a0d0e21e 4063 if (strEQ(d,"__FILE__")) return -KEY___FILE__;
68dc0745 4064 if (strEQ(d,"__LINE__")) return -KEY___LINE__;
4065 if (strEQ(d,"__PACKAGE__")) return -KEY___PACKAGE__;
e50aee73 4066 if (strEQ(d,"__DATA__")) return KEY___DATA__;
79072805
LW		 4067 if (strEQ(d,"__END__")) return KEY___END__;
4068 }
4069 break;
8990e307
LW		 4070 case 'A':
4071 if (strEQ(d,"AUTOLOAD")) return KEY_AUTOLOAD;
4072 break;
79072805 4073 case 'a':
463ee0b2
LW		 4074 switch (len) {
4075 case 3:
a0d0e21e
LW		 4076 if (strEQ(d,"and")) return -KEY_and;
4077 if (strEQ(d,"abs")) return -KEY_abs;
85e6fe83 4078 break;
463ee0b2 4079 case 5:
a0d0e21e
LW		 4080 if (strEQ(d,"alarm")) return -KEY_alarm;
4081 if (strEQ(d,"atan2")) return -KEY_atan2;
463ee0b2
LW		 4082 break;
4083 case 6:
a0d0e21e 4084 if (strEQ(d,"accept")) return -KEY_accept;
463ee0b2
LW		 4085 break;
4086 }
79072805
LW		 4087 break;
4088 case 'B':
4089 if (strEQ(d,"BEGIN")) return KEY_BEGIN;
93a17b20 4090 break;
79072805 4091 case 'b':
a0d0e21e
LW		 4092 if (strEQ(d,"bless")) return -KEY_bless;
4093 if (strEQ(d,"bind")) return -KEY_bind;
4094 if (strEQ(d,"binmode")) return -KEY_binmode;
4095 break;
4096 case 'C':
4097 if (strEQ(d,"CORE")) return -KEY_CORE;
79072805
LW		 4098 break;
4099 case 'c':
4100 switch (len) {
4101 case 3:
a0d0e21e
LW		 4102 if (strEQ(d,"cmp")) return -KEY_cmp;
4103 if (strEQ(d,"chr")) return -KEY_chr;
4104 if (strEQ(d,"cos")) return -KEY_cos;
79072805
LW		 4105 break;
4106 case 4:
4107 if (strEQ(d,"chop")) return KEY_chop;
4108 break;
4109 case 5:
a0d0e21e
LW		 4110 if (strEQ(d,"close")) return -KEY_close;
4111 if (strEQ(d,"chdir")) return -KEY_chdir;
4112 if (strEQ(d,"chomp")) return KEY_chomp;
4113 if (strEQ(d,"chmod")) return -KEY_chmod;
4114 if (strEQ(d,"chown")) return -KEY_chown;
4115 if (strEQ(d,"crypt")) return -KEY_crypt;
79072805
LW		 4116 break;
4117 case 6:
a0d0e21e
LW		 4118 if (strEQ(d,"chroot")) return -KEY_chroot;
4119 if (strEQ(d,"caller")) return -KEY_caller;
79072805
LW		 4120 break;
4121 case 7:
a0d0e21e 4122 if (strEQ(d,"connect")) return -KEY_connect;
79072805
LW		 4123 break;
4124 case 8:
a0d0e21e
LW		 4125 if (strEQ(d,"closedir")) return -KEY_closedir;
4126 if (strEQ(d,"continue")) return -KEY_continue;
79072805
LW		 4127 break;
4128 }
4129 break;
ed6116ce
LW		 4130 case 'D':
4131 if (strEQ(d,"DESTROY")) return KEY_DESTROY;
4132 break;
79072805
LW		 4133 case 'd':
4134 switch (len) {
4135 case 2:
4136 if (strEQ(d,"do")) return KEY_do;
4137 break;
4138 case 3:
a0d0e21e 4139 if (strEQ(d,"die")) return -KEY_die;
79072805
LW		 4140 break;
4141 case 4:
a0d0e21e 4142 if (strEQ(d,"dump")) return -KEY_dump;
79072805
LW		 4143 break;
4144 case 6:
4145 if (strEQ(d,"delete")) return KEY_delete;
4146 break;
4147 case 7:
4148 if (strEQ(d,"defined")) return KEY_defined;
a0d0e21e 4149 if (strEQ(d,"dbmopen")) return -KEY_dbmopen;
79072805
LW		 4150 break;
4151 case 8:
a0d0e21e 4152 if (strEQ(d,"dbmclose")) return -KEY_dbmclose;
79072805
LW		 4153 break;
4154 }
4155 break;
4156 case 'E':
a0d0e21e 4157 if (strEQ(d,"EQ")) { deprecate(d); return -KEY_eq;}
79072805
LW		 4158 if (strEQ(d,"END")) return KEY_END;
4159 break;
4160 case 'e':
4161 switch (len) {
4162 case 2:
a0d0e21e 4163 if (strEQ(d,"eq")) return -KEY_eq;
79072805
LW		 4164 break;
4165 case 3:
a0d0e21e
LW		 4166 if (strEQ(d,"eof")) return -KEY_eof;
4167 if (strEQ(d,"exp")) return -KEY_exp;
79072805
LW		 4168 break;
4169 case 4:
4170 if (strEQ(d,"else")) return KEY_else;
a0d0e21e 4171 if (strEQ(d,"exit")) return -KEY_exit;
79072805 4172 if (strEQ(d,"eval")) return KEY_eval;
a0d0e21e 4173 if (strEQ(d,"exec")) return -KEY_exec;
79072805
LW		 4174 if (strEQ(d,"each")) return KEY_each;
4175 break;
4176 case 5:
4177 if (strEQ(d,"elsif")) return KEY_elsif;
4178 break;
a0d0e21e
LW		 4179 case 6:
4180 if (strEQ(d,"exists")) return KEY_exists;
4633a7c4 4181 if (strEQ(d,"elseif")) warn("elseif should be elsif");
a0d0e21e 4182 break;
79072805 4183 case 8:
a0d0e21e
LW		 4184 if (strEQ(d,"endgrent")) return -KEY_endgrent;
4185 if (strEQ(d,"endpwent")) return -KEY_endpwent;
79072805
LW		 4186 break;
4187 case 9:
a0d0e21e 4188 if (strEQ(d,"endnetent")) return -KEY_endnetent;
79072805
LW		 4189 break;
4190 case 10:
a0d0e21e
LW		 4191 if (strEQ(d,"endhostent")) return -KEY_endhostent;
4192 if (strEQ(d,"endservent")) return -KEY_endservent;
79072805
LW		 4193 break;
4194 case 11:
a0d0e21e 4195 if (strEQ(d,"endprotoent")) return -KEY_endprotoent;
79072805 4196 break;
a687059c 4197 }
a687059c 4198 break;
79072805
LW		 4199 case 'f':
4200 switch (len) {
4201 case 3:
4202 if (strEQ(d,"for")) return KEY_for;
4203 break;
4204 case 4:
a0d0e21e 4205 if (strEQ(d,"fork")) return -KEY_fork;
79072805
LW		 4206 break;
4207 case 5:
a0d0e21e
LW		 4208 if (strEQ(d,"fcntl")) return -KEY_fcntl;
4209 if (strEQ(d,"flock")) return -KEY_flock;
79072805
LW		 4210 break;
4211 case 6:
4212 if (strEQ(d,"format")) return KEY_format;
a0d0e21e 4213 if (strEQ(d,"fileno")) return -KEY_fileno;
79072805
LW		 4214 break;
4215 case 7:
4216 if (strEQ(d,"foreach")) return KEY_foreach;
4217 break;
4218 case 8:
a0d0e21e 4219 if (strEQ(d,"formline")) return -KEY_formline;
79072805 4220 break;
378cc40b 4221 }
a687059c 4222 break;
79072805
LW		 4223 case 'G':
4224 if (len == 2) {
a0d0e21e
LW		 4225 if (strEQ(d,"GT")) { deprecate(d); return -KEY_gt;}
4226 if (strEQ(d,"GE")) { deprecate(d); return -KEY_ge;}
9f68db38 4227 }
a687059c 4228 break;
79072805 4229 case 'g':
a687059c
LW		 4230 if (strnEQ(d,"get",3)) {
4231 d += 3;
4232 if (*d == 'p') {
79072805
LW		 4233 switch (len) {
4234 case 7:
a0d0e21e
LW		 4235 if (strEQ(d,"ppid")) return -KEY_getppid;
4236 if (strEQ(d,"pgrp")) return -KEY_getpgrp;
79072805
LW		 4237 break;
4238 case 8:
a0d0e21e
LW		 4239 if (strEQ(d,"pwent")) return -KEY_getpwent;
4240 if (strEQ(d,"pwnam")) return -KEY_getpwnam;
4241 if (strEQ(d,"pwuid")) return -KEY_getpwuid;
79072805
LW		 4242 break;
4243 case 11:
a0d0e21e
LW		 4244 if (strEQ(d,"peername")) return -KEY_getpeername;
4245 if (strEQ(d,"protoent")) return -KEY_getprotoent;
4246 if (strEQ(d,"priority")) return -KEY_getpriority;
79072805
LW		 4247 break;
4248 case 14:
a0d0e21e 4249 if (strEQ(d,"protobyname")) return -KEY_getprotobyname;
79072805
LW		 4250 break;
4251 case 16:
a0d0e21e 4252 if (strEQ(d,"protobynumber"))return -KEY_getprotobynumber;
79072805
LW		 4253 break;
4254 }
a687059c
LW		 4255 }
4256 else if (*d == 'h') {
a0d0e21e
LW		 4257 if (strEQ(d,"hostbyname")) return -KEY_gethostbyname;
4258 if (strEQ(d,"hostbyaddr")) return -KEY_gethostbyaddr;
4259 if (strEQ(d,"hostent")) return -KEY_gethostent;
a687059c
LW		 4260 }
4261 else if (*d == 'n') {
a0d0e21e
LW		 4262 if (strEQ(d,"netbyname")) return -KEY_getnetbyname;
4263 if (strEQ(d,"netbyaddr")) return -KEY_getnetbyaddr;
4264 if (strEQ(d,"netent")) return -KEY_getnetent;
a687059c
LW		 4265 }
4266 else if (*d == 's') {
a0d0e21e
LW		 4267 if (strEQ(d,"servbyname")) return -KEY_getservbyname;
4268 if (strEQ(d,"servbyport")) return -KEY_getservbyport;
4269 if (strEQ(d,"servent")) return -KEY_getservent;
4270 if (strEQ(d,"sockname")) return -KEY_getsockname;
4271 if (strEQ(d,"sockopt")) return -KEY_getsockopt;
a687059c
LW		 4272 }
4273 else if (*d == 'g') {
a0d0e21e
LW		 4274 if (strEQ(d,"grent")) return -KEY_getgrent;
4275 if (strEQ(d,"grnam")) return -KEY_getgrnam;
4276 if (strEQ(d,"grgid")) return -KEY_getgrgid;
a687059c
LW		 4277 }
4278 else if (*d == 'l') {
a0d0e21e 4279 if (strEQ(d,"login")) return -KEY_getlogin;
a687059c 4280 }
a0d0e21e 4281 else if (strEQ(d,"c")) return -KEY_getc;
79072805 4282 break;
a687059c 4283 }
79072805
LW		 4284 switch (len) {
4285 case 2:
a0d0e21e
LW		 4286 if (strEQ(d,"gt")) return -KEY_gt;
4287 if (strEQ(d,"ge")) return -KEY_ge;
79072805
LW		 4288 break;
4289 case 4:
4290 if (strEQ(d,"grep")) return KEY_grep;
4291 if (strEQ(d,"goto")) return KEY_goto;
fb73857a 4292 if (strEQ(d,"glob")) return KEY_glob;
79072805
LW		 4293 break;
4294 case 6:
a0d0e21e 4295 if (strEQ(d,"gmtime")) return -KEY_gmtime;
79072805 4296 break;
378cc40b 4297 }
a687059c 4298 break;
79072805 4299 case 'h':
a0d0e21e 4300 if (strEQ(d,"hex")) return -KEY_hex;
a687059c 4301 break;
7d07dbc2
MB		 4302 case 'I':
4303 if (strEQ(d,"INIT")) return KEY_INIT;
4304 break;
79072805
LW		 4305 case 'i':
4306 switch (len) {
4307 case 2:
4308 if (strEQ(d,"if")) return KEY_if;
4309 break;
4310 case 3:
a0d0e21e 4311 if (strEQ(d,"int")) return -KEY_int;
79072805
LW		 4312 break;
4313 case 5:
a0d0e21e
LW		 4314 if (strEQ(d,"index")) return -KEY_index;
4315 if (strEQ(d,"ioctl")) return -KEY_ioctl;
79072805
LW		 4316 break;
4317 }
a687059c 4318 break;
79072805 4319 case 'j':
a0d0e21e 4320 if (strEQ(d,"join")) return -KEY_join;
a687059c 4321 break;
79072805
LW		 4322 case 'k':
4323 if (len == 4) {
4324 if (strEQ(d,"keys")) return KEY_keys;
a0d0e21e 4325 if (strEQ(d,"kill")) return -KEY_kill;
663a0e37 4326 }
79072805
LW		 4327 break;
4328 case 'L':
4329 if (len == 2) {
a0d0e21e
LW		 4330 if (strEQ(d,"LT")) { deprecate(d); return -KEY_lt;}
4331 if (strEQ(d,"LE")) { deprecate(d); return -KEY_le;}
378cc40b 4332 }
79072805
LW		 4333 break;
4334 case 'l':
4335 switch (len) {
4336 case 2:
a0d0e21e
LW		 4337 if (strEQ(d,"lt")) return -KEY_lt;
4338 if (strEQ(d,"le")) return -KEY_le;
4339 if (strEQ(d,"lc")) return -KEY_lc;
79072805
LW		 4340 break;
4341 case 3:
a0d0e21e 4342 if (strEQ(d,"log")) return -KEY_log;
79072805
LW		 4343 break;
4344 case 4:
4345 if (strEQ(d,"last")) return KEY_last;
a0d0e21e 4346 if (strEQ(d,"link")) return -KEY_link;
c0329465 4347 if (strEQ(d,"lock")) return -KEY_lock;
395c3793 4348 break;
79072805
LW		 4349 case 5:
4350 if (strEQ(d,"local")) return KEY_local;
a0d0e21e 4351 if (strEQ(d,"lstat")) return -KEY_lstat;
79072805
LW		 4352 break;
4353 case 6:
a0d0e21e
LW		 4354 if (strEQ(d,"length")) return -KEY_length;
4355 if (strEQ(d,"listen")) return -KEY_listen;
79072805
LW		 4356 break;
4357 case 7:
a0d0e21e 4358 if (strEQ(d,"lcfirst")) return -KEY_lcfirst;
79072805
LW		 4359 break;
4360 case 9:
a0d0e21e 4361 if (strEQ(d,"localtime")) return -KEY_localtime;
395c3793
LW		 4362 break;
4363 }
a687059c 4364 break;
79072805
LW		 4365 case 'm':
4366 switch (len) {
4367 case 1: return KEY_m;
93a17b20
LW		 4368 case 2:
4369 if (strEQ(d,"my")) return KEY_my;
4370 break;
a0d0e21e
LW		 4371 case 3:
4372 if (strEQ(d,"map")) return KEY_map;
4373 break;
79072805 4374 case 5:
a0d0e21e 4375 if (strEQ(d,"mkdir")) return -KEY_mkdir;
79072805
LW		 4376 break;
4377 case 6:
a0d0e21e
LW		 4378 if (strEQ(d,"msgctl")) return -KEY_msgctl;
4379 if (strEQ(d,"msgget")) return -KEY_msgget;
4380 if (strEQ(d,"msgrcv")) return -KEY_msgrcv;
4381 if (strEQ(d,"msgsnd")) return -KEY_msgsnd;
79072805
LW		 4382 break;
4383 }
a687059c 4384 break;
79072805 4385 case 'N':
a0d0e21e 4386 if (strEQ(d,"NE")) { deprecate(d); return -KEY_ne;}
a687059c 4387 break;
79072805
LW		 4388 case 'n':
4389 if (strEQ(d,"next")) return KEY_next;
a0d0e21e
LW		 4390 if (strEQ(d,"ne")) return -KEY_ne;
4391 if (strEQ(d,"not")) return -KEY_not;
4392 if (strEQ(d,"no")) return KEY_no;
a687059c 4393 break;
79072805
LW		 4394 case 'o':
4395 switch (len) {
463ee0b2 4396 case 2:
a0d0e21e 4397 if (strEQ(d,"or")) return -KEY_or;
463ee0b2 4398 break;
79072805 4399 case 3:
a0d0e21e
LW		 4400 if (strEQ(d,"ord")) return -KEY_ord;
4401 if (strEQ(d,"oct")) return -KEY_oct;
79072805
LW		 4402 break;
4403 case 4:
a0d0e21e 4404 if (strEQ(d,"open")) return -KEY_open;
79072805
LW		 4405 break;
4406 case 7:
a0d0e21e 4407 if (strEQ(d,"opendir")) return -KEY_opendir;
79072805 4408 break;
fe14fcc3 4409 }
a687059c 4410 break;
79072805
LW		 4411 case 'p':
4412 switch (len) {
4413 case 3:
4414 if (strEQ(d,"pop")) return KEY_pop;
a0d0e21e 4415 if (strEQ(d,"pos")) return KEY_pos;
79072805
LW		 4416 break;
4417 case 4:
4418 if (strEQ(d,"push")) return KEY_push;
a0d0e21e
LW		 4419 if (strEQ(d,"pack")) return -KEY_pack;
4420 if (strEQ(d,"pipe")) return -KEY_pipe;
79072805
LW		 4421 break;
4422 case 5:
4423 if (strEQ(d,"print")) return KEY_print;
4424 break;
4425 case 6:
4426 if (strEQ(d,"printf")) return KEY_printf;
4427 break;
4428 case 7:
4429 if (strEQ(d,"package")) return KEY_package;
4430 break;
c07a80fd 4431 case 9:
4432 if (strEQ(d,"prototype")) return KEY_prototype;
663a0e37 4433 }
79072805
LW		 4434 break;
4435 case 'q':
4436 if (len <= 2) {
4437 if (strEQ(d,"q")) return KEY_q;
4438 if (strEQ(d,"qq")) return KEY_qq;
8990e307 4439 if (strEQ(d,"qw")) return KEY_qw;
79072805 4440 if (strEQ(d,"qx")) return KEY_qx;
663a0e37 4441 }
a0d0e21e 4442 else if (strEQ(d,"quotemeta")) return -KEY_quotemeta;
79072805
LW		 4443 break;
4444 case 'r':
4445 switch (len) {
4446 case 3:
a0d0e21e 4447 if (strEQ(d,"ref")) return -KEY_ref;
79072805
LW		 4448 break;
4449 case 4:
a0d0e21e
LW		 4450 if (strEQ(d,"read")) return -KEY_read;
4451 if (strEQ(d,"rand")) return -KEY_rand;
4452 if (strEQ(d,"recv")) return -KEY_recv;
79072805
LW		 4453 if (strEQ(d,"redo")) return KEY_redo;
4454 break;
4455 case 5:
a0d0e21e
LW		 4456 if (strEQ(d,"rmdir")) return -KEY_rmdir;
4457 if (strEQ(d,"reset")) return -KEY_reset;
79072805
LW		 4458 break;
4459 case 6:
4460 if (strEQ(d,"return")) return KEY_return;
a0d0e21e
LW		 4461 if (strEQ(d,"rename")) return -KEY_rename;
4462 if (strEQ(d,"rindex")) return -KEY_rindex;
79072805
LW		 4463 break;
4464 case 7:
a0d0e21e
LW		 4465 if (strEQ(d,"require")) return -KEY_require;
4466 if (strEQ(d,"reverse")) return -KEY_reverse;
4467 if (strEQ(d,"readdir")) return -KEY_readdir;
79072805
LW		 4468 break;
4469 case 8:
a0d0e21e
LW		 4470 if (strEQ(d,"readlink")) return -KEY_readlink;
4471 if (strEQ(d,"readline")) return -KEY_readline;
4472 if (strEQ(d,"readpipe")) return -KEY_readpipe;
79072805
LW		 4473 break;
4474 case 9:
a0d0e21e 4475 if (strEQ(d,"rewinddir")) return -KEY_rewinddir;
79072805 4476 break;
a687059c 4477 }
79072805
LW		 4478 break;
4479 case 's':
a687059c 4480 switch (d[1]) {
79072805 4481 case 0: return KEY_s;
a687059c 4482 case 'c':
79072805 4483 if (strEQ(d,"scalar")) return KEY_scalar;
a687059c
LW		 4484 break;
4485 case 'e':
79072805
LW		 4486 switch (len) {
4487 case 4:
a0d0e21e
LW		 4488 if (strEQ(d,"seek")) return -KEY_seek;
4489 if (strEQ(d,"send")) return -KEY_send;
79072805
LW		 4490 break;
4491 case 5:
a0d0e21e 4492 if (strEQ(d,"semop")) return -KEY_semop;
79072805
LW		 4493 break;
4494 case 6:
a0d0e21e
LW		 4495 if (strEQ(d,"select")) return -KEY_select;
4496 if (strEQ(d,"semctl")) return -KEY_semctl;
4497 if (strEQ(d,"semget")) return -KEY_semget;
79072805
LW		 4498 break;
4499 case 7:
a0d0e21e
LW		 4500 if (strEQ(d,"setpgrp")) return -KEY_setpgrp;
4501 if (strEQ(d,"seekdir")) return -KEY_seekdir;
79072805
LW		 4502 break;
4503 case 8:
a0d0e21e
LW		 4504 if (strEQ(d,"setpwent")) return -KEY_setpwent;
4505 if (strEQ(d,"setgrent")) return -KEY_setgrent;
79072805
LW		 4506 break;
4507 case 9:
a0d0e21e 4508 if (strEQ(d,"setnetent")) return -KEY_setnetent;
79072805
LW		 4509 break;
4510 case 10:
a0d0e21e
LW		 4511 if (strEQ(d,"setsockopt")) return -KEY_setsockopt;
4512 if (strEQ(d,"sethostent")) return -KEY_sethostent;
4513 if (strEQ(d,"setservent")) return -KEY_setservent;
79072805
LW		 4514 break;
4515 case 11:
a0d0e21e
LW		 4516 if (strEQ(d,"setpriority")) return -KEY_setpriority;
4517 if (strEQ(d,"setprotoent")) return -KEY_setprotoent;
79072805
LW		 4518 break;
4519 }
a687059c
LW		 4520 break;
4521 case 'h':
79072805
LW		 4522 switch (len) {
4523 case 5:
4524 if (strEQ(d,"shift")) return KEY_shift;
4525 break;
4526 case 6:
a0d0e21e
LW		 4527 if (strEQ(d,"shmctl")) return -KEY_shmctl;
4528 if (strEQ(d,"shmget")) return -KEY_shmget;
79072805
LW		 4529 break;
4530 case 7:
a0d0e21e 4531 if (strEQ(d,"shmread")) return -KEY_shmread;
79072805
LW		 4532 break;
4533 case 8:
a0d0e21e
LW		 4534 if (strEQ(d,"shmwrite")) return -KEY_shmwrite;
4535 if (strEQ(d,"shutdown")) return -KEY_shutdown;
79072805
LW		 4536 break;
4537 }
a687059c
LW		 4538 break;
4539 case 'i':
a0d0e21e 4540 if (strEQ(d,"sin")) return -KEY_sin;
a687059c
LW		 4541 break;
4542 case 'l':
a0d0e21e 4543 if (strEQ(d,"sleep")) return -KEY_sleep;
a687059c
LW		 4544 break;
4545 case 'o':
79072805 4546 if (strEQ(d,"sort")) return KEY_sort;
a0d0e21e
LW		 4547 if (strEQ(d,"socket")) return -KEY_socket;
4548 if (strEQ(d,"socketpair")) return -KEY_socketpair;
a687059c
LW		 4549 break;
4550 case 'p':
79072805 4551 if (strEQ(d,"split")) return KEY_split;
a0d0e21e 4552 if (strEQ(d,"sprintf")) return -KEY_sprintf;
79072805 4553 if (strEQ(d,"splice")) return KEY_splice;
a687059c
LW		 4554 break;
4555 case 'q':
a0d0e21e 4556 if (strEQ(d,"sqrt")) return -KEY_sqrt;
a687059c
LW		 4557 break;
4558 case 'r':
a0d0e21e 4559 if (strEQ(d,"srand")) return -KEY_srand;
a687059c
LW		 4560 break;
4561 case 't':
a0d0e21e 4562 if (strEQ(d,"stat")) return -KEY_stat;
79072805 4563 if (strEQ(d,"study")) return KEY_study;
a687059c
LW		 4564 break;
4565 case 'u':
a0d0e21e 4566 if (strEQ(d,"substr")) return -KEY_substr;
79072805 4567 if (strEQ(d,"sub")) return KEY_sub;
a687059c
LW		 4568 break;
4569 case 'y':
79072805
LW		 4570 switch (len) {
4571 case 6:
a0d0e21e 4572 if (strEQ(d,"system")) return -KEY_system;
79072805
LW		 4573 break;
4574 case 7:
a0d0e21e
LW		 4575 if (strEQ(d,"symlink")) return -KEY_symlink;
4576 if (strEQ(d,"syscall")) return -KEY_syscall;
137443ea 4577 if (strEQ(d,"sysopen")) return -KEY_sysopen;
4578 if (strEQ(d,"sysread")) return -KEY_sysread;
4579 if (strEQ(d,"sysseek")) return -KEY_sysseek;
79072805
LW		 4580 break;
4581 case 8:
a0d0e21e 4582 if (strEQ(d,"syswrite")) return -KEY_syswrite;
79072805 4583 break;
a687059c 4584 }
a687059c
LW		 4585 break;
4586 }
4587 break;
79072805
LW		 4588 case 't':
4589 switch (len) {
4590 case 2:
4591 if (strEQ(d,"tr")) return KEY_tr;
4592 break;
463ee0b2
LW		 4593 case 3:
4594 if (strEQ(d,"tie")) return KEY_tie;
4595 break;
79072805 4596 case 4:
a0d0e21e 4597 if (strEQ(d,"tell")) return -KEY_tell;
c07a80fd 4598 if (strEQ(d,"tied")) return KEY_tied;
a0d0e21e 4599 if (strEQ(d,"time")) return -KEY_time;
79072805
LW		 4600 break;
4601 case 5:
a0d0e21e 4602 if (strEQ(d,"times")) return -KEY_times;
79072805
LW		 4603 break;
4604 case 7:
a0d0e21e 4605 if (strEQ(d,"telldir")) return -KEY_telldir;
79072805
LW		 4606 break;
4607 case 8:
a0d0e21e 4608 if (strEQ(d,"truncate")) return -KEY_truncate;
79072805 4609 break;
378cc40b 4610 }
a687059c 4611 break;
79072805
LW		 4612 case 'u':
4613 switch (len) {
4614 case 2:
a0d0e21e
LW		 4615 if (strEQ(d,"uc")) return -KEY_uc;
4616 break;
4617 case 3:
4618 if (strEQ(d,"use")) return KEY_use;
79072805
LW		 4619 break;
4620 case 5:
4621 if (strEQ(d,"undef")) return KEY_undef;
4622 if (strEQ(d,"until")) return KEY_until;
463ee0b2 4623 if (strEQ(d,"untie")) return KEY_untie;
a0d0e21e
LW		 4624 if (strEQ(d,"utime")) return -KEY_utime;
4625 if (strEQ(d,"umask")) return -KEY_umask;
79072805
LW		 4626 break;
4627 case 6:
4628 if (strEQ(d,"unless")) return KEY_unless;
a0d0e21e
LW		 4629 if (strEQ(d,"unpack")) return -KEY_unpack;
4630 if (strEQ(d,"unlink")) return -KEY_unlink;
79072805
LW		 4631 break;
4632 case 7:
4633 if (strEQ(d,"unshift")) return KEY_unshift;
a0d0e21e 4634 if (strEQ(d,"ucfirst")) return -KEY_ucfirst;
79072805 4635 break;
a687059c
LW		 4636 }
4637 break;
79072805 4638 case 'v':
a0d0e21e
LW		 4639 if (strEQ(d,"values")) return -KEY_values;
4640 if (strEQ(d,"vec")) return -KEY_vec;
a687059c 4641 break;
79072805
LW		 4642 case 'w':
4643 switch (len) {
4644 case 4:
a0d0e21e
LW		 4645 if (strEQ(d,"warn")) return -KEY_warn;
4646 if (strEQ(d,"wait")) return -KEY_wait;
79072805
LW		 4647 break;
4648 case 5:
4649 if (strEQ(d,"while")) return KEY_while;
a0d0e21e 4650 if (strEQ(d,"write")) return -KEY_write;
79072805
LW		 4651 break;
4652 case 7:
a0d0e21e 4653 if (strEQ(d,"waitpid")) return -KEY_waitpid;
79072805
LW		 4654 break;
4655 case 9:
a0d0e21e 4656 if (strEQ(d,"wantarray")) return -KEY_wantarray;
79072805 4657 break;
2f3197b3 4658 }
a687059c 4659 break;
79072805 4660 case 'x':
a0d0e21e
LW		 4661 if (len == 1) return -KEY_x;
4662 if (strEQ(d,"xor")) return -KEY_xor;
a687059c 4663 break;
79072805
LW		 4664 case 'y':
4665 if (len == 1) return KEY_y;
4666 break;
4667 case 'z':
a687059c
LW		 4668 break;
4669 }
79072805 4670 return 0;
a687059c
LW		 4671}
4672
76e3520e 4673STATIC void
8ac85365 4674checkcomma(register char *s, char *name, char *what)
a687059c 4675{
2f3197b3
LW		 4676 char *w;
4677
463ee0b2 4678 if (dowarn && *s == ' ' && s[1] == '(') { /* XXX gotta be a better way */
a0d0e21e
LW		 4679 int level = 1;
4680 for (w = s+2; *w && level; w++) {
4681 if (*w == '(')
4682 ++level;
4683 else if (*w == ')')
4684 --level;
4685 }
4686 if (*w)
4687 for (; *w && isSPACE(*w); w++) ;
d1f3fb15 4688 if (!*w || !strchr(";|})]oaiuw!=", *w)) /* an advisory hack only... */
2f3197b3
LW		 4689 warn("%s (...) interpreted as function",name);
4690 }
4691 while (s < bufend && isSPACE(*s))
4692 s++;
a687059c
LW		 4693 if (*s == '(')
4694 s++;
de3bb511 4695 while (s < bufend && isSPACE(*s))
a687059c 4696 s++;
79072805 4697 if (isIDFIRST(*s)) {
2f3197b3 4698 w = s++;
de3bb511 4699 while (isALNUM(*s))
a687059c 4700 s++;
de3bb511 4701 while (s < bufend && isSPACE(*s))
a687059c 4702 s++;
e929a76b 4703 if (*s == ',') {
463ee0b2 4704 int kw;
e929a76b 4705 *s = '\0';
4633a7c4 4706 kw = keyword(w, s - w) || perl_get_cv(w, FALSE) != 0;
e929a76b 4707 *s = ',';
463ee0b2 4708 if (kw)
e929a76b 4709 return;
463ee0b2
LW		 4710 croak("No comma allowed after %s", what);
4711 }
4712 }
4713}
4714
b3ac6de7
IZ		 4715STATIC SV *
4716new_constant(char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type)
4717{
b3ac6de7 4718 dSP;
5152d7c7 4719 HV *table = perl_get_hv("\10", FALSE); /* ^H */
b3ac6de7
IZ		 4720 BINOP myop;
4721 SV *res;
4722 bool oldcatch = CATCH_GET;
4723 SV **cvp;
4724 SV *cv, *typesv;
4725 char buf[128];
4726
4727 if (!table) {
4728 yyerror("%^H is not defined");
4729 return sv;
4730 }
4731 cvp = hv_fetch(table, key, strlen(key), FALSE);
4732 if (!cvp || !SvOK(*cvp)) {
4733 sprintf(buf,"$^H{%s} is not defined", key);
4734 yyerror(buf);
4735 return sv;
4736 }
4737 sv_2mortal(sv); /* Parent created it permanently */
4738 cv = *cvp;
4739 if (!pv)
4740 pv = sv_2mortal(newSVpv(s, len));
4741 if (type)
4742 typesv = sv_2mortal(newSVpv(type, 0));
4743 else
4744 typesv = &sv_undef;
4745 CATCH_SET(TRUE);
4746 Zero(&myop, 1, BINOP);
4747 myop.op_last = (OP *) &myop;
4748 myop.op_next = Nullop;
4749 myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED;
4750
4751 PUSHSTACKi(SI_OVERLOAD);
4752 ENTER;
4753 SAVEOP();
4754 op = (OP *) &myop;
4755 if (PERLDB_SUB && curstash != debstash)
4756 op->op_private |= OPpENTERSUB_DB;
4757 PUTBACK;
4758 pp_pushmark(ARGS);
4759
4760 EXTEND(sp, 3);
4761 PUSHs(pv);
4762 PUSHs(sv);
4763 PUSHs(typesv);
4764 PUSHs(cv);
4765 PUTBACK;
4766
4767 if (op = pp_entersub(ARGS))
4768 CALLRUNOPS();
4769 LEAVE;
4770 SPAGAIN;
4771
4772 res = POPs;
4773 PUTBACK;
4774 CATCH_SET(oldcatch);
4775 POPSTACK;
4776
4777 if (!SvOK(res)) {
4778 sprintf(buf,"Call to &{$^H{%s}} did not return a defined value", key);
4779 yyerror(buf);
4780 }
4781 return SvREFCNT_inc(res);
4782}
4783
76e3520e 4784STATIC char *
8ac85365 4785scan_word(register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
463ee0b2
LW		 4786{
4787 register char *d = dest;
8903cb82 4788 register char *e = d + destlen - 3; /* two-character token, ending NUL */
463ee0b2 4789 for (;;) {
8903cb82 4790 if (d >= e)
fc36a67e 4791 croak(ident_too_long);
463ee0b2
LW		 4792 if (isALNUM(*s))
4793 *d++ = *s++;
4794 else if (*s == '\'' && allow_package && isIDFIRST(s[1])) {
4795 *d++ = ':';
4796 *d++ = ':';
4797 s++;
4798 }
c3e0f903 4799 else if (*s == ':' && s[1] == ':' && allow_package && s[2] != '$') {
463ee0b2
LW		 4800 *d++ = *s++;
4801 *d++ = *s++;
4802 }
4803 else {
4804 *d = '\0';
4805 *slp = d - dest;
4806 return s;
e929a76b 4807 }
378cc40b
LW		 4808 }
4809}
4810
76e3520e 4811STATIC char *
8ac85365 4812scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I32 ck_uni)
378cc40b
LW		 4813{
4814 register char *d;
8903cb82 4815 register char *e;
79072805 4816 char *bracket = 0;
748a9306 4817 char funny = *s++;
378cc40b 4818
79072805
LW		 4819 if (lex_brackets == 0)
4820 lex_fakebrack = 0;
a0d0e21e
LW		 4821 if (isSPACE(*s))
4822 s = skipspace(s);
378cc40b 4823 d = dest;
8903cb82 4824 e = d + destlen - 3; /* two-character token, ending NUL */
de3bb511 4825 if (isDIGIT(*s)) {
8903cb82 4826 while (isDIGIT(*s)) {
4827 if (d >= e)
fc36a67e 4828 croak(ident_too_long);
378cc40b 4829 *d++ = *s++;
8903cb82 4830 }
378cc40b
LW		 4831 }
4832 else {
463ee0b2 4833 for (;;) {
8903cb82 4834 if (d >= e)
fc36a67e 4835 croak(ident_too_long);
463ee0b2
LW		 4836 if (isALNUM(*s))
4837 *d++ = *s++;
4838 else if (*s == '\'' && isIDFIRST(s[1])) {
4839 *d++ = ':';
4840 *d++ = ':';
4841 s++;
4842 }
a0d0e21e 4843 else if (*s == ':' && s[1] == ':') {
463ee0b2
LW		 4844 *d++ = *s++;
4845 *d++ = *s++;
4846 }
4847 else
4848 break;
4849 }
378cc40b
LW		 4850 }
4851 *d = '\0';
4852 d = dest;
79072805
LW		 4853 if (*d) {
4854 if (lex_state != LEX_NORMAL)
4855 lex_state = LEX_INTERPENDMAYBE;
4856 return s;
378cc40b 4857 }
748a9306 4858 if (*s == '$' && s[1] &&
ff0cee69 4859 (isALNUM(s[1]) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
5cd24f17 4860 {
4861 if (isDIGIT(s[1]) && lex_state == LEX_INTERPNORMAL)
4862 deprecate("\"$$<digit>\" to mean \"${$}<digit>\"");
4863 else
4864 return s;
4865 }
79072805
LW		 4866 if (*s == '{') {
4867 bracket = s;
4868 s++;
4869 }
4870 else if (ck_uni)
4871 check_uni();
93a17b20 4872 if (s < send)
79072805
LW		 4873 *d = *s++;
4874 d[1] = '\0';
748a9306 4875 if (*d == '^' && *s && (isUPPER(*s) || strchr("[\\]^_?", *s))) {
bbce6d69 4876 *d = toCTRL(*s);
4877 s++;
de3bb511 4878 }
79072805 4879 if (bracket) {
748a9306 4880 if (isSPACE(s[-1])) {
fa83b5b6 4881 while (s < send) {
4882 char ch = *s++;
4883 if (ch != ' ' && ch != '\t') {
4884 *d = ch;
4885 break;
4886 }
4887 }
748a9306 4888 }
ff68c719 4889 if (isIDFIRST(*d)) {
79072805 4890 d++;
748a9306 4891 while (isALNUM(*s) || *s == ':')
79072805
LW		 4892 *d++ = *s++;
4893 *d = '\0';
748a9306 4894 while (s < send && (*s == ' ' || *s == '\t')) s++;
ff68c719 4895 if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
748a9306
LW		 4896 if (dowarn && keyword(dest, d - dest)) {
4897 char *brack = *s == '[' ? "[...]" : "{...}";
4898 warn("Ambiguous use of %c{%s%s} resolved to %c%s%s",
4899 funny, dest, brack, funny, dest, brack);
4900 }
4901 lex_fakebrack = lex_brackets+1;
79072805 4902 bracket++;
a0d0e21e 4903 lex_brackstack[lex_brackets++] = XOPERATOR;
79072805
LW		 4904 return s;
4905 }
4906 }
4907 if (*s == '}') {
4908 s++;
4909 if (lex_state == LEX_INTERPNORMAL && !lex_brackets)
4910 lex_state = LEX_INTERPEND;
748a9306
LW		 4911 if (funny == '#')
4912 funny = '@';
84902520 4913 if (dowarn && lex_state == LEX_NORMAL &&
748a9306
LW		 4914 (keyword(dest, d - dest) || perl_get_cv(dest, FALSE)))
4915 warn("Ambiguous use of %c{%s} resolved to %c%s",
4916 funny, dest, funny, dest);
79072805
LW		 4917 }
4918 else {
4919 s = bracket; /* let the parser handle it */
93a17b20 4920 *dest = '\0';
79072805
LW		 4921 }
4922 }
4923 else if (lex_state == LEX_INTERPNORMAL && !lex_brackets && !intuit_more(s))
4924 lex_state = LEX_INTERPEND;
378cc40b
LW		 4925 return s;
4926}
4927
8ac85365 4928void pmflag(U16 *pmfl, int ch)
a0d0e21e 4929{
bbce6d69 4930 if (ch == 'i')
a0d0e21e 4931 *pmfl |= PMf_FOLD;
a0d0e21e
LW		 4932 else if (ch == 'g')
4933 *pmfl |= PMf_GLOBAL;
c90c0ff4 4934 else if (ch == 'c')
4935 *pmfl |= PMf_CONTINUE;
a0d0e21e
LW		 4936 else if (ch == 'o')
4937 *pmfl |= PMf_KEEP;
4938 else if (ch == 'm')
4939 *pmfl |= PMf_MULTILINE;
4940 else if (ch == 's')
4941 *pmfl |= PMf_SINGLELINE;
48c036b1
GS		 4942 else if (ch == 't')
4943 *pmfl |= PMf_TAINTMEM;
a0d0e21e
LW		 4944 else if (ch == 'x')
4945 *pmfl |= PMf_EXTENDED;
4946}
378cc40b 4947
76e3520e 4948STATIC char *
8ac85365 4949scan_pat(char *start)
378cc40b 4950{
79072805
LW		 4951 PMOP *pm;
4952 char *s;
378cc40b 4953
79072805
LW		 4954 s = scan_str(start);
4955 if (!s) {
4956 if (lex_stuff)
8990e307 4957 SvREFCNT_dec(lex_stuff);
79072805 4958 lex_stuff = Nullsv;
463ee0b2 4959 croak("Search pattern not terminated");
378cc40b 4960 }
bbce6d69 4961
79072805 4962 pm = (PMOP*)newPMOP(OP_MATCH, 0);
a0d0e21e 4963 if (multi_open == '?')
79072805 4964 pm->op_pmflags |= PMf_ONCE;
48c036b1 4965 while (*s && strchr("iogcmstx", *s))
a0d0e21e 4966 pmflag(&pm->op_pmflags,*s++);
4633a7c4 4967 pm->op_pmpermflags = pm->op_pmflags;
bbce6d69 4968
79072805
LW		 4969 lex_op = (OP*)pm;
4970 yylval.ival = OP_MATCH;
378cc40b
LW		 4971 return s;
4972}
4973
76e3520e 4974STATIC char *
8ac85365 4975scan_subst(char *start)
79072805 4976{
a0d0e21e 4977 register char *s;
79072805 4978 register PMOP *pm;
4fdae800 4979 I32 first_start;
79072805
LW		 4980 I32 es = 0;
4981
79072805
LW		 4982 yylval.ival = OP_NULL;
4983
a0d0e21e 4984 s = scan_str(start);
79072805
LW		 4985
4986 if (!s) {
4987 if (lex_stuff)
8990e307 4988 SvREFCNT_dec(lex_stuff);
79072805 4989 lex_stuff = Nullsv;
463ee0b2 4990 croak("Substitution pattern not terminated");
a687059c 4991 }
79072805 4992
a0d0e21e 4993 if (s[-1] == multi_open)
79072805
LW		 4994 s--;
4995
4fdae800 4996 first_start = multi_start;
79072805
LW		 4997 s = scan_str(s);
4998 if (!s) {
4999 if (lex_stuff)
8990e307 5000 SvREFCNT_dec(lex_stuff);
79072805
LW		 5001 lex_stuff = Nullsv;
5002 if (lex_repl)
8990e307 5003 SvREFCNT_dec(lex_repl);
79072805 5004 lex_repl = Nullsv;
463ee0b2 5005 croak("Substitution replacement not terminated");
a687059c 5006 }
4fdae800 5007 multi_start = first_start; /* so whole substitution is taken together */
2f3197b3 5008
79072805 5009 pm = (PMOP*)newPMOP(OP_SUBST, 0);
48c036b1 5010 while (*s) {
a687059c
LW		 5011 if (*s == 'e') {
5012 s++;
2f3197b3 5013 es++;
a687059c 5014 }
48c036b1 5015 else if (strchr("iogcmstx", *s))
a0d0e21e 5016 pmflag(&pm->op_pmflags,*s++);
48c036b1
GS		 5017 else
5018 break;
378cc40b 5019 }
79072805
LW		 5020
5021 if (es) {
5022 SV *repl;
5023 pm->op_pmflags |= PMf_EVAL;
463ee0b2
LW		 5024 repl = newSVpv("",0);
5025 while (es-- > 0)
a0d0e21e 5026 sv_catpv(repl, es ? "eval " : "do ");
79072805
LW		 5027 sv_catpvn(repl, "{ ", 2);
5028 sv_catsv(repl, lex_repl);
5029 sv_catpvn(repl, " };", 2);
5030 SvCOMPILED_on(repl);
8990e307 5031 SvREFCNT_dec(lex_repl);
79072805 5032 lex_repl = repl;
378cc40b 5033 }
79072805 5034
4633a7c4 5035 pm->op_pmpermflags = pm->op_pmflags;
79072805
LW		 5036 lex_op = (OP*)pm;
5037 yylval.ival = OP_SUBST;
378cc40b
LW		 5038 return s;
5039}
5040
76e3520e 5041STATIC char *
8ac85365 5042scan_trans(char *start)
378cc40b 5043{
a0d0e21e 5044 register char* s;
11343788 5045 OP *o;
79072805
LW		 5046 short *tbl;
5047 I32 squash;
8ac85365 5048 I32 Delete;
79072805
LW		 5049 I32 complement;
5050
5051 yylval.ival = OP_NULL;
5052
a0d0e21e 5053 s = scan_str(start);
79072805
LW		 5054 if (!s) {
5055 if (lex_stuff)
8990e307 5056 SvREFCNT_dec(lex_stuff);
79072805 5057 lex_stuff = Nullsv;
2c268ad5 5058 croak("Transliteration pattern not terminated");
a687059c 5059 }
a0d0e21e 5060 if (s[-1] == multi_open)
2f3197b3
LW		 5061 s--;
5062
93a17b20 5063 s = scan_str(s);
79072805
LW		 5064 if (!s) {
5065 if (lex_stuff)
8990e307 5066 SvREFCNT_dec(lex_stuff);
79072805
LW		 5067 lex_stuff = Nullsv;
5068 if (lex_repl)
8990e307 5069 SvREFCNT_dec(lex_repl);
79072805 5070 lex_repl = Nullsv;
2c268ad5 5071 croak("Transliteration replacement not terminated");
a687059c 5072 }
79072805
LW		 5073
5074 New(803,tbl,256,short);
11343788 5075 o = newPVOP(OP_TRANS, 0, (char*)tbl);
2f3197b3 5076
8ac85365 5077 complement = Delete = squash = 0;
395c3793
LW		 5078 while (*s == 'c' || *s == 'd' || *s == 's') {
5079 if (*s == 'c')
79072805 5080 complement = OPpTRANS_COMPLEMENT;
395c3793 5081 else if (*s == 'd')
8ac85365 5082 Delete = OPpTRANS_DELETE;
395c3793 5083 else
79072805 5084 squash = OPpTRANS_SQUASH;
395c3793
LW		 5085 s++;
5086 }
8ac85365 5087 o->op_private = Delete|squash|complement;
79072805 5088
11343788 5089 lex_op = o;
79072805
LW		 5090 yylval.ival = OP_TRANS;
5091 return s;
5092}
5093
76e3520e 5094STATIC char *
8ac85365 5095scan_heredoc(register char *s)
79072805 5096{
11343788 5097 dTHR;
79072805
LW		 5098 SV *herewas;
5099 I32 op_type = OP_SCALAR;
5100 I32 len;
5101 SV *tmpstr;
5102 char term;
5103 register char *d;
fc36a67e 5104 register char *e;
4633a7c4 5105 char *peek;
a2c06652 5106 int outer = (rsfp && !(lex_inwhat == OP_SCALAR));
79072805
LW		 5107
5108 s += 2;
5109 d = tokenbuf;
fc36a67e 5110 e = tokenbuf + sizeof tokenbuf - 1;
fd2d0953 5111 if (!outer)
79072805 5112 *d++ = '\n';
4633a7c4
LW		 5113 for (peek = s; *peek == ' ' || *peek == '\t'; peek++) ;
5114 if (*peek && strchr("`'\"",*peek)) {
5115 s = peek;
79072805 5116 term = *s++;
fc36a67e 5117 s = delimcpy(d, e, s, bufend, term, &len);
5118 d += len;
79072805
LW		 5119 if (s < bufend)
5120 s++;
79072805
LW		 5121 }
5122 else {
5123 if (*s == '\\')
5124 s++, term = '\'';
5125 else
5126 term = '"';
4633a7c4
LW		 5127 if (!isALNUM(*s))
5128 deprecate("bare << to mean <<\"\"");
fc36a67e 5129 for (; isALNUM(*s); s++) {
5130 if (d < e)
5131 *d++ = *s;
5132 }
5133 }
5134 if (d >= tokenbuf + sizeof tokenbuf - 1)
5135 croak("Delimiter for here document is too long");
79072805
LW		 5136 *d++ = '\n';
5137 *d = '\0';
5138 len = d - tokenbuf;
5139 d = "\n";
fd2d0953 5140 if (outer || !(d=ninstr(s,bufend,d,d+1)))
79072805
LW		 5141 herewas = newSVpv(s,bufend-s);
5142 else
5143 s--, herewas = newSVpv(s,d-s);
5144 s += SvCUR(herewas);
748a9306 5145
8d6dde3e 5146 tmpstr = NEWSV(87,79);
748a9306
LW		 5147 sv_upgrade(tmpstr, SVt_PVIV);
5148 if (term == '\'') {
79072805 5149 op_type = OP_CONST;
748a9306
LW		 5150 SvIVX(tmpstr) = -1;
5151 }
5152 else if (term == '`') {
79072805 5153 op_type = OP_BACKTICK;
748a9306
LW		 5154 SvIVX(tmpstr) = '\\';
5155 }
79072805
LW		 5156
5157 CLINE;
5158 multi_start = curcop->cop_line;
5159 multi_open = multi_close = '<';
79072805 5160 term = *tokenbuf;
fd2d0953 5161 if (!outer) {
79072805
LW		 5162 d = s;
5163 while (s < bufend &&
36477c24 5164 (*s != term || memNE(s,tokenbuf,len)) ) {
79072805
LW		 5165 if (*s++ == '\n')
5166 curcop->cop_line++;
5167 }
5168 if (s >= bufend) {
5169 curcop->cop_line = multi_start;
8990e307 5170 missingterm(tokenbuf);
79072805
LW		 5171 }
5172 sv_setpvn(tmpstr,d+1,s-d);
5173 s += len - 1;
d2719217 5174 curcop->cop_line++; /* the preceding stmt passes a newline */
49d8d3a1 5175
79072805
LW		 5176 sv_catpvn(herewas,s,bufend-s);
5177 sv_setsv(linestr,herewas);
fd049845 5178 oldoldbufptr = oldbufptr = bufptr = s = linestart = SvPVX(linestr);
463ee0b2 5179 bufend = SvPVX(linestr) + SvCUR(linestr);
79072805
LW		 5180 }
5181 else
5182 sv_setpvn(tmpstr,"",0); /* avoid "uninitialized" warning */
5183 while (s >= bufend) { /* multiple line string? */
fd2d0953 5184 if (!outer ||
fd049845 5185 !(oldoldbufptr = oldbufptr = s = linestart = filter_gets(linestr, rsfp, 0))) {
79072805 5186 curcop->cop_line = multi_start;
8990e307 5187 missingterm(tokenbuf);
79072805
LW		 5188 }
5189 curcop->cop_line++;
84902520 5190 if (PERLDB_LINE && curstash != debstash) {
79072805
LW		 5191 SV *sv = NEWSV(88,0);
5192
93a17b20 5193 sv_upgrade(sv, SVt_PVMG);
79072805
LW		 5194 sv_setsv(sv,linestr);
5195 av_store(GvAV(curcop->cop_filegv),
5196 (I32)curcop->cop_line,sv);
5197 }
463ee0b2 5198 bufend = SvPVX(linestr) + SvCUR(linestr);
36477c24 5199 if (*s == term && memEQ(s,tokenbuf,len)) {
79072805
LW		 5200 s = bufend - 1;
5201 *s = ' ';
5202 sv_catsv(linestr,herewas);
463ee0b2 5203 bufend = SvPVX(linestr) + SvCUR(linestr);
79072805
LW		 5204 }
5205 else {
5206 s = bufend;
5207 sv_catsv(tmpstr,linestr);
395c3793
LW		 5208 }
5209 }
79072805
LW		 5210 multi_end = curcop->cop_line;
5211 s++;
5212 if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
5213 SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
463ee0b2 5214 Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
79072805 5215 }
8990e307 5216 SvREFCNT_dec(herewas);
79072805
LW		 5217 lex_stuff = tmpstr;
5218 yylval.ival = op_type;
5219 return s;
5220}
5221
02aa26ce
NT		 5222/* scan_inputsymbol
5223 takes: current position in input buffer
5224 returns: new position in input buffer
5225 side-effects: yylval and lex_op are set.
5226
5227 This code handles:
5228
5229 <> read from ARGV
5230 <FH> read from filehandle
5231 <pkg::FH> read from package qualified filehandle
5232 <pkg'FH> read from package qualified filehandle
5233 <$fh> read from filehandle in $fh
5234 <*.h> filename glob
5235
5236*/
5237
76e3520e 5238STATIC char *
8ac85365 5239scan_inputsymbol(char *start)
79072805 5240{
02aa26ce 5241 register char *s = start; /* current position in buffer */
79072805 5242 register char *d;
fc36a67e 5243 register char *e;
79072805
LW		 5244 I32 len;
5245
02aa26ce
NT		 5246 d = tokenbuf; /* start of temp holding space */
5247 e = tokenbuf + sizeof tokenbuf; /* end of temp holding space */
5248 s = delimcpy(d, e, s + 1, bufend, '>', &len); /* extract until > */
5249
5250 /* die if we didn't have space for the contents of the <>,
5251 or if it didn't end
5252 */
5253
fc36a67e 5254 if (len >= sizeof tokenbuf)
5255 croak("Excessively long <> operator");
5256 if (s >= bufend)
463ee0b2 5257 croak("Unterminated <> operator");
02aa26ce 5258
fc36a67e 5259 s++;
02aa26ce
NT		 5260
5261 /* check for <$fh>
5262 Remember, only scalar variables are interpreted as filehandles by
5263 this code. Anything more complex (e.g., <$fh{$num}>) will be
5264 treated as a glob() call.
5265 This code makes use of the fact that except for the $ at the front,
5266 a scalar variable and a filehandle look the same.
5267 */
4633a7c4 5268 if (*d == '$' && d[1]) d++;
02aa26ce
NT		 5269
5270 /* allow <Pkg'VALUE> or <Pkg::VALUE> */
a0d0e21e 5271 while (*d && (isALNUM(*d) || *d == '\'' || *d == ':'))
79072805 5272 d++;
02aa26ce
NT		 5273
5274 /* If we've tried to read what we allow filehandles to look like, and
5275 there's still text left, then it must be a glob() and not a getline.
5276 Use scan_str to pull out the stuff between the <> and treat it
5277 as nothing more than a string.
5278 */
5279
79072805
LW		 5280 if (d - tokenbuf != len) {
5281 yylval.ival = OP_GLOB;
5282 set_csh();
5283 s = scan_str(start);
5284 if (!s)
02aa26ce 5285 croak("Glob not terminated");
79072805
LW		 5286 return s;
5287 }
395c3793 5288 else {
02aa26ce 5289 /* we're in a filehandle read situation */
79072805 5290 d = tokenbuf;
02aa26ce
NT		 5291
5292 /* turn <> into <ARGV> */
79072805
LW		 5293 if (!len)
5294 (void)strcpy(d,"ARGV");
02aa26ce
NT		 5295
5296 /* if <$fh>, create the ops to turn the variable into a
5297 filehandle
5298 */
79072805 5299 if (*d == '$') {
a0d0e21e 5300 I32 tmp;
02aa26ce
NT		 5301
5302 /* try to find it in the pad for this block, otherwise find
5303 add symbol table ops
5304 */
11343788
MB		 5305 if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
5306 OP *o = newOP(OP_PADSV, 0);
5307 o->op_targ = tmp;
5308 lex_op = (OP*)newUNOP(OP_READLINE, 0, newUNOP(OP_RV2GV, 0, o));
a0d0e21e
LW		 5309 }
5310 else {
5311 GV *gv = gv_fetchpv(d+1,TRUE, SVt_PV);
5312 lex_op = (OP*)newUNOP(OP_READLINE, 0,
5313 newUNOP(OP_RV2GV, 0,
5314 newUNOP(OP_RV2SV, 0,
5315 newGVOP(OP_GV, 0, gv))));
5316 }
02aa26ce 5317 /* we created the ops in lex_op, so make yylval.ival a null op */
79072805
LW		 5318 yylval.ival = OP_NULL;
5319 }
02aa26ce
NT		 5320
5321 /* If it's none of the above, it must be a literal filehandle
5322 (<Foo::BAR> or <FOO>) so build a simple readline OP */
79072805 5323 else {
85e6fe83 5324 GV *gv = gv_fetchpv(d,TRUE, SVt_PVIO);
79072805
LW		 5325 lex_op = (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
5326 yylval.ival = OP_NULL;
5327 }
5328 }
02aa26ce 5329
79072805
LW		 5330 return s;
5331}
5332
02aa26ce
NT		 5333
5334/* scan_str
5335 takes: start position in buffer
5336 returns: position to continue reading from buffer
5337 side-effects: multi_start, multi_close, lex_repl or lex_stuff, and
5338 updates the read buffer.
5339
5340 This subroutine pulls a string out of the input. It is called for:
5341 q single quotes q(literal text)
5342 ' single quotes 'literal text'
5343 qq double quotes qq(interpolate $here please)
5344 " double quotes "interpolate $here please"
5345 qx backticks qx(/bin/ls -l)
5346 ` backticks `/bin/ls -l`
5347 qw quote words @EXPORT_OK = qw( func() $spam )
5348 m// regexp match m/this/
5349 s/// regexp substitute s/this/that/
5350 tr/// string transliterate tr/this/that/
5351 y/// string transliterate y/this/that/
5352 ($*@) sub prototypes sub foo ($)
5353 <> readline or globs <FOO>, <>, <$fh>, or <*.c>
5354
5355 In most of these cases (all but <>, patterns and transliterate)
5356 yylex() calls scan_str(). m// makes yylex() call scan_pat() which
5357 calls scan_str(). s/// makes yylex() call scan_subst() which calls
5358 scan_str(). tr/// and y/// make yylex() call scan_trans() which
5359 calls scan_str().
5360
5361 It skips whitespace before the string starts, and treats the first
5362 character as the delimiter. If the delimiter is one of ([{< then
5363 the corresponding "close" character )]}> is used as the closing
5364 delimiter. It allows quoting of delimiters, and if the string has
5365 balanced delimiters ([{<>}]) it allows nesting.
5366
5367 The lexer always reads these strings into lex_stuff, except in the
5368 case of the operators which take *two* arguments (s/// and tr///)
5369 when it checks to see if lex_stuff is full (presumably with the 1st
5370 arg to s or tr) and if so puts the string into lex_repl.
5371
5372*/
5373
76e3520e 5374STATIC char *
8ac85365 5375scan_str(char *start)
79072805 5376{
11343788 5377 dTHR;
02aa26ce
NT		 5378 SV *sv; /* scalar value: string */
5379 char *tmps; /* temp string, used for delimiter matching */
5380 register char *s = start; /* current position in the buffer */
5381 register char term; /* terminating character */
5382 register char *to; /* current position in the sv's data */
5383 I32 brackets = 1; /* bracket nesting level */
5384
5385 /* skip space before the delimiter */
fb73857a 5386 if (isSPACE(*s))
5387 s = skipspace(s);
02aa26ce
NT		 5388
5389 /* mark where we are, in case we need to report errors */
79072805 5390 CLINE;
02aa26ce
NT		 5391
5392 /* after skipping whitespace, the next character is the terminator */
a0d0e21e 5393 term = *s;
02aa26ce 5394 /* mark where we are */
79072805
LW		 5395 multi_start = curcop->cop_line;
5396 multi_open = term;
02aa26ce
NT		 5397
5398 /* find corresponding closing delimiter */
93a17b20 5399 if (term && (tmps = strchr("([{< )]}> )]}>",term)))
79072805
LW		 5400 term = tmps[5];
5401 multi_close = term;
5402
02aa26ce 5403 /* create a new SV to hold the contents. 87 is leak category, I'm
8d6dde3e
IZ		 5404 assuming. 79 is the SV's initial length. What a random number. */
5405 sv = NEWSV(87,79);
ed6116ce
LW		 5406 sv_upgrade(sv, SVt_PVIV);
5407 SvIVX(sv) = term;
a0d0e21e 5408 (void)SvPOK_only(sv); /* validate pointer */
02aa26ce
NT		 5409
5410 /* move past delimiter and try to read a complete string */
93a17b20
LW		 5411 s++;
5412 for (;;) {
02aa26ce 5413 /* extend sv if need be */
93a17b20 5414 SvGROW(sv, SvCUR(sv) + (bufend - s) + 1);
02aa26ce 5415 /* set 'to' to the next character in the sv's string */
463ee0b2 5416 to = SvPVX(sv)+SvCUR(sv);
02aa26ce
NT		 5417
5418 /* if open delimiter is the close delimiter read unbridle */
93a17b20
LW		 5419 if (multi_open == multi_close) {
5420 for (; s < bufend; s++,to++) {
02aa26ce 5421 /* embedded newlines increment the current line number */
463ee0b2
LW		 5422 if (*s == '\n' && !rsfp)
5423 curcop->cop_line++;
02aa26ce 5424 /* handle quoted delimiters */
a0d0e21e
LW		 5425 if (*s == '\\' && s+1 < bufend && term != '\\') {
5426 if (s[1] == term)
5427 s++;
02aa26ce 5428 /* any other quotes are simply copied straight through */
a0d0e21e
LW		 5429 else
5430 *to++ = *s++;
5431 }
02aa26ce
NT		 5432 /* terminate when run out of buffer (the for() condition), or
5433 have found the terminator */
93a17b20
LW		 5434 else if (*s == term)
5435 break;
5436 *to = *s;
5437 }
5438 }
02aa26ce
NT		 5439
5440 /* if the terminator isn't the same as the start character (e.g.,
5441 matched brackets), we have to allow more in the quoting, and
5442 be prepared for nested brackets.
5443 */
93a17b20 5444 else {
02aa26ce 5445 /* read until we run out of string, or we find the terminator */
93a17b20 5446 for (; s < bufend; s++,to++) {
02aa26ce 5447 /* embedded newlines increment the line count */
463ee0b2
LW		 5448 if (*s == '\n' && !rsfp)
5449 curcop->cop_line++;
02aa26ce 5450 /* backslashes can escape the open or closing characters */
6d07e5e9
GS		 5451 if (*s == '\\' && s+1 < bufend) {
5452 if ((s[1] == multi_open) || (s[1] == multi_close))
a0d0e21e
LW		 5453 s++;
5454 else
5455 *to++ = *s++;
5456 }
02aa26ce 5457 /* allow nested opens and closes */
6d07e5e9 5458 else if (*s == multi_close && --brackets <= 0)
93a17b20
LW		 5459 break;
5460 else if (*s == multi_open)
5461 brackets++;
5462 *to = *s;
5463 }
5464 }
02aa26ce 5465 /* terminate the copied string and update the sv's end-of-string */
93a17b20 5466 *to = '\0';
463ee0b2 5467 SvCUR_set(sv, to - SvPVX(sv));
93a17b20 5468
02aa26ce
NT		 5469 /*
5470 * this next chunk reads more into the buffer if we're not done yet
5471 */
5472
5473 if (s < bufend) break; /* handle case where we are done yet :-) */
79072805 5474
02aa26ce
NT		 5475 /* if we're out of file, or a read fails, bail and reset the current
5476 line marker so we can report where the unterminated string began
5477 */
79072805 5478 if (!rsfp ||
fd049845 5479 !(oldoldbufptr = oldbufptr = s = linestart = filter_gets(linestr, rsfp, 0))) {
c07a80fd 5480 sv_free(sv);
79072805
LW		 5481 curcop->cop_line = multi_start;
5482 return Nullch;
5483 }
02aa26ce 5484 /* we read a line, so increment our line counter */
79072805 5485 curcop->cop_line++;
02aa26ce
NT		 5486
5487 /* update debugger info */
84902520 5488 if (PERLDB_LINE && curstash != debstash) {
79072805
LW		 5489 SV *sv = NEWSV(88,0);
5490
93a17b20 5491 sv_upgrade(sv, SVt_PVMG);
79072805
LW		 5492 sv_setsv(sv,linestr);
5493 av_store(GvAV(curcop->cop_filegv),
5494 (I32)curcop->cop_line, sv);
395c3793 5495 }
02aa26ce
NT		 5496
5497 /* having changed the buffer, we must update bufend */
463ee0b2 5498 bufend = SvPVX(linestr) + SvCUR(linestr);
378cc40b 5499 }
02aa26ce
NT		 5500
5501 /* at this point, we have successfully read the delimited string */
5502
79072805
LW		 5503 multi_end = curcop->cop_line;
5504 s++;
02aa26ce
NT		 5505
5506 /* if we allocated too much space, give some back */
93a17b20
LW		 5507 if (SvCUR(sv) + 5 < SvLEN(sv)) {
5508 SvLEN_set(sv, SvCUR(sv) + 1);
463ee0b2 5509 Renew(SvPVX(sv), SvLEN(sv), char);
79072805 5510 }
02aa26ce
NT		 5511
5512 /* decide whether this is the first or second quoted string we've read
5513 for this op
5514 */
5515
79072805 5516 if (lex_stuff)
93a17b20 5517 lex_repl = sv;
79072805 5518 else
93a17b20 5519 lex_stuff = sv;
378cc40b
LW		 5520 return s;
5521}
5522
02aa26ce
NT		 5523/*
5524 scan_num
5525 takes: pointer to position in buffer
5526 returns: pointer to new position in buffer
5527 side-effects: builds ops for the constant in yylval.op
5528
5529 Read a number in any of the formats that Perl accepts:
5530
5531 0(x[0-7A-F]+)|([0-7]+)
5532 [\d_]+(\.[\d_]*)?[Ee](\d+)
5533
5534 Underbars (_) are allowed in decimal numbers. If -w is on,
5535 underbars before a decimal point must be at three digit intervals.
5536
5537 Like most scan_ routines, it uses the tokenbuf buffer to hold the
5538 thing it reads.
5539
5540 If it reads a number without a decimal point or an exponent, it will
5541 try converting the number to an integer and see if it can do so
5542 without loss of precision.
5543*/
5544
378cc40b 5545char *
8ac85365 5546scan_num(char *start)
378cc40b 5547{
02aa26ce
NT		 5548 register char *s = start; /* current position in buffer */
5549 register char *d; /* destination in temp buffer */
5550 register char *e; /* end of temp buffer */
5551 I32 tryiv; /* used to see if it can be an int */
5552 double value; /* number read, as a double */
5553 SV *sv; /* place to put the converted number */
5554 I32 floatit; /* boolean: int or float? */
5555 char *lastub = 0; /* position of last underbar */
fc36a67e 5556 static char number_too_long[] = "Number too long";
378cc40b 5557
02aa26ce
NT		 5558 /* We use the first character to decide what type of number this is */
5559
378cc40b 5560 switch (*s) {
79072805 5561 default:
02aa26ce
NT		 5562 croak("panic: scan_num");
5563
5564 /* if it starts with a 0, it could be an octal number, a decimal in
5565 0.13 disguise, or a hexadecimal number.
5566 */
378cc40b
LW		 5567 case '0':
5568 {
02aa26ce
NT		 5569 /* variables:
5570 u holds the "number so far"
5571 shift the power of 2 of the base (hex == 4, octal == 3)
5572 overflowed was the number more than we can hold?
5573
5574 Shift is used when we add a digit. It also serves as an "are
5575 we in octal or hex?" indicator to disallow hex characters when
5576 in octal mode.
5577 */
55497cff 5578 UV u;
79072805 5579 I32 shift;
55497cff 5580 bool overflowed = FALSE;
378cc40b 5581
02aa26ce 5582 /* check for hex */
378cc40b
LW		 5583 if (s[1] == 'x') {
5584 shift = 4;
5585 s += 2;
5586 }
02aa26ce 5587 /* check for a decimal in disguise */
378cc40b
LW		 5588 else if (s[1] == '.')
5589 goto decimal;
02aa26ce 5590 /* so it must be octal */
378cc40b
LW		 5591 else
5592 shift = 3;
55497cff 5593 u = 0;
02aa26ce
NT		 5594
5595 /* read the rest of the octal number */
378cc40b 5596 for (;;) {
02aa26ce 5597 UV n, b; /* n is used in the overflow test, b is the digit we're adding on */
55497cff 5598
378cc40b 5599 switch (*s) {
02aa26ce
NT		 5600
5601 /* if we don't mention it, we're done */
378cc40b
LW		 5602 default:
5603 goto out;
02aa26ce
NT		 5604
5605 /* _ are ignored */
de3bb511
LW		 5606 case '_':
5607 s++;
5608 break;
02aa26ce
NT		 5609
5610 /* 8 and 9 are not octal */
378cc40b
LW		 5611 case '8': case '9':
5612 if (shift != 4)
a687059c 5613 yyerror("Illegal octal digit");
378cc40b 5614 /* FALL THROUGH */
02aa26ce
NT		 5615
5616 /* octal digits */
378cc40b
LW		 5617 case '0': case '1': case '2': case '3': case '4':
5618 case '5': case '6': case '7':
02aa26ce 5619 b = *s++ & 15; /* ASCII digit -> value of digit */
55497cff 5620 goto digit;
02aa26ce
NT		 5621
5622 /* hex digits */
378cc40b
LW		 5623 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
5624 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
02aa26ce 5625 /* make sure they said 0x */
378cc40b
LW		 5626 if (shift != 4)
5627 goto out;
55497cff 5628 b = (*s++ & 7) + 9;
02aa26ce
NT		 5629
5630 /* Prepare to put the digit we have onto the end
5631 of the number so far. We check for overflows.
5632 */
5633
55497cff 5634 digit:
02aa26ce 5635 n = u << shift; /* make room for the digit */
b3ac6de7
IZ		 5636 if (!overflowed && (n >> shift) != u
5637 && !(hints & HINT_NEW_BINARY)) {
55497cff 5638 warn("Integer overflow in %s number",
5639 (shift == 4) ? "hex" : "octal");
5640 overflowed = TRUE;
5641 }
02aa26ce 5642 u = n | b; /* add the digit to the end */
378cc40b
LW		 5643 break;
5644 }
5645 }
02aa26ce
NT		 5646
5647 /* if we get here, we had success: make a scalar value from
5648 the number.
5649 */
378cc40b 5650 out:
79072805 5651 sv = NEWSV(92,0);
55497cff 5652 sv_setuv(sv, u);
b3ac6de7
IZ		 5653 if ( hints & HINT_NEW_BINARY)
5654 sv = new_constant(start, s - start, "binary", sv, Nullsv, NULL);
378cc40b
LW		 5655 }
5656 break;
02aa26ce
NT		 5657
5658 /*
5659 handle decimal numbers.
5660 we're also sent here when we read a 0 as the first digit
5661 */
378cc40b
LW		 5662 case '1': case '2': case '3': case '4': case '5':
5663 case '6': case '7': case '8': case '9': case '.':
5664 decimal:
378cc40b 5665 d = tokenbuf;
fc36a67e 5666 e = tokenbuf + sizeof tokenbuf - 6; /* room for various punctuation */
79072805 5667 floatit = FALSE;
02aa26ce
NT		 5668
5669 /* read next group of digits and _ and copy into d */
de3bb511 5670 while (isDIGIT(*s) || *s == '_') {
02aa26ce
NT		 5671 /* skip underscores, checking for misplaced ones
5672 if -w is on
5673 */
93a17b20
LW		 5674 if (*s == '_') {
5675 if (dowarn && lastub && s - lastub != 3)
8990e307 5676 warn("Misplaced _ in number");
93a17b20
LW		 5677 lastub = ++s;
5678 }
fc36a67e 5679 else {
02aa26ce 5680 /* check for end of fixed-length buffer */
fc36a67e 5681 if (d >= e)
5682 croak(number_too_long);
02aa26ce 5683 /* if we're ok, copy the character */
378cc40b 5684 *d++ = *s++;
fc36a67e 5685 }
378cc40b 5686 }
02aa26ce
NT		 5687
5688 /* final misplaced underbar check */
93a17b20 5689 if (dowarn && lastub && s - lastub != 3)
8990e307 5690 warn("Misplaced _ in number");
02aa26ce
NT		 5691
5692 /* read a decimal portion if there is one. avoid
5693 3..5 being interpreted as the number 3. followed
5694 by .5
5695 */
2f3197b3 5696 if (*s == '.' && s[1] != '.') {
79072805 5697 floatit = TRUE;
378cc40b 5698 *d++ = *s++;
02aa26ce
NT		 5699
5700 /* copy, ignoring underbars, until we run out of
5701 digits. Note: no misplaced underbar checks!
5702 */
fc36a67e 5703 for (; isDIGIT(*s) || *s == '_'; s++) {
02aa26ce 5704 /* fixed length buffer check */
fc36a67e 5705 if (d >= e)
5706 croak(number_too_long);
5707 if (*s != '_')
5708 *d++ = *s;
378cc40b
LW		 5709 }
5710 }
02aa26ce
NT		 5711
5712 /* read exponent part, if present */
93a17b20 5713 if (*s && strchr("eE",*s) && strchr("+-0123456789",s[1])) {
79072805
LW		 5714 floatit = TRUE;
5715 s++;
02aa26ce
NT		 5716
5717 /* regardless of whether user said 3E5 or 3e5, use lower 'e' */
79072805 5718 *d++ = 'e'; /* At least some Mach atof()s don't grok 'E' */
02aa26ce
NT		 5719
5720 /* allow positive or negative exponent */
378cc40b
LW		 5721 if (*s == '+' || *s == '-')
5722 *d++ = *s++;
02aa26ce
NT		 5723
5724 /* read digits of exponent (no underbars :-) */
fc36a67e 5725 while (isDIGIT(*s)) {
5726 if (d >= e)
5727 croak(number_too_long);
378cc40b 5728 *d++ = *s++;
fc36a67e 5729 }
378cc40b 5730 }
02aa26ce
NT		 5731
5732 /* terminate the string */
378cc40b 5733 *d = '\0';
02aa26ce
NT		 5734
5735 /* make an sv from the string */
79072805 5736 sv = NEWSV(92,0);
02aa26ce 5737 /* reset numeric locale in case we were earlier left in Swaziland */
36477c24 5738 SET_NUMERIC_STANDARD();
79072805 5739 value = atof(tokenbuf);
02aa26ce
NT		 5740
5741 /*
5742 See if we can make do with an integer value without loss of
5743 precision. We use I_V to cast to an int, because some
5744 compilers have issues. Then we try casting it back and see
5745 if it was the same. We only do this if we know we
5746 specifically read an integer.
5747
5748 Note: if floatit is true, then we don't need to do the
5749 conversion at all.
5750 */
1e422769 5751 tryiv = I_V(value);
5752 if (!floatit && (double)tryiv == value)
5753 sv_setiv(sv, tryiv);
2f3197b3 5754 else
1e422769 5755 sv_setnv(sv, value);
b3ac6de7
IZ		 5756 if ( floatit ? (hints & HINT_NEW_FLOAT) : (hints & HINT_NEW_INTEGER) )
5757 sv = new_constant(tokenbuf, d - tokenbuf,
5758 (floatit ? "float" : "integer"), sv, Nullsv, NULL);
378cc40b 5759 break;
79072805 5760 }
a687059c 5761
02aa26ce
NT		 5762 /* make the op for the constant and return */
5763
79072805 5764 yylval.opval = newSVOP(OP_CONST, 0, sv);
a687059c 5765
378cc40b
LW		 5766 return s;
5767}
5768
76e3520e 5769STATIC char *
8ac85365 5770scan_formline(register char *s)
378cc40b 5771{
11343788 5772 dTHR;
79072805 5773 register char *eol;
378cc40b 5774 register char *t;
a0d0e21e 5775 SV *stuff = newSVpv("",0);
79072805 5776 bool needargs = FALSE;
378cc40b 5777
79072805 5778 while (!needargs) {
85e6fe83 5779 if (*s == '.' || *s == '}') {
79072805
LW		 5780 /*SUPPRESS 530*/
5781 for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
5782 if (*t == '\n')
5783 break;
5784 }
0f85fab0 5785 if (in_eval && !rsfp) {
93a17b20 5786 eol = strchr(s,'\n');
0f85fab0
LW		 5787 if (!eol++)
5788 eol = bufend;
5789 }
5790 else
463ee0b2 5791 eol = bufend = SvPVX(linestr) + SvCUR(linestr);
79072805 5792 if (*s != '#') {
a0d0e21e
LW		 5793 for (t = s; t < eol; t++) {
5794 if (*t == '~' && t[1] == '~' && SvCUR(stuff)) {
5795 needargs = FALSE;
5796 goto enough; /* ~~ must be first line in formline */
378cc40b 5797 }
a0d0e21e
LW		 5798 if (*t == '@' || *t == '^')
5799 needargs = TRUE;
378cc40b 5800 }
a0d0e21e 5801 sv_catpvn(stuff, s, eol-s);
79072805
LW		 5802 }
5803 s = eol;
5804 if (rsfp) {
fd049845 5805 s = filter_gets(linestr, rsfp, 0);
5806 oldoldbufptr = oldbufptr = bufptr = linestart = SvPVX(linestr);
a0d0e21e 5807 bufend = bufptr + SvCUR(linestr);
79072805
LW		 5808 if (!s) {
5809 s = bufptr;
5810 yyerror("Format not terminated");
378cc40b
LW		 5811 break;
5812 }
378cc40b 5813 }
463ee0b2 5814 incline(s);
79072805 5815 }
a0d0e21e
LW		 5816 enough:
5817 if (SvCUR(stuff)) {
463ee0b2 5818 expect = XTERM;
79072805 5819 if (needargs) {
a0d0e21e 5820 lex_state = LEX_NORMAL;
79072805
LW		 5821 nextval[nexttoke].ival = 0;
5822 force_next(',');
5823 }
a0d0e21e
LW		 5824 else
5825 lex_state = LEX_FORMLINE;
79072805
LW		 5826 nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, stuff);
5827 force_next(THING);
5828 nextval[nexttoke].ival = OP_FORMLINE;
5829 force_next(LSTOP);
378cc40b 5830 }
79072805 5831 else {
8990e307 5832 SvREFCNT_dec(stuff);
85e6fe83 5833 lex_formbrack = 0;
79072805
LW		 5834 bufptr = s;
5835 }
5836 return s;
378cc40b 5837}
a687059c 5838
76e3520e 5839STATIC void
8ac85365 5840set_csh(void)
a687059c 5841{
ae986130
LW		 5842#ifdef CSH
5843 if (!cshlen)
5844 cshlen = strlen(cshname);
5845#endif
a687059c 5846}
463ee0b2 5847
ba6d6ac9 5848I32
8ac85365 5849start_subparse(I32 is_format, U32 flags)
8990e307 5850{
11343788 5851 dTHR;
ba6d6ac9 5852 I32 oldsavestack_ix = savestack_ix;
748a9306
LW		 5853 CV* outsidecv = compcv;
5854 AV* comppadlist;
8990e307 5855
e9a444f0
LW		 5856 if (compcv) {
5857 assert(SvTYPE(compcv) == SVt_PVCV);
5858 }
8990e307
LW		 5859 save_I32(&subline);
5860 save_item(subname);
55497cff 5861 SAVEI32(padix);
8990e307
LW		 5862 SAVESPTR(curpad);
5863 SAVESPTR(comppad);
5864 SAVESPTR(comppad_name);
748a9306 5865 SAVESPTR(compcv);
55497cff 5866 SAVEI32(comppad_name_fill);
5867 SAVEI32(min_intro_pending);
5868 SAVEI32(max_intro_pending);
5869 SAVEI32(pad_reset_pending);
748a9306
LW		 5870
5871 compcv = (CV*)NEWSV(1104,0);
774d564b 5872 sv_upgrade((SV *)compcv, is_format ? SVt_PVFM : SVt_PVCV);
fa83b5b6 5873 CvFLAGS(compcv) |= flags;
748a9306 5874
8990e307 5875 comppad = newAV();
6d4ff0d2
MB		 5876 av_push(comppad, Nullsv);
5877 curpad = AvARRAY(comppad);
8990e307
LW		 5878 comppad_name = newAV();
5879 comppad_name_fill = 0;
5880 min_intro_pending = 0;
8990e307 5881 padix = 0;
8990e307 5882 subline = curcop->cop_line;
6d4ff0d2
MB		 5883#ifdef USE_THREADS
5884 av_store(comppad_name, 0, newSVpv("@_", 2));
5885 curpad[0] = (SV*)newAV();
5886 SvPADMY_on(curpad[0]); /* XXX Needed? */
5887 CvOWNER(compcv) = 0;
12ca11f6 5888 New(666, CvMUTEXP(compcv), 1, perl_mutex);
6d4ff0d2 5889 MUTEX_INIT(CvMUTEXP(compcv));
6d4ff0d2 5890#endif /* USE_THREADS */
748a9306
LW		 5891
5892 comppadlist = newAV();
5893 AvREAL_off(comppadlist);
8e07c86e
AD		 5894 av_store(comppadlist, 0, (SV*)comppad_name);
5895 av_store(comppadlist, 1, (SV*)comppad);
748a9306
LW		 5896
5897 CvPADLIST(compcv) = comppadlist;
199100c8 5898 CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc(outsidecv);
11343788
MB		 5899#ifdef USE_THREADS
5900 CvOWNER(compcv) = 0;
12ca11f6 5901 New(666, CvMUTEXP(compcv), 1, perl_mutex);
11343788 5902 MUTEX_INIT(CvMUTEXP(compcv));
11343788 5903#endif /* USE_THREADS */
748a9306 5904
8990e307
LW		 5905 return oldsavestack_ix;
5906}
5907
5908int
8ac85365 5909yywarn(char *s)
8990e307 5910{
11343788 5911 dTHR;
8990e307 5912 --error_count;
748a9306
LW		 5913 in_eval |= 2;
5914 yyerror(s);
5915 in_eval &= ~2;
5916 return 0;
8990e307
LW		 5917}
5918
5919int
8ac85365 5920yyerror(char *s)
463ee0b2 5921{
11343788 5922 dTHR;
68dc0745 5923 char *where = NULL;
5924 char *context = NULL;
5925 int contlen = -1;
46fc3d4c 5926 SV *msg;
463ee0b2 5927
54310121 5928 if (!yychar || (yychar == ';' && !rsfp))
5929 where = "at EOF";
5930 else if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
463ee0b2
LW		 5931 oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
5932 while (isSPACE(*oldoldbufptr))
5933 oldoldbufptr++;
68dc0745 5934 context = oldoldbufptr;
5935 contlen = bufptr - oldoldbufptr;
463ee0b2
LW		 5936 }
5937 else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
5938 oldbufptr != bufptr) {
5939 while (isSPACE(*oldbufptr))
5940 oldbufptr++;
68dc0745 5941 context = oldbufptr;
5942 contlen = bufptr - oldbufptr;
463ee0b2
LW		 5943 }
5944 else if (yychar > 255)
68dc0745 5945 where = "next token ???";
463ee0b2
LW		 5946 else if ((yychar & 127) == 127) {
5947 if (lex_state == LEX_NORMAL ||
5948 (lex_state == LEX_KNOWNEXT && lex_defer == LEX_NORMAL))
68dc0745 5949 where = "at end of line";
4633a7c4 5950 else if (lex_inpat)
68dc0745 5951 where = "within pattern";
463ee0b2 5952 else
68dc0745 5953 where = "within string";
463ee0b2 5954 }
46fc3d4c 5955 else {
5956 SV *where_sv = sv_2mortal(newSVpv("next char ", 0));
5957 if (yychar < 32)
5958 sv_catpvf(where_sv, "^%c", toCTRL(yychar));
5959 else if (isPRINT_LC(yychar))
5960 sv_catpvf(where_sv, "%c", yychar);
463ee0b2 5961 else
46fc3d4c 5962 sv_catpvf(where_sv, "\\%03o", yychar & 255);
5963 where = SvPVX(where_sv);
463ee0b2 5964 }
46fc3d4c 5965 msg = sv_2mortal(newSVpv(s, 0));
fc36a67e 5966 sv_catpvf(msg, " at %_ line %ld, ",
46fc3d4c 5967 GvSV(curcop->cop_filegv), (long)curcop->cop_line);
68dc0745 5968 if (context)
46fc3d4c 5969 sv_catpvf(msg, "near \"%.*s\"\n", contlen, context);
463ee0b2 5970 else
46fc3d4c 5971 sv_catpvf(msg, "%s\n", where);
4fdae800 5972 if (multi_start < multi_end && (U32)(curcop->cop_line - multi_end) <= 1) {
46fc3d4c 5973 sv_catpvf(msg,
4fdae800 5974 " (Might be a runaway multi-line %c%c string starting on line %ld)\n",
ff0cee69 5975 (int)multi_open,(int)multi_close,(long)multi_start);
a0d0e21e
LW		 5976 multi_end = 0;
5977 }
748a9306 5978 if (in_eval & 2)
fc36a67e 5979 warn("%_", msg);
748a9306 5980 else if (in_eval)
38a03e6e 5981 sv_catsv(ERRSV, msg);
463ee0b2 5982 else
46fc3d4c 5983 PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
463ee0b2 5984 if (++error_count >= 10)
fc36a67e 5985 croak("%_ has too many errors.\n", GvSV(curcop->cop_filegv));
4633a7c4 5986 in_my = 0;
c750a3ec 5987 in_my_stash = Nullhv;
463ee0b2
LW		 5988 return 0;
5989}
4e35701f 5990
161b471a 5991
Unnamed repository; edit this file 'description' to name the repository.