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
per Larry suggestion, toss change#1327 and fix the documentation
[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 */
0f303493 547 gv_fetchpv(s, in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : 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;
0f303493 1525 gv_fetchpv(tokenbuf+1, in_eval ? (GV_ADDMULTI | GV_ADDINEVAL) : 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? */
56f7f34b
CS		 2824 GV *ogv = Nullgv; /* override (winner) */
2825 GV *hgv = Nullgv; /* hidden (loser) */
2826 if (expect != XOPERATOR && (*s != ':' || s[1] != ':')) {
2827 CV *cv;
2828 if ((gv = gv_fetchpv(tokenbuf, FALSE, SVt_PVCV)) &&
2829 (cv = GvCVu(gv)))
2830 {
2831 if (GvIMPORTED_CV(gv))
2832 ogv = gv;
2833 else if (! CvMETHOD(cv))
2834 hgv = gv;
2835 }
2836 if (!ogv &&
2837 (gvp = (GV**)hv_fetch(globalstash,tokenbuf,len,FALSE)) &&
2838 (gv = *gvp) != (GV*)&sv_undef &&
2839 GvCVu(gv) && GvIMPORTED_CV(gv))
2840 {
2841 ogv = gv;
2842 }
2843 }
2844 if (ogv) {
2845 tmp = 0; /* overridden by import or by GLOBAL */
6e7b2336
GS		 2846 }
2847 else if (gv && !gvp
2848 && -tmp==KEY_lock /* XXX generalizable kludge */
1d64a758 2849 && !hv_fetch(GvHVn(incgv), "Thread.pm", 9, FALSE))
6e7b2336
GS		 2850 {
2851 tmp = 0; /* any sub overrides "weak" keyword */
a0d0e21e 2852 }
56f7f34b
CS		 2853 else { /* no override */
2854 tmp = -tmp;
2855 gv = Nullgv;
2856 gvp = 0;
2857 if (dowarn && hgv)
2858 warn("Subroutine %s::%s hidden by keyword; use ampersand",
2859 HvNAME(GvESTASH(hgv)), GvENAME(hgv));
49dc05e3 2860 }
a0d0e21e
LW		 2861 }
2862
2863 reserved_word:
2864 switch (tmp) {
79072805
LW		 2865
2866 default: /* not a keyword */
93a17b20 2867 just_a_word: {
96e4d5b1 2868 SV *sv;
748a9306 2869 char lastchar = (bufptr == oldoldbufptr ? 0 : bufptr[-1]);
8990e307
LW		 2870
2871 /* Get the rest if it looks like a package qualifier */
2872
a0d0e21e 2873 if (*s == '\'' || *s == ':' && s[1] == ':') {
c3e0f903 2874 STRLEN morelen;
8903cb82 2875 s = scan_word(s, tokenbuf + len, sizeof tokenbuf - len,
c3e0f903
GS		 2876 TRUE, &morelen);
2877 if (!morelen)
ec2ab091
HM		 2878 croak("Bad name after %s%s", tokenbuf,
2879 *s == '\'' ? "'" : "::");
c3e0f903 2880 len += morelen;
a0d0e21e 2881 }
8990e307 2882
3643fb5f 2883 if (expect == XOPERATOR) {
fd049845 2884 if (bufptr == linestart) {
463ee0b2
LW		 2885 curcop->cop_line--;
2886 warn(warn_nosemi);
2887 curcop->cop_line++;
2888 }
2889 else
54310121 2890 no_op("Bareword",s);
463ee0b2 2891 }
8990e307 2892
c3e0f903
GS		 2893 /* Look for a subroutine with this name in current package,
2894 unless name is "Foo::", in which case Foo is a bearword
2895 (and a package name). */
2896
2897 if (len > 2 &&
2898 tokenbuf[len - 2] == ':' && tokenbuf[len - 1] == ':')
2899 {
2900 if (dowarn && ! gv_fetchpv(tokenbuf, FALSE, SVt_PVHV))
2901 warn("Bareword \"%s\" refers to nonexistent package",
2902 tokenbuf);
2903 len -= 2;
2904 tokenbuf[len] = '\0';
2905 gv = Nullgv;
2906 gvp = 0;
2907 }
2908 else {
2909 len = 0;
2910 if (!gv)
2911 gv = gv_fetchpv(tokenbuf, FALSE, SVt_PVCV);
2912 }
2913
2914 /* if we saw a global override before, get the right name */
8990e307 2915
49dc05e3
GS		 2916 if (gvp) {
2917 sv = newSVpv("CORE::GLOBAL::",14);
2918 sv_catpv(sv,tokenbuf);
2919 }
2920 else
2921 sv = newSVpv(tokenbuf,0);
8990e307 2922
a0d0e21e
LW		 2923 /* Presume this is going to be a bareword of some sort. */
2924
2925 CLINE;
49dc05e3 2926 yylval.opval = (OP*)newSVOP(OP_CONST, 0, sv);
a0d0e21e
LW		 2927 yylval.opval->op_private = OPpCONST_BARE;
2928
c3e0f903
GS		 2929 /* And if "Foo::", then that's what it certainly is. */
2930
2931 if (len)
2932 goto safe_bareword;
2933
8990e307
LW		 2934 /* See if it's the indirect object for a list operator. */
2935
a0d0e21e
LW		 2936 if (oldoldbufptr &&
2937 oldoldbufptr < bufptr &&
2938 (oldoldbufptr == last_lop || oldoldbufptr == last_uni) &&
2939 /* NO SKIPSPACE BEFORE HERE! */
2a841d13
IZ		 2940 (expect == XREF
2941 || ((opargs[last_lop_op] >> OASHIFT)& 7) == OA_FILEREF
2942 || (last_lop_op == OP_ENTERSUB
2943 && last_proto
2944 && last_proto[last_proto[0] == ';' ? 1 : 0] == '*')) )
a0d0e21e 2945 {
748a9306
LW		 2946 bool immediate_paren = *s == '(';
2947
a0d0e21e
LW		 2948 /* (Now we can afford to cross potential line boundary.) */
2949 s = skipspace(s);
2950
2951 /* Two barewords in a row may indicate method call. */
2952
2953 if ((isALPHA(*s) || *s == '$') && (tmp=intuit_method(s,gv)))
2954 return tmp;
2955
2956 /* If not a declared subroutine, it's an indirect object. */
2957 /* (But it's an indir obj regardless for sort.) */
2958
8e07c86e 2959 if ((last_lop_op == OP_SORT ||
8ebc5c01 2960 (!immediate_paren && (!gv || !GvCVu(gv))) ) &&
8e07c86e 2961 (last_lop_op != OP_MAPSTART && last_lop_op != OP_GREPSTART)){
748a9306
LW		 2962 expect = (last_lop == oldoldbufptr) ? XTERM : XOPERATOR;
2963 goto bareword;
93a17b20
LW		 2964 }
2965 }
8990e307
LW		 2966
2967 /* If followed by a paren, it's certainly a subroutine. */
2968
2969 expect = XOPERATOR;
2970 s = skipspace(s);
93a17b20 2971 if (*s == '(') {
79072805 2972 CLINE;
96e4d5b1 2973 if (gv && GvCVu(gv)) {
2974 for (d = s + 1; *d == ' ' || *d == '\t'; d++) ;
2975 if (*d == ')' && (sv = cv_const_sv(GvCV(gv)))) {
2976 s = d + 1;
2977 goto its_constant;
2978 }
2979 }
a0d0e21e 2980 nextval[nexttoke].opval = yylval.opval;
463ee0b2 2981 expect = XOPERATOR;
93a17b20 2982 force_next(WORD);
c07a80fd 2983 yylval.ival = 0;
463ee0b2 2984 TOKEN('&');
79072805 2985 }
93a17b20 2986
a0d0e21e 2987 /* If followed by var or block, call it a method (unless sub) */
8990e307 2988
8ebc5c01 2989 if ((*s == '$' || *s == '{') && (!gv || !GvCVu(gv))) {
463ee0b2 2990 last_lop = oldbufptr;
8990e307 2991 last_lop_op = OP_METHOD;
93a17b20 2992 PREBLOCK(METHOD);
463ee0b2
LW		 2993 }
2994
8990e307
LW		 2995 /* If followed by a bareword, see if it looks like indir obj. */
2996
a0d0e21e
LW		 2997 if ((isALPHA(*s) || *s == '$') && (tmp = intuit_method(s,gv)))
2998 return tmp;
93a17b20 2999
8990e307
LW		 3000 /* Not a method, so call it a subroutine (if defined) */
3001
8ebc5c01 3002 if (gv && GvCVu(gv)) {
46fc3d4c 3003 CV* cv;
748a9306 3004 if (lastchar == '-')
c2960299 3005 warn("Ambiguous use of -%s resolved as -&%s()",
748a9306 3006 tokenbuf, tokenbuf);
8990e307 3007 last_lop = oldbufptr;
a0d0e21e 3008 last_lop_op = OP_ENTERSUB;
89bfa8cd 3009 /* Check for a constant sub */
46fc3d4c 3010 cv = GvCV(gv);
96e4d5b1 3011 if ((sv = cv_const_sv(cv))) {
3012 its_constant:
3013 SvREFCNT_dec(((SVOP*)yylval.opval)->op_sv);
3014 ((SVOP*)yylval.opval)->op_sv = SvREFCNT_inc(sv);
3015 yylval.opval->op_private = 0;
3016 TOKEN(WORD);
89bfa8cd 3017 }
3018
a5f75d66
AD		 3019 /* Resolve to GV now. */
3020 op_free(yylval.opval);
3021 yylval.opval = newCVREF(0, newGVOP(OP_GV, 0, gv));
4633a7c4
LW		 3022 /* Is there a prototype? */
3023 if (SvPOK(cv)) {
3024 STRLEN len;
2a841d13 3025 last_proto = SvPV((SV*)cv, len);
4633a7c4
LW		 3026 if (!len)
3027 TERM(FUNC0SUB);
2a841d13 3028 if (strEQ(last_proto, "$"))
4633a7c4 3029 OPERATOR(UNIOPSUB);
2a841d13 3030 if (*last_proto == '&' && *s == '{') {
4633a7c4
LW		 3031 sv_setpv(subname,"__ANON__");
3032 PREBLOCK(LSTOPSUB);
3033 }
2a841d13
IZ		 3034 } else
3035 last_proto = NULL;
a5f75d66 3036 nextval[nexttoke].opval = yylval.opval;
8990e307
LW		 3037 expect = XTERM;
3038 force_next(WORD);
3039 TOKEN(NOAMP);
3040 }
748a9306
LW		 3041
3042 if (hints & HINT_STRICT_SUBS &&
3043 lastchar != '-' &&
a0d0e21e 3044 strnNE(s,"->",2) &&
9b01e405 3045 last_lop_op != OP_TRUNCATE && /* S/F prototype in opcode.pl */
a0d0e21e
LW		 3046 last_lop_op != OP_ACCEPT &&
3047 last_lop_op != OP_PIPE_OP &&
3048 last_lop_op != OP_SOCKPAIR)
3049 {
3050 warn(
3051 "Bareword \"%s\" not allowed while \"strict subs\" in use",
85e6fe83
LW		 3052 tokenbuf);
3053 ++error_count;
3054 }
8990e307
LW		 3055
3056 /* Call it a bare word */
3057
748a9306
LW		 3058 bareword:
3059 if (dowarn) {
3060 if (lastchar != '-') {
3061 for (d = tokenbuf; *d && isLOWER(*d); d++) ;
3062 if (!*d)
3063 warn(warn_reserved, tokenbuf);
3064 }
3065 }
c3e0f903
GS		 3066
3067 safe_bareword:
748a9306
LW		 3068 if (lastchar && strchr("*%&", lastchar)) {
3069 warn("Operator or semicolon missing before %c%s",
3070 lastchar, tokenbuf);
c2960299 3071 warn("Ambiguous use of %c resolved as operator %c",
748a9306
LW		 3072 lastchar, lastchar);
3073 }
93a17b20 3074 TOKEN(WORD);
79072805 3075 }
79072805 3076
68dc0745 3077 case KEY___FILE__:
46fc3d4c 3078 yylval.opval = (OP*)newSVOP(OP_CONST, 0,
3079 newSVsv(GvSV(curcop->cop_filegv)));
3080 TERM(THING);
3081
79072805 3082 case KEY___LINE__:
46fc3d4c 3083 yylval.opval = (OP*)newSVOP(OP_CONST, 0,
3084 newSVpvf("%ld", (long)curcop->cop_line));
79072805 3085 TERM(THING);
68dc0745 3086
3087 case KEY___PACKAGE__:
3088 yylval.opval = (OP*)newSVOP(OP_CONST, 0,
3089 (curstash
3090 ? newSVsv(curstname)
3091 : &sv_undef));
79072805 3092 TERM(THING);
79072805 3093
e50aee73 3094 case KEY___DATA__:
79072805
LW		 3095 case KEY___END__: {
3096 GV *gv;
79072805
LW		 3097
3098 /*SUPPRESS 560*/
a5f75d66 3099 if (rsfp && (!in_eval || tokenbuf[2] == 'D')) {
e50aee73
AD		 3100 char *pname = "main";
3101 if (tokenbuf[2] == 'D')
3102 pname = HvNAME(curstash ? curstash : defstash);
46fc3d4c 3103 gv = gv_fetchpv(form("%s::DATA", pname), TRUE, SVt_PVIO);
a5f75d66 3104 GvMULTI_on(gv);
79072805 3105 if (!GvIO(gv))
a0d0e21e
LW		 3106 GvIOp(gv) = newIO();
3107 IoIFP(GvIOp(gv)) = rsfp;
3108#if defined(HAS_FCNTL) && defined(F_SETFD)
3109 {
760ac839 3110 int fd = PerlIO_fileno(rsfp);
a0d0e21e
LW		 3111 fcntl(fd,F_SETFD,fd >= 3);
3112 }
79072805 3113#endif
fd049845 3114 /* Mark this internal pseudo-handle as clean */
3115 IoFLAGS(GvIOp(gv)) |= IOf_UNTAINT;
79072805 3116 if (preprocess)
a0d0e21e 3117 IoTYPE(GvIOp(gv)) = '|';
760ac839 3118 else if ((PerlIO*)rsfp == PerlIO_stdin())
a0d0e21e 3119 IoTYPE(GvIOp(gv)) = '-';
79072805 3120 else
a0d0e21e 3121 IoTYPE(GvIOp(gv)) = '<';
79072805
LW		 3122 rsfp = Nullfp;
3123 }
3124 goto fake_eof;
e929a76b 3125 }
de3bb511 3126
8990e307 3127 case KEY_AUTOLOAD:
ed6116ce 3128 case KEY_DESTROY:
79072805
LW		 3129 case KEY_BEGIN:
3130 case KEY_END:
7d07dbc2 3131 case KEY_INIT:
a0d0e21e 3132 if (expect == XSTATE) {
93a17b20
LW		 3133 s = bufptr;
3134 goto really_sub;
79072805
LW		 3135 }
3136 goto just_a_word;
3137
a0d0e21e
LW		 3138 case KEY_CORE:
3139 if (*s == ':' && s[1] == ':') {
3140 s += 2;
748a9306 3141 d = s;
8903cb82 3142 s = scan_word(s, tokenbuf, sizeof tokenbuf, FALSE, &len);
a0d0e21e
LW		 3143 tmp = keyword(tokenbuf, len);
3144 if (tmp < 0)
3145 tmp = -tmp;
3146 goto reserved_word;
3147 }
3148 goto just_a_word;
3149
463ee0b2
LW		 3150 case KEY_abs:
3151 UNI(OP_ABS);
3152
79072805
LW		 3153 case KEY_alarm:
3154 UNI(OP_ALARM);
3155
3156 case KEY_accept:
a0d0e21e 3157 LOP(OP_ACCEPT,XTERM);
79072805 3158
463ee0b2
LW		 3159 case KEY_and:
3160 OPERATOR(ANDOP);
3161
79072805 3162 case KEY_atan2:
a0d0e21e 3163 LOP(OP_ATAN2,XTERM);
85e6fe83 3164
79072805 3165 case KEY_bind:
a0d0e21e 3166 LOP(OP_BIND,XTERM);
79072805
LW		 3167
3168 case KEY_binmode:
3169 UNI(OP_BINMODE);
3170
3171 case KEY_bless:
a0d0e21e 3172 LOP(OP_BLESS,XTERM);
79072805
LW		 3173
3174 case KEY_chop:
3175 UNI(OP_CHOP);
3176
3177 case KEY_continue:
3178 PREBLOCK(CONTINUE);
3179
3180 case KEY_chdir:
85e6fe83 3181 (void)gv_fetchpv("ENV",TRUE, SVt_PVHV); /* may use HOME */
79072805
LW		 3182 UNI(OP_CHDIR);
3183
3184 case KEY_close:
3185 UNI(OP_CLOSE);
3186
3187 case KEY_closedir:
3188 UNI(OP_CLOSEDIR);
3189
3190 case KEY_cmp:
3191 Eop(OP_SCMP);
3192
3193 case KEY_caller:
3194 UNI(OP_CALLER);
3195
3196 case KEY_crypt:
3197#ifdef FCRYPT
de3bb511
LW		 3198 if (!cryptseen++)
3199 init_des();
a687059c 3200#endif
a0d0e21e 3201 LOP(OP_CRYPT,XTERM);
79072805
LW		 3202
3203 case KEY_chmod:
748a9306
LW		 3204 if (dowarn) {
3205 for (d = s; d < bufend && (isSPACE(*d) || *d == '('); d++) ;
3206 if (*d != '0' && isDIGIT(*d))
3207 yywarn("chmod: mode argument is missing initial 0");
3208 }
a0d0e21e 3209 LOP(OP_CHMOD,XTERM);
79072805
LW		 3210
3211 case KEY_chown:
a0d0e21e 3212 LOP(OP_CHOWN,XTERM);
79072805
LW		 3213
3214 case KEY_connect:
a0d0e21e 3215 LOP(OP_CONNECT,XTERM);
79072805 3216
463ee0b2
LW		 3217 case KEY_chr:
3218 UNI(OP_CHR);
3219
79072805
LW		 3220 case KEY_cos:
3221 UNI(OP_COS);
3222
3223 case KEY_chroot:
3224 UNI(OP_CHROOT);
3225
3226 case KEY_do:
3227 s = skipspace(s);
3228 if (*s == '{')
a0d0e21e 3229 PRETERMBLOCK(DO);
79072805 3230 if (*s != '\'')
a0d0e21e 3231 s = force_word(s,WORD,FALSE,TRUE,FALSE);
378cc40b 3232 OPERATOR(DO);
79072805
LW		 3233
3234 case KEY_die:
a0d0e21e
LW		 3235 hints |= HINT_BLOCK_SCOPE;
3236 LOP(OP_DIE,XTERM);
79072805
LW		 3237
3238 case KEY_defined:
3239 UNI(OP_DEFINED);
3240
3241 case KEY_delete:
a0d0e21e 3242 UNI(OP_DELETE);
79072805
LW		 3243
3244 case KEY_dbmopen:
a0d0e21e
LW		 3245 gv_fetchpv("AnyDBM_File::ISA", GV_ADDMULTI, SVt_PVAV);
3246 LOP(OP_DBMOPEN,XTERM);
79072805
LW		 3247
3248 case KEY_dbmclose:
3249 UNI(OP_DBMCLOSE);
3250
3251 case KEY_dump:
a0d0e21e 3252 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3253 LOOPX(OP_DUMP);
3254
3255 case KEY_else:
3256 PREBLOCK(ELSE);
3257
3258 case KEY_elsif:
3259 yylval.ival = curcop->cop_line;
3260 OPERATOR(ELSIF);
3261
3262 case KEY_eq:
3263 Eop(OP_SEQ);
3264
a0d0e21e
LW		 3265 case KEY_exists:
3266 UNI(OP_EXISTS);
3267
79072805
LW		 3268 case KEY_exit:
3269 UNI(OP_EXIT);
3270
3271 case KEY_eval:
79072805 3272 s = skipspace(s);
a0d0e21e 3273 expect = (*s == '{') ? XTERMBLOCK : XTERM;
463ee0b2 3274 UNIBRACK(OP_ENTEREVAL);
79072805
LW		 3275
3276 case KEY_eof:
3277 UNI(OP_EOF);
3278
3279 case KEY_exp:
3280 UNI(OP_EXP);
3281
3282 case KEY_each:
3283 UNI(OP_EACH);
3284
3285 case KEY_exec:
3286 set_csh();
a0d0e21e 3287 LOP(OP_EXEC,XREF);
79072805
LW		 3288
3289 case KEY_endhostent:
3290 FUN0(OP_EHOSTENT);
3291
3292 case KEY_endnetent:
3293 FUN0(OP_ENETENT);
3294
3295 case KEY_endservent:
3296 FUN0(OP_ESERVENT);
3297
3298 case KEY_endprotoent:
3299 FUN0(OP_EPROTOENT);
3300
3301 case KEY_endpwent:
3302 FUN0(OP_EPWENT);
3303
3304 case KEY_endgrent:
3305 FUN0(OP_EGRENT);
3306
3307 case KEY_for:
3308 case KEY_foreach:
3309 yylval.ival = curcop->cop_line;
55497cff 3310 s = skipspace(s);
ecca16b0 3311 if (expect == XSTATE && isIDFIRST(*s)) {
55497cff 3312 char *p = s;
3313 if ((bufend - p) >= 3 &&
3314 strnEQ(p, "my", 2) && isSPACE(*(p + 2)))
3315 p += 2;
3316 p = skipspace(p);
3317 if (isIDFIRST(*p))
3318 croak("Missing $ on loop variable");
3319 }
79072805
LW		 3320 OPERATOR(FOR);
3321
3322 case KEY_formline:
a0d0e21e 3323 LOP(OP_FORMLINE,XTERM);
79072805
LW		 3324
3325 case KEY_fork:
3326 FUN0(OP_FORK);
3327
3328 case KEY_fcntl:
a0d0e21e 3329 LOP(OP_FCNTL,XTERM);
79072805
LW		 3330
3331 case KEY_fileno:
3332 UNI(OP_FILENO);
3333
3334 case KEY_flock:
a0d0e21e 3335 LOP(OP_FLOCK,XTERM);
79072805
LW		 3336
3337 case KEY_gt:
3338 Rop(OP_SGT);
3339
3340 case KEY_ge:
3341 Rop(OP_SGE);
3342
3343 case KEY_grep:
a0d0e21e 3344 LOP(OP_GREPSTART, *s == '(' ? XTERM : XREF);
79072805
LW		 3345
3346 case KEY_goto:
a0d0e21e 3347 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3348 LOOPX(OP_GOTO);
3349
3350 case KEY_gmtime:
3351 UNI(OP_GMTIME);
3352
3353 case KEY_getc:
3354 UNI(OP_GETC);
3355
3356 case KEY_getppid:
3357 FUN0(OP_GETPPID);
3358
3359 case KEY_getpgrp:
3360 UNI(OP_GETPGRP);
3361
3362 case KEY_getpriority:
a0d0e21e 3363 LOP(OP_GETPRIORITY,XTERM);
79072805
LW		 3364
3365 case KEY_getprotobyname:
3366 UNI(OP_GPBYNAME);
3367
3368 case KEY_getprotobynumber:
a0d0e21e 3369 LOP(OP_GPBYNUMBER,XTERM);
79072805
LW		 3370
3371 case KEY_getprotoent:
3372 FUN0(OP_GPROTOENT);
3373
3374 case KEY_getpwent:
3375 FUN0(OP_GPWENT);
3376
3377 case KEY_getpwnam:
ff68c719 3378 UNI(OP_GPWNAM);
79072805
LW		 3379
3380 case KEY_getpwuid:
ff68c719 3381 UNI(OP_GPWUID);
79072805
LW		 3382
3383 case KEY_getpeername:
3384 UNI(OP_GETPEERNAME);
3385
3386 case KEY_gethostbyname:
3387 UNI(OP_GHBYNAME);
3388
3389 case KEY_gethostbyaddr:
a0d0e21e 3390 LOP(OP_GHBYADDR,XTERM);
79072805
LW		 3391
3392 case KEY_gethostent:
3393 FUN0(OP_GHOSTENT);
3394
3395 case KEY_getnetbyname:
3396 UNI(OP_GNBYNAME);
3397
3398 case KEY_getnetbyaddr:
a0d0e21e 3399 LOP(OP_GNBYADDR,XTERM);
79072805
LW		 3400
3401 case KEY_getnetent:
3402 FUN0(OP_GNETENT);
3403
3404 case KEY_getservbyname:
a0d0e21e 3405 LOP(OP_GSBYNAME,XTERM);
79072805
LW		 3406
3407 case KEY_getservbyport:
a0d0e21e 3408 LOP(OP_GSBYPORT,XTERM);
79072805
LW		 3409
3410 case KEY_getservent:
3411 FUN0(OP_GSERVENT);
3412
3413 case KEY_getsockname:
3414 UNI(OP_GETSOCKNAME);
3415
3416 case KEY_getsockopt:
a0d0e21e 3417 LOP(OP_GSOCKOPT,XTERM);
79072805
LW		 3418
3419 case KEY_getgrent:
3420 FUN0(OP_GGRENT);
3421
3422 case KEY_getgrnam:
ff68c719 3423 UNI(OP_GGRNAM);
79072805
LW		 3424
3425 case KEY_getgrgid:
ff68c719 3426 UNI(OP_GGRGID);
79072805
LW		 3427
3428 case KEY_getlogin:
3429 FUN0(OP_GETLOGIN);
3430
93a17b20 3431 case KEY_glob:
a0d0e21e
LW		 3432 set_csh();
3433 LOP(OP_GLOB,XTERM);
93a17b20 3434
79072805
LW		 3435 case KEY_hex:
3436 UNI(OP_HEX);
3437
3438 case KEY_if:
3439 yylval.ival = curcop->cop_line;
3440 OPERATOR(IF);
3441
3442 case KEY_index:
a0d0e21e 3443 LOP(OP_INDEX,XTERM);
79072805
LW		 3444
3445 case KEY_int:
3446 UNI(OP_INT);
3447
3448 case KEY_ioctl:
a0d0e21e 3449 LOP(OP_IOCTL,XTERM);
79072805
LW		 3450
3451 case KEY_join:
a0d0e21e 3452 LOP(OP_JOIN,XTERM);
79072805
LW		 3453
3454 case KEY_keys:
3455 UNI(OP_KEYS);
3456
3457 case KEY_kill:
a0d0e21e 3458 LOP(OP_KILL,XTERM);
79072805
LW		 3459
3460 case KEY_last:
a0d0e21e 3461 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805 3462 LOOPX(OP_LAST);
a0d0e21e 3463
79072805
LW		 3464 case KEY_lc:
3465 UNI(OP_LC);
3466
3467 case KEY_lcfirst:
3468 UNI(OP_LCFIRST);
3469
3470 case KEY_local:
3471 OPERATOR(LOCAL);
3472
3473 case KEY_length:
3474 UNI(OP_LENGTH);
3475
3476 case KEY_lt:
3477 Rop(OP_SLT);
3478
3479 case KEY_le:
3480 Rop(OP_SLE);
3481
3482 case KEY_localtime:
3483 UNI(OP_LOCALTIME);
3484
3485 case KEY_log:
3486 UNI(OP_LOG);
3487
3488 case KEY_link:
a0d0e21e 3489 LOP(OP_LINK,XTERM);
79072805
LW		 3490
3491 case KEY_listen:
a0d0e21e 3492 LOP(OP_LISTEN,XTERM);
79072805 3493
c0329465
MB		 3494 case KEY_lock:
3495 UNI(OP_LOCK);
3496
79072805
LW		 3497 case KEY_lstat:
3498 UNI(OP_LSTAT);
3499
3500 case KEY_m:
3501 s = scan_pat(s);
3502 TERM(sublex_start());
3503
a0d0e21e
LW		 3504 case KEY_map:
3505 LOP(OP_MAPSTART,XREF);
3506
79072805 3507 case KEY_mkdir:
a0d0e21e 3508 LOP(OP_MKDIR,XTERM);
79072805
LW		 3509
3510 case KEY_msgctl:
a0d0e21e 3511 LOP(OP_MSGCTL,XTERM);
79072805
LW		 3512
3513 case KEY_msgget:
a0d0e21e 3514 LOP(OP_MSGGET,XTERM);
79072805
LW		 3515
3516 case KEY_msgrcv:
a0d0e21e 3517 LOP(OP_MSGRCV,XTERM);
79072805
LW		 3518
3519 case KEY_msgsnd:
a0d0e21e 3520 LOP(OP_MSGSND,XTERM);
79072805 3521
93a17b20
LW		 3522 case KEY_my:
3523 in_my = TRUE;
c750a3ec
MB		 3524 s = skipspace(s);
3525 if (isIDFIRST(*s)) {
97fcbf96 3526 s = scan_word(s, tokenbuf, sizeof tokenbuf, TRUE, &len);
c750a3ec
MB		 3527 in_my_stash = gv_stashpv(tokenbuf, FALSE);
3528 if (!in_my_stash) {
3529 char tmpbuf[1024];
3530 bufptr = s;
3531 sprintf(tmpbuf, "No such class %.1000s", tokenbuf);
3532 yyerror(tmpbuf);
3533 }
3534 }
55497cff 3535 OPERATOR(MY);
93a17b20 3536
79072805 3537 case KEY_next:
a0d0e21e 3538 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3539 LOOPX(OP_NEXT);
3540
3541 case KEY_ne:
3542 Eop(OP_SNE);
3543
a0d0e21e
LW		 3544 case KEY_no:
3545 if (expect != XSTATE)
3546 yyerror("\"no\" not allowed in expression");
3547 s = force_word(s,WORD,FALSE,TRUE,FALSE);
89bfa8cd 3548 s = force_version(s);
a0d0e21e
LW		 3549 yylval.ival = 0;
3550 OPERATOR(USE);
3551
3552 case KEY_not:
3553 OPERATOR(NOTOP);
3554
79072805 3555 case KEY_open:
93a17b20
LW		 3556 s = skipspace(s);
3557 if (isIDFIRST(*s)) {
3558 char *t;
3559 for (d = s; isALNUM(*d); d++) ;
3560 t = skipspace(d);
3561 if (strchr("|&*+-=!?:.", *t))
3562 warn("Precedence problem: open %.*s should be open(%.*s)",
3563 d-s,s, d-s,s);
3564 }
a0d0e21e 3565 LOP(OP_OPEN,XTERM);
79072805 3566
463ee0b2 3567 case KEY_or:
a0d0e21e 3568 yylval.ival = OP_OR;
463ee0b2
LW		 3569 OPERATOR(OROP);
3570
79072805
LW		 3571 case KEY_ord:
3572 UNI(OP_ORD);
3573
3574 case KEY_oct:
3575 UNI(OP_OCT);
3576
3577 case KEY_opendir:
a0d0e21e 3578 LOP(OP_OPEN_DIR,XTERM);
79072805
LW		 3579
3580 case KEY_print:
3581 checkcomma(s,tokenbuf,"filehandle");
a0d0e21e 3582 LOP(OP_PRINT,XREF);
79072805
LW		 3583
3584 case KEY_printf:
3585 checkcomma(s,tokenbuf,"filehandle");
a0d0e21e 3586 LOP(OP_PRTF,XREF);
79072805 3587
c07a80fd 3588 case KEY_prototype:
3589 UNI(OP_PROTOTYPE);
3590
79072805 3591 case KEY_push:
a0d0e21e 3592 LOP(OP_PUSH,XTERM);
79072805
LW		 3593
3594 case KEY_pop:
3595 UNI(OP_POP);
3596
a0d0e21e
LW		 3597 case KEY_pos:
3598 UNI(OP_POS);
3599
79072805 3600 case KEY_pack:
a0d0e21e 3601 LOP(OP_PACK,XTERM);
79072805
LW		 3602
3603 case KEY_package:
a0d0e21e 3604 s = force_word(s,WORD,FALSE,TRUE,FALSE);
79072805
LW		 3605 OPERATOR(PACKAGE);
3606
3607 case KEY_pipe:
a0d0e21e 3608 LOP(OP_PIPE_OP,XTERM);
79072805
LW		 3609
3610 case KEY_q:
3611 s = scan_str(s);
3612 if (!s)
85e6fe83 3613 missingterm((char*)0);
79072805
LW		 3614 yylval.ival = OP_CONST;
3615 TERM(sublex_start());
3616
a0d0e21e
LW		 3617 case KEY_quotemeta:
3618 UNI(OP_QUOTEMETA);
3619
8990e307
LW		 3620 case KEY_qw:
3621 s = scan_str(s);
3622 if (!s)
85e6fe83 3623 missingterm((char*)0);
55497cff 3624 if (dowarn && SvLEN(lex_stuff)) {
3625 d = SvPV_force(lex_stuff, len);
3626 for (; len; --len, ++d) {
3627 if (*d == ',') {
3628 warn("Possible attempt to separate words with commas");
3629 break;
3630 }
3631 if (*d == '#') {
3632 warn("Possible attempt to put comments in qw() list");
3633 break;
3634 }
3635 }
3636 }
8990e307 3637 force_next(')');
76e3520e 3638 nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, tokeq(lex_stuff));
8990e307
LW		 3639 lex_stuff = Nullsv;
3640 force_next(THING);
3641 force_next(',');
3642 nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(" ",1));
3643 force_next(THING);
3644 force_next('(');
a0d0e21e
LW		 3645 yylval.ival = OP_SPLIT;
3646 CLINE;
3647 expect = XTERM;
3648 bufptr = s;
3649 last_lop = oldbufptr;
3650 last_lop_op = OP_SPLIT;
3651 return FUNC;
8990e307 3652
79072805
LW		 3653 case KEY_qq:
3654 s = scan_str(s);
3655 if (!s)
85e6fe83 3656 missingterm((char*)0);
a0d0e21e 3657 yylval.ival = OP_STRINGIFY;
ed6116ce
LW		 3658 if (SvIVX(lex_stuff) == '\'')
3659 SvIVX(lex_stuff) = 0; /* qq'$foo' should intepolate */
79072805
LW		 3660 TERM(sublex_start());
3661
3662 case KEY_qx:
3663 s = scan_str(s);
3664 if (!s)
85e6fe83 3665 missingterm((char*)0);
79072805
LW		 3666 yylval.ival = OP_BACKTICK;
3667 set_csh();
3668 TERM(sublex_start());
3669
3670 case KEY_return:
3671 OLDLOP(OP_RETURN);
3672
3673 case KEY_require:
748a9306 3674 *tokenbuf = '\0';
a0d0e21e 3675 s = force_word(s,WORD,TRUE,TRUE,FALSE);
748a9306 3676 if (isIDFIRST(*tokenbuf))
89bfa8cd 3677 gv_stashpvn(tokenbuf, strlen(tokenbuf), TRUE);
748a9306 3678 else if (*s == '<')
a0d0e21e 3679 yyerror("<> should be quotes");
463ee0b2 3680 UNI(OP_REQUIRE);
79072805
LW		 3681
3682 case KEY_reset:
3683 UNI(OP_RESET);
3684
3685 case KEY_redo:
a0d0e21e 3686 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3687 LOOPX(OP_REDO);
3688
3689 case KEY_rename:
a0d0e21e 3690 LOP(OP_RENAME,XTERM);
79072805
LW		 3691
3692 case KEY_rand:
3693 UNI(OP_RAND);
3694
3695 case KEY_rmdir:
3696 UNI(OP_RMDIR);
3697
3698 case KEY_rindex:
a0d0e21e 3699 LOP(OP_RINDEX,XTERM);
79072805
LW		 3700
3701 case KEY_read:
a0d0e21e 3702 LOP(OP_READ,XTERM);
79072805
LW		 3703
3704 case KEY_readdir:
3705 UNI(OP_READDIR);
3706
93a17b20
LW		 3707 case KEY_readline:
3708 set_csh();
3709 UNI(OP_READLINE);
3710
3711 case KEY_readpipe:
3712 set_csh();
3713 UNI(OP_BACKTICK);
3714
79072805
LW		 3715 case KEY_rewinddir:
3716 UNI(OP_REWINDDIR);
3717
3718 case KEY_recv:
a0d0e21e 3719 LOP(OP_RECV,XTERM);
79072805
LW		 3720
3721 case KEY_reverse:
a0d0e21e 3722 LOP(OP_REVERSE,XTERM);
79072805
LW		 3723
3724 case KEY_readlink:
3725 UNI(OP_READLINK);
3726
3727 case KEY_ref:
3728 UNI(OP_REF);
3729
3730 case KEY_s:
3731 s = scan_subst(s);
3732 if (yylval.opval)
3733 TERM(sublex_start());
3734 else
3735 TOKEN(1); /* force error */
3736
a0d0e21e
LW		 3737 case KEY_chomp:
3738 UNI(OP_CHOMP);
3739
79072805
LW		 3740 case KEY_scalar:
3741 UNI(OP_SCALAR);
3742
3743 case KEY_select:
a0d0e21e 3744 LOP(OP_SELECT,XTERM);
79072805
LW		 3745
3746 case KEY_seek:
a0d0e21e 3747 LOP(OP_SEEK,XTERM);
79072805
LW		 3748
3749 case KEY_semctl:
a0d0e21e 3750 LOP(OP_SEMCTL,XTERM);
79072805
LW		 3751
3752 case KEY_semget:
a0d0e21e 3753 LOP(OP_SEMGET,XTERM);
79072805
LW		 3754
3755 case KEY_semop:
a0d0e21e 3756 LOP(OP_SEMOP,XTERM);
79072805
LW		 3757
3758 case KEY_send:
a0d0e21e 3759 LOP(OP_SEND,XTERM);
79072805
LW		 3760
3761 case KEY_setpgrp:
a0d0e21e 3762 LOP(OP_SETPGRP,XTERM);
79072805
LW		 3763
3764 case KEY_setpriority:
a0d0e21e 3765 LOP(OP_SETPRIORITY,XTERM);
79072805
LW		 3766
3767 case KEY_sethostent:
ff68c719 3768 UNI(OP_SHOSTENT);
79072805
LW		 3769
3770 case KEY_setnetent:
ff68c719 3771 UNI(OP_SNETENT);
79072805
LW		 3772
3773 case KEY_setservent:
ff68c719 3774 UNI(OP_SSERVENT);
79072805
LW		 3775
3776 case KEY_setprotoent:
ff68c719 3777 UNI(OP_SPROTOENT);
79072805
LW		 3778
3779 case KEY_setpwent:
3780 FUN0(OP_SPWENT);
3781
3782 case KEY_setgrent:
3783 FUN0(OP_SGRENT);
3784
3785 case KEY_seekdir:
a0d0e21e 3786 LOP(OP_SEEKDIR,XTERM);
79072805
LW		 3787
3788 case KEY_setsockopt:
a0d0e21e 3789 LOP(OP_SSOCKOPT,XTERM);
79072805
LW		 3790
3791 case KEY_shift:
3792 UNI(OP_SHIFT);
3793
3794 case KEY_shmctl:
a0d0e21e 3795 LOP(OP_SHMCTL,XTERM);
79072805
LW		 3796
3797 case KEY_shmget:
a0d0e21e 3798 LOP(OP_SHMGET,XTERM);
79072805
LW		 3799
3800 case KEY_shmread:
a0d0e21e 3801 LOP(OP_SHMREAD,XTERM);
79072805
LW		 3802
3803 case KEY_shmwrite:
a0d0e21e 3804 LOP(OP_SHMWRITE,XTERM);
79072805
LW		 3805
3806 case KEY_shutdown:
a0d0e21e 3807 LOP(OP_SHUTDOWN,XTERM);
79072805
LW		 3808
3809 case KEY_sin:
3810 UNI(OP_SIN);
3811
3812 case KEY_sleep:
3813 UNI(OP_SLEEP);
3814
3815 case KEY_socket:
a0d0e21e 3816 LOP(OP_SOCKET,XTERM);
79072805
LW		 3817
3818 case KEY_socketpair:
a0d0e21e 3819 LOP(OP_SOCKPAIR,XTERM);
79072805
LW		 3820
3821 case KEY_sort:
3822 checkcomma(s,tokenbuf,"subroutine name");
3823 s = skipspace(s);
3824 if (*s == ';' || *s == ')') /* probably a close */
463ee0b2
LW		 3825 croak("sort is now a reserved word");
3826 expect = XTERM;
15f0808c 3827 s = force_word(s,WORD,TRUE,TRUE,FALSE);
a0d0e21e 3828 LOP(OP_SORT,XREF);
79072805
LW		 3829
3830 case KEY_split:
a0d0e21e 3831 LOP(OP_SPLIT,XTERM);
79072805
LW		 3832
3833 case KEY_sprintf:
a0d0e21e 3834 LOP(OP_SPRINTF,XTERM);
79072805
LW		 3835
3836 case KEY_splice:
a0d0e21e 3837 LOP(OP_SPLICE,XTERM);
79072805
LW		 3838
3839 case KEY_sqrt:
3840 UNI(OP_SQRT);
3841
3842 case KEY_srand:
3843 UNI(OP_SRAND);
3844
3845 case KEY_stat:
3846 UNI(OP_STAT);
3847
3848 case KEY_study:
3849 sawstudy++;
3850 UNI(OP_STUDY);
3851
3852 case KEY_substr:
a0d0e21e 3853 LOP(OP_SUBSTR,XTERM);
79072805
LW		 3854
3855 case KEY_format:
3856 case KEY_sub:
93a17b20 3857 really_sub:
79072805 3858 s = skipspace(s);
4633a7c4 3859
463ee0b2 3860 if (isIDFIRST(*s) || *s == '\'' || *s == ':') {
8903cb82 3861 char tmpbuf[sizeof tokenbuf];
4633a7c4 3862 expect = XBLOCK;
8903cb82 3863 d = scan_word(s, tmpbuf, sizeof tmpbuf, TRUE, &len);
463ee0b2
LW		 3864 if (strchr(tmpbuf, ':'))
3865 sv_setpv(subname, tmpbuf);
3866 else {
3867 sv_setsv(subname,curstname);
8990e307 3868 sv_catpvn(subname,"::",2);
463ee0b2
LW		 3869 sv_catpvn(subname,tmpbuf,len);
3870 }
a0d0e21e 3871 s = force_word(s,WORD,FALSE,TRUE,TRUE);
4633a7c4 3872 s = skipspace(s);
79072805 3873 }
4633a7c4
LW		 3874 else {
3875 expect = XTERMBLOCK;
79072805 3876 sv_setpv(subname,"?");
4633a7c4
LW		 3877 }
3878
3879 if (tmp == KEY_format) {
3880 s = skipspace(s);
3881 if (*s == '=')
3882 lex_formbrack = lex_brackets + 1;
3883 OPERATOR(FORMAT);
3884 }
79072805 3885
4633a7c4
LW		 3886 /* Look for a prototype */
3887 if (*s == '(') {
68dc0745 3888 char *p;
3889
4633a7c4
LW		 3890 s = scan_str(s);
3891 if (!s) {
3892 if (lex_stuff)
3893 SvREFCNT_dec(lex_stuff);
3894 lex_stuff = Nullsv;
3895 croak("Prototype not terminated");
3896 }
68dc0745 3897 /* strip spaces */
3898 d = SvPVX(lex_stuff);
3899 tmp = 0;
3900 for (p = d; *p; ++p) {
3901 if (!isSPACE(*p))
3902 d[tmp++] = *p;
3903 }
3904 d[tmp] = '\0';
3905 SvCUR(lex_stuff) = tmp;
3906
4633a7c4
LW		 3907 nexttoke++;
3908 nextval[1] = nextval[0];
3909 nexttype[1] = nexttype[0];
3910 nextval[0].opval = (OP*)newSVOP(OP_CONST, 0, lex_stuff);
3911 nexttype[0] = THING;
3912 if (nexttoke == 1) {
3913 lex_defer = lex_state;
3914 lex_expect = expect;
3915 lex_state = LEX_KNOWNEXT;
3916 }
3917 lex_stuff = Nullsv;
3918 }
79072805 3919
4633a7c4
LW		 3920 if (*SvPV(subname,na) == '?') {
3921 sv_setpv(subname,"__ANON__");
3922 TOKEN(ANONSUB);
3923 }
3924 PREBLOCK(SUB);
79072805
LW		 3925
3926 case KEY_system:
3927 set_csh();
a0d0e21e 3928 LOP(OP_SYSTEM,XREF);
79072805
LW		 3929
3930 case KEY_symlink:
a0d0e21e 3931 LOP(OP_SYMLINK,XTERM);
79072805
LW		 3932
3933 case KEY_syscall:
a0d0e21e 3934 LOP(OP_SYSCALL,XTERM);
79072805 3935
c07a80fd 3936 case KEY_sysopen:
3937 LOP(OP_SYSOPEN,XTERM);
3938
137443ea 3939 case KEY_sysseek:
3940 LOP(OP_SYSSEEK,XTERM);
3941
79072805 3942 case KEY_sysread:
a0d0e21e 3943 LOP(OP_SYSREAD,XTERM);
79072805
LW		 3944
3945 case KEY_syswrite:
a0d0e21e 3946 LOP(OP_SYSWRITE,XTERM);
79072805
LW		 3947
3948 case KEY_tr:
3949 s = scan_trans(s);
3950 TERM(sublex_start());
3951
3952 case KEY_tell:
3953 UNI(OP_TELL);
3954
3955 case KEY_telldir:
3956 UNI(OP_TELLDIR);
3957
463ee0b2 3958 case KEY_tie:
a0d0e21e 3959 LOP(OP_TIE,XTERM);
463ee0b2 3960
c07a80fd 3961 case KEY_tied:
3962 UNI(OP_TIED);
3963
79072805
LW		 3964 case KEY_time:
3965 FUN0(OP_TIME);
3966
3967 case KEY_times:
3968 FUN0(OP_TMS);
3969
3970 case KEY_truncate:
a0d0e21e 3971 LOP(OP_TRUNCATE,XTERM);
79072805
LW		 3972
3973 case KEY_uc:
3974 UNI(OP_UC);
3975
3976 case KEY_ucfirst:
3977 UNI(OP_UCFIRST);
3978
463ee0b2
LW		 3979 case KEY_untie:
3980 UNI(OP_UNTIE);
3981
79072805
LW		 3982 case KEY_until:
3983 yylval.ival = curcop->cop_line;
3984 OPERATOR(UNTIL);
3985
3986 case KEY_unless:
3987 yylval.ival = curcop->cop_line;
3988 OPERATOR(UNLESS);
3989
3990 case KEY_unlink:
a0d0e21e 3991 LOP(OP_UNLINK,XTERM);
79072805
LW		 3992
3993 case KEY_undef:
3994 UNI(OP_UNDEF);
3995
3996 case KEY_unpack:
a0d0e21e 3997 LOP(OP_UNPACK,XTERM);
79072805
LW		 3998
3999 case KEY_utime:
a0d0e21e 4000 LOP(OP_UTIME,XTERM);
79072805
LW		 4001
4002 case KEY_umask:
748a9306
LW		 4003 if (dowarn) {
4004 for (d = s; d < bufend && (isSPACE(*d) || *d == '('); d++) ;
4005 if (*d != '0' && isDIGIT(*d))
4006 yywarn("umask: argument is missing initial 0");
4007 }
79072805
LW		 4008 UNI(OP_UMASK);
4009
4010 case KEY_unshift:
a0d0e21e
LW		 4011 LOP(OP_UNSHIFT,XTERM);
4012
4013 case KEY_use:
4014 if (expect != XSTATE)
4015 yyerror("\"use\" not allowed in expression");
89bfa8cd 4016 s = skipspace(s);
4017 if(isDIGIT(*s)) {
4018 s = force_version(s);
4019 if(*s == ';' || (s = skipspace(s), *s == ';')) {
4020 nextval[nexttoke].opval = Nullop;
4021 force_next(WORD);
4022 }
4023 }
4024 else {
4025 s = force_word(s,WORD,FALSE,TRUE,FALSE);
4026 s = force_version(s);
4027 }
a0d0e21e
LW		 4028 yylval.ival = 1;
4029 OPERATOR(USE);
79072805
LW		 4030
4031 case KEY_values:
4032 UNI(OP_VALUES);
4033
4034 case KEY_vec:
4035 sawvec = TRUE;
a0d0e21e 4036 LOP(OP_VEC,XTERM);
79072805
LW		 4037
4038 case KEY_while:
4039 yylval.ival = curcop->cop_line;
4040 OPERATOR(WHILE);
4041
4042 case KEY_warn:
a0d0e21e
LW		 4043 hints |= HINT_BLOCK_SCOPE;
4044 LOP(OP_WARN,XTERM);
79072805
LW		 4045
4046 case KEY_wait:
4047 FUN0(OP_WAIT);
4048
4049 case KEY_waitpid:
a0d0e21e 4050 LOP(OP_WAITPID,XTERM);
79072805
LW		 4051
4052 case KEY_wantarray:
4053 FUN0(OP_WANTARRAY);
4054
4055 case KEY_write:
85e6fe83 4056 gv_fetchpv("\f",TRUE, SVt_PV); /* Make sure $^L is defined */
79072805
LW		 4057 UNI(OP_ENTERWRITE);
4058
4059 case KEY_x:
4060 if (expect == XOPERATOR)
4061 Mop(OP_REPEAT);
4062 check_uni();
4063 goto just_a_word;
4064
a0d0e21e
LW		 4065 case KEY_xor:
4066 yylval.ival = OP_XOR;
4067 OPERATOR(OROP);
4068
79072805
LW		 4069 case KEY_y:
4070 s = scan_trans(s);
4071 TERM(sublex_start());
4072 }
49dc05e3 4073 }}
79072805
LW		 4074}
4075
4076I32
8ac85365 4077keyword(register char *d, I32 len)
79072805
LW		 4078{
4079 switch (*d) {
4080 case '_':
4081 if (d[1] == '_') {
a0d0e21e 4082 if (strEQ(d,"__FILE__")) return -KEY___FILE__;
68dc0745 4083 if (strEQ(d,"__LINE__")) return -KEY___LINE__;
4084 if (strEQ(d,"__PACKAGE__")) return -KEY___PACKAGE__;
e50aee73 4085 if (strEQ(d,"__DATA__")) return KEY___DATA__;
79072805
LW		 4086 if (strEQ(d,"__END__")) return KEY___END__;
4087 }
4088 break;
8990e307
LW		 4089 case 'A':
4090 if (strEQ(d,"AUTOLOAD")) return KEY_AUTOLOAD;
4091 break;
79072805 4092 case 'a':
463ee0b2
LW		 4093 switch (len) {
4094 case 3:
a0d0e21e
LW		 4095 if (strEQ(d,"and")) return -KEY_and;
4096 if (strEQ(d,"abs")) return -KEY_abs;
85e6fe83 4097 break;
463ee0b2 4098 case 5:
a0d0e21e
LW		 4099 if (strEQ(d,"alarm")) return -KEY_alarm;
4100 if (strEQ(d,"atan2")) return -KEY_atan2;
463ee0b2
LW		 4101 break;
4102 case 6:
a0d0e21e 4103 if (strEQ(d,"accept")) return -KEY_accept;
463ee0b2
LW		 4104 break;
4105 }
79072805
LW		 4106 break;
4107 case 'B':
4108 if (strEQ(d,"BEGIN")) return KEY_BEGIN;
93a17b20 4109 break;
79072805 4110 case 'b':
a0d0e21e
LW		 4111 if (strEQ(d,"bless")) return -KEY_bless;
4112 if (strEQ(d,"bind")) return -KEY_bind;
4113 if (strEQ(d,"binmode")) return -KEY_binmode;
4114 break;
4115 case 'C':
4116 if (strEQ(d,"CORE")) return -KEY_CORE;
79072805
LW		 4117 break;
4118 case 'c':
4119 switch (len) {
4120 case 3:
a0d0e21e
LW		 4121 if (strEQ(d,"cmp")) return -KEY_cmp;
4122 if (strEQ(d,"chr")) return -KEY_chr;
4123 if (strEQ(d,"cos")) return -KEY_cos;
79072805
LW		 4124 break;
4125 case 4:
4126 if (strEQ(d,"chop")) return KEY_chop;
4127 break;
4128 case 5:
a0d0e21e
LW		 4129 if (strEQ(d,"close")) return -KEY_close;
4130 if (strEQ(d,"chdir")) return -KEY_chdir;
4131 if (strEQ(d,"chomp")) return KEY_chomp;
4132 if (strEQ(d,"chmod")) return -KEY_chmod;
4133 if (strEQ(d,"chown")) return -KEY_chown;
4134 if (strEQ(d,"crypt")) return -KEY_crypt;
79072805
LW		 4135 break;
4136 case 6:
a0d0e21e
LW		 4137 if (strEQ(d,"chroot")) return -KEY_chroot;
4138 if (strEQ(d,"caller")) return -KEY_caller;
79072805
LW		 4139 break;
4140 case 7:
a0d0e21e 4141 if (strEQ(d,"connect")) return -KEY_connect;
79072805
LW		 4142 break;
4143 case 8:
a0d0e21e
LW		 4144 if (strEQ(d,"closedir")) return -KEY_closedir;
4145 if (strEQ(d,"continue")) return -KEY_continue;
79072805
LW		 4146 break;
4147 }
4148 break;
ed6116ce
LW		 4149 case 'D':
4150 if (strEQ(d,"DESTROY")) return KEY_DESTROY;
4151 break;
79072805
LW		 4152 case 'd':
4153 switch (len) {
4154 case 2:
4155 if (strEQ(d,"do")) return KEY_do;
4156 break;
4157 case 3:
a0d0e21e 4158 if (strEQ(d,"die")) return -KEY_die;
79072805
LW		 4159 break;
4160 case 4:
a0d0e21e 4161 if (strEQ(d,"dump")) return -KEY_dump;
79072805
LW		 4162 break;
4163 case 6:
4164 if (strEQ(d,"delete")) return KEY_delete;
4165 break;
4166 case 7:
4167 if (strEQ(d,"defined")) return KEY_defined;
a0d0e21e 4168 if (strEQ(d,"dbmopen")) return -KEY_dbmopen;
79072805
LW		 4169 break;
4170 case 8:
a0d0e21e 4171 if (strEQ(d,"dbmclose")) return -KEY_dbmclose;
79072805
LW		 4172 break;
4173 }
4174 break;
4175 case 'E':
a0d0e21e 4176 if (strEQ(d,"EQ")) { deprecate(d); return -KEY_eq;}
79072805
LW		 4177 if (strEQ(d,"END")) return KEY_END;
4178 break;
4179 case 'e':
4180 switch (len) {
4181 case 2:
a0d0e21e 4182 if (strEQ(d,"eq")) return -KEY_eq;
79072805
LW		 4183 break;
4184 case 3:
a0d0e21e
LW		 4185 if (strEQ(d,"eof")) return -KEY_eof;
4186 if (strEQ(d,"exp")) return -KEY_exp;
79072805
LW		 4187 break;
4188 case 4:
4189 if (strEQ(d,"else")) return KEY_else;
a0d0e21e 4190 if (strEQ(d,"exit")) return -KEY_exit;
79072805 4191 if (strEQ(d,"eval")) return KEY_eval;
a0d0e21e 4192 if (strEQ(d,"exec")) return -KEY_exec;
79072805
LW		 4193 if (strEQ(d,"each")) return KEY_each;
4194 break;
4195 case 5:
4196 if (strEQ(d,"elsif")) return KEY_elsif;
4197 break;
a0d0e21e
LW		 4198 case 6:
4199 if (strEQ(d,"exists")) return KEY_exists;
4633a7c4 4200 if (strEQ(d,"elseif")) warn("elseif should be elsif");
a0d0e21e 4201 break;
79072805 4202 case 8:
a0d0e21e
LW		 4203 if (strEQ(d,"endgrent")) return -KEY_endgrent;
4204 if (strEQ(d,"endpwent")) return -KEY_endpwent;
79072805
LW		 4205 break;
4206 case 9:
a0d0e21e 4207 if (strEQ(d,"endnetent")) return -KEY_endnetent;
79072805
LW		 4208 break;
4209 case 10:
a0d0e21e
LW		 4210 if (strEQ(d,"endhostent")) return -KEY_endhostent;
4211 if (strEQ(d,"endservent")) return -KEY_endservent;
79072805
LW		 4212 break;
4213 case 11:
a0d0e21e 4214 if (strEQ(d,"endprotoent")) return -KEY_endprotoent;
79072805 4215 break;
a687059c 4216 }
a687059c 4217 break;
79072805
LW		 4218 case 'f':
4219 switch (len) {
4220 case 3:
4221 if (strEQ(d,"for")) return KEY_for;
4222 break;
4223 case 4:
a0d0e21e 4224 if (strEQ(d,"fork")) return -KEY_fork;
79072805
LW		 4225 break;
4226 case 5:
a0d0e21e
LW		 4227 if (strEQ(d,"fcntl")) return -KEY_fcntl;
4228 if (strEQ(d,"flock")) return -KEY_flock;
79072805
LW		 4229 break;
4230 case 6:
4231 if (strEQ(d,"format")) return KEY_format;
a0d0e21e 4232 if (strEQ(d,"fileno")) return -KEY_fileno;
79072805
LW		 4233 break;
4234 case 7:
4235 if (strEQ(d,"foreach")) return KEY_foreach;
4236 break;
4237 case 8:
a0d0e21e 4238 if (strEQ(d,"formline")) return -KEY_formline;
79072805 4239 break;
378cc40b 4240 }
a687059c 4241 break;
79072805
LW		 4242 case 'G':
4243 if (len == 2) {
a0d0e21e
LW		 4244 if (strEQ(d,"GT")) { deprecate(d); return -KEY_gt;}
4245 if (strEQ(d,"GE")) { deprecate(d); return -KEY_ge;}
9f68db38 4246 }
a687059c 4247 break;
79072805 4248 case 'g':
a687059c
LW		 4249 if (strnEQ(d,"get",3)) {
4250 d += 3;
4251 if (*d == 'p') {
79072805
LW		 4252 switch (len) {
4253 case 7:
a0d0e21e
LW		 4254 if (strEQ(d,"ppid")) return -KEY_getppid;
4255 if (strEQ(d,"pgrp")) return -KEY_getpgrp;
79072805
LW		 4256 break;
4257 case 8:
a0d0e21e
LW		 4258 if (strEQ(d,"pwent")) return -KEY_getpwent;
4259 if (strEQ(d,"pwnam")) return -KEY_getpwnam;
4260 if (strEQ(d,"pwuid")) return -KEY_getpwuid;
79072805
LW		 4261 break;
4262 case 11:
a0d0e21e
LW		 4263 if (strEQ(d,"peername")) return -KEY_getpeername;
4264 if (strEQ(d,"protoent")) return -KEY_getprotoent;
4265 if (strEQ(d,"priority")) return -KEY_getpriority;
79072805
LW		 4266 break;
4267 case 14:
a0d0e21e 4268 if (strEQ(d,"protobyname")) return -KEY_getprotobyname;
79072805
LW		 4269 break;
4270 case 16:
a0d0e21e 4271 if (strEQ(d,"protobynumber"))return -KEY_getprotobynumber;
79072805
LW		 4272 break;
4273 }
a687059c
LW		 4274 }
4275 else if (*d == 'h') {
a0d0e21e
LW		 4276 if (strEQ(d,"hostbyname")) return -KEY_gethostbyname;
4277 if (strEQ(d,"hostbyaddr")) return -KEY_gethostbyaddr;
4278 if (strEQ(d,"hostent")) return -KEY_gethostent;
a687059c
LW		 4279 }
4280 else if (*d == 'n') {
a0d0e21e
LW		 4281 if (strEQ(d,"netbyname")) return -KEY_getnetbyname;
4282 if (strEQ(d,"netbyaddr")) return -KEY_getnetbyaddr;
4283 if (strEQ(d,"netent")) return -KEY_getnetent;
a687059c
LW		 4284 }
4285 else if (*d == 's') {
a0d0e21e
LW		 4286 if (strEQ(d,"servbyname")) return -KEY_getservbyname;
4287 if (strEQ(d,"servbyport")) return -KEY_getservbyport;
4288 if (strEQ(d,"servent")) return -KEY_getservent;
4289 if (strEQ(d,"sockname")) return -KEY_getsockname;
4290 if (strEQ(d,"sockopt")) return -KEY_getsockopt;
a687059c
LW		 4291 }
4292 else if (*d == 'g') {
a0d0e21e
LW		 4293 if (strEQ(d,"grent")) return -KEY_getgrent;
4294 if (strEQ(d,"grnam")) return -KEY_getgrnam;
4295 if (strEQ(d,"grgid")) return -KEY_getgrgid;
a687059c
LW		 4296 }
4297 else if (*d == 'l') {
a0d0e21e 4298 if (strEQ(d,"login")) return -KEY_getlogin;
a687059c 4299 }
a0d0e21e 4300 else if (strEQ(d,"c")) return -KEY_getc;
79072805 4301 break;
a687059c 4302 }
79072805
LW		 4303 switch (len) {
4304 case 2:
a0d0e21e
LW		 4305 if (strEQ(d,"gt")) return -KEY_gt;
4306 if (strEQ(d,"ge")) return -KEY_ge;
79072805
LW		 4307 break;
4308 case 4:
4309 if (strEQ(d,"grep")) return KEY_grep;
4310 if (strEQ(d,"goto")) return KEY_goto;
fb73857a 4311 if (strEQ(d,"glob")) return KEY_glob;
79072805
LW		 4312 break;
4313 case 6:
a0d0e21e 4314 if (strEQ(d,"gmtime")) return -KEY_gmtime;
79072805 4315 break;
378cc40b 4316 }
a687059c 4317 break;
79072805 4318 case 'h':
a0d0e21e 4319 if (strEQ(d,"hex")) return -KEY_hex;
a687059c 4320 break;
7d07dbc2
MB		 4321 case 'I':
4322 if (strEQ(d,"INIT")) return KEY_INIT;
4323 break;
79072805
LW		 4324 case 'i':
4325 switch (len) {
4326 case 2:
4327 if (strEQ(d,"if")) return KEY_if;
4328 break;
4329 case 3:
a0d0e21e 4330 if (strEQ(d,"int")) return -KEY_int;
79072805
LW		 4331 break;
4332 case 5:
a0d0e21e
LW		 4333 if (strEQ(d,"index")) return -KEY_index;
4334 if (strEQ(d,"ioctl")) return -KEY_ioctl;
79072805
LW		 4335 break;
4336 }
a687059c 4337 break;
79072805 4338 case 'j':
a0d0e21e 4339 if (strEQ(d,"join")) return -KEY_join;
a687059c 4340 break;
79072805
LW		 4341 case 'k':
4342 if (len == 4) {
4343 if (strEQ(d,"keys")) return KEY_keys;
a0d0e21e 4344 if (strEQ(d,"kill")) return -KEY_kill;
663a0e37 4345 }
79072805
LW		 4346 break;
4347 case 'L':
4348 if (len == 2) {
a0d0e21e
LW		 4349 if (strEQ(d,"LT")) { deprecate(d); return -KEY_lt;}
4350 if (strEQ(d,"LE")) { deprecate(d); return -KEY_le;}
378cc40b 4351 }
79072805
LW		 4352 break;
4353 case 'l':
4354 switch (len) {
4355 case 2:
a0d0e21e
LW		 4356 if (strEQ(d,"lt")) return -KEY_lt;
4357 if (strEQ(d,"le")) return -KEY_le;
4358 if (strEQ(d,"lc")) return -KEY_lc;
79072805
LW		 4359 break;
4360 case 3:
a0d0e21e 4361 if (strEQ(d,"log")) return -KEY_log;
79072805
LW		 4362 break;
4363 case 4:
4364 if (strEQ(d,"last")) return KEY_last;
a0d0e21e 4365 if (strEQ(d,"link")) return -KEY_link;
c0329465 4366 if (strEQ(d,"lock")) return -KEY_lock;
395c3793 4367 break;
79072805
LW		 4368 case 5:
4369 if (strEQ(d,"local")) return KEY_local;
a0d0e21e 4370 if (strEQ(d,"lstat")) return -KEY_lstat;
79072805
LW		 4371 break;
4372 case 6:
a0d0e21e
LW		 4373 if (strEQ(d,"length")) return -KEY_length;
4374 if (strEQ(d,"listen")) return -KEY_listen;
79072805
LW		 4375 break;
4376 case 7:
a0d0e21e 4377 if (strEQ(d,"lcfirst")) return -KEY_lcfirst;
79072805
LW		 4378 break;
4379 case 9:
a0d0e21e 4380 if (strEQ(d,"localtime")) return -KEY_localtime;
395c3793
LW		 4381 break;
4382 }
a687059c 4383 break;
79072805
LW		 4384 case 'm':
4385 switch (len) {
4386 case 1: return KEY_m;
93a17b20
LW		 4387 case 2:
4388 if (strEQ(d,"my")) return KEY_my;
4389 break;
a0d0e21e
LW		 4390 case 3:
4391 if (strEQ(d,"map")) return KEY_map;
4392 break;
79072805 4393 case 5:
a0d0e21e 4394 if (strEQ(d,"mkdir")) return -KEY_mkdir;
79072805
LW		 4395 break;
4396 case 6:
a0d0e21e
LW		 4397 if (strEQ(d,"msgctl")) return -KEY_msgctl;
4398 if (strEQ(d,"msgget")) return -KEY_msgget;
4399 if (strEQ(d,"msgrcv")) return -KEY_msgrcv;
4400 if (strEQ(d,"msgsnd")) return -KEY_msgsnd;
79072805
LW		 4401 break;
4402 }
a687059c 4403 break;
79072805 4404 case 'N':
a0d0e21e 4405 if (strEQ(d,"NE")) { deprecate(d); return -KEY_ne;}
a687059c 4406 break;
79072805
LW		 4407 case 'n':
4408 if (strEQ(d,"next")) return KEY_next;
a0d0e21e
LW		 4409 if (strEQ(d,"ne")) return -KEY_ne;
4410 if (strEQ(d,"not")) return -KEY_not;
4411 if (strEQ(d,"no")) return KEY_no;
a687059c 4412 break;
79072805
LW		 4413 case 'o':
4414 switch (len) {
463ee0b2 4415 case 2:
a0d0e21e 4416 if (strEQ(d,"or")) return -KEY_or;
463ee0b2 4417 break;
79072805 4418 case 3:
a0d0e21e
LW		 4419 if (strEQ(d,"ord")) return -KEY_ord;
4420 if (strEQ(d,"oct")) return -KEY_oct;
72311751 4421 if (strEQ(d,"our")) { deprecate("reserved word \"our\"");
85b81015 4422 return 0;}
79072805
LW		 4423 break;
4424 case 4:
a0d0e21e 4425 if (strEQ(d,"open")) return -KEY_open;
79072805
LW		 4426 break;
4427 case 7:
a0d0e21e 4428 if (strEQ(d,"opendir")) return -KEY_opendir;
79072805 4429 break;
fe14fcc3 4430 }
a687059c 4431 break;
79072805
LW		 4432 case 'p':
4433 switch (len) {
4434 case 3:
4435 if (strEQ(d,"pop")) return KEY_pop;
a0d0e21e 4436 if (strEQ(d,"pos")) return KEY_pos;
79072805
LW		 4437 break;
4438 case 4:
4439 if (strEQ(d,"push")) return KEY_push;
a0d0e21e
LW		 4440 if (strEQ(d,"pack")) return -KEY_pack;
4441 if (strEQ(d,"pipe")) return -KEY_pipe;
79072805
LW		 4442 break;
4443 case 5:
4444 if (strEQ(d,"print")) return KEY_print;
4445 break;
4446 case 6:
4447 if (strEQ(d,"printf")) return KEY_printf;
4448 break;
4449 case 7:
4450 if (strEQ(d,"package")) return KEY_package;
4451 break;
c07a80fd 4452 case 9:
4453 if (strEQ(d,"prototype")) return KEY_prototype;
663a0e37 4454 }
79072805
LW		 4455 break;
4456 case 'q':
4457 if (len <= 2) {
4458 if (strEQ(d,"q")) return KEY_q;
4459 if (strEQ(d,"qq")) return KEY_qq;
8990e307 4460 if (strEQ(d,"qw")) return KEY_qw;
79072805 4461 if (strEQ(d,"qx")) return KEY_qx;
663a0e37 4462 }
a0d0e21e 4463 else if (strEQ(d,"quotemeta")) return -KEY_quotemeta;
79072805
LW		 4464 break;
4465 case 'r':
4466 switch (len) {
4467 case 3:
a0d0e21e 4468 if (strEQ(d,"ref")) return -KEY_ref;
79072805
LW		 4469 break;
4470 case 4:
a0d0e21e
LW		 4471 if (strEQ(d,"read")) return -KEY_read;
4472 if (strEQ(d,"rand")) return -KEY_rand;
4473 if (strEQ(d,"recv")) return -KEY_recv;
79072805
LW		 4474 if (strEQ(d,"redo")) return KEY_redo;
4475 break;
4476 case 5:
a0d0e21e
LW		 4477 if (strEQ(d,"rmdir")) return -KEY_rmdir;
4478 if (strEQ(d,"reset")) return -KEY_reset;
79072805
LW		 4479 break;
4480 case 6:
4481 if (strEQ(d,"return")) return KEY_return;
a0d0e21e
LW		 4482 if (strEQ(d,"rename")) return -KEY_rename;
4483 if (strEQ(d,"rindex")) return -KEY_rindex;
79072805
LW		 4484 break;
4485 case 7:
a0d0e21e
LW		 4486 if (strEQ(d,"require")) return -KEY_require;
4487 if (strEQ(d,"reverse")) return -KEY_reverse;
4488 if (strEQ(d,"readdir")) return -KEY_readdir;
79072805
LW		 4489 break;
4490 case 8:
a0d0e21e
LW		 4491 if (strEQ(d,"readlink")) return -KEY_readlink;
4492 if (strEQ(d,"readline")) return -KEY_readline;
4493 if (strEQ(d,"readpipe")) return -KEY_readpipe;
79072805
LW		 4494 break;
4495 case 9:
a0d0e21e 4496 if (strEQ(d,"rewinddir")) return -KEY_rewinddir;
79072805 4497 break;
a687059c 4498 }
79072805
LW		 4499 break;
4500 case 's':
a687059c 4501 switch (d[1]) {
79072805 4502 case 0: return KEY_s;
a687059c 4503 case 'c':
79072805 4504 if (strEQ(d,"scalar")) return KEY_scalar;
a687059c
LW		 4505 break;
4506 case 'e':
79072805
LW		 4507 switch (len) {
4508 case 4:
a0d0e21e
LW		 4509 if (strEQ(d,"seek")) return -KEY_seek;
4510 if (strEQ(d,"send")) return -KEY_send;
79072805
LW		 4511 break;
4512 case 5:
a0d0e21e 4513 if (strEQ(d,"semop")) return -KEY_semop;
79072805
LW		 4514 break;
4515 case 6:
a0d0e21e
LW		 4516 if (strEQ(d,"select")) return -KEY_select;
4517 if (strEQ(d,"semctl")) return -KEY_semctl;
4518 if (strEQ(d,"semget")) return -KEY_semget;
79072805
LW		 4519 break;
4520 case 7:
a0d0e21e
LW		 4521 if (strEQ(d,"setpgrp")) return -KEY_setpgrp;
4522 if (strEQ(d,"seekdir")) return -KEY_seekdir;
79072805
LW		 4523 break;
4524 case 8:
a0d0e21e
LW		 4525 if (strEQ(d,"setpwent")) return -KEY_setpwent;
4526 if (strEQ(d,"setgrent")) return -KEY_setgrent;
79072805
LW		 4527 break;
4528 case 9:
a0d0e21e 4529 if (strEQ(d,"setnetent")) return -KEY_setnetent;
79072805
LW		 4530 break;
4531 case 10:
a0d0e21e
LW		 4532 if (strEQ(d,"setsockopt")) return -KEY_setsockopt;
4533 if (strEQ(d,"sethostent")) return -KEY_sethostent;
4534 if (strEQ(d,"setservent")) return -KEY_setservent;
79072805
LW		 4535 break;
4536 case 11:
a0d0e21e
LW		 4537 if (strEQ(d,"setpriority")) return -KEY_setpriority;
4538 if (strEQ(d,"setprotoent")) return -KEY_setprotoent;
79072805
LW		 4539 break;
4540 }
a687059c
LW		 4541 break;
4542 case 'h':
79072805
LW		 4543 switch (len) {
4544 case 5:
4545 if (strEQ(d,"shift")) return KEY_shift;
4546 break;
4547 case 6:
a0d0e21e
LW		 4548 if (strEQ(d,"shmctl")) return -KEY_shmctl;
4549 if (strEQ(d,"shmget")) return -KEY_shmget;
79072805
LW		 4550 break;
4551 case 7:
a0d0e21e 4552 if (strEQ(d,"shmread")) return -KEY_shmread;
79072805
LW		 4553 break;
4554 case 8:
a0d0e21e
LW		 4555 if (strEQ(d,"shmwrite")) return -KEY_shmwrite;
4556 if (strEQ(d,"shutdown")) return -KEY_shutdown;
79072805
LW		 4557 break;
4558 }
a687059c
LW		 4559 break;
4560 case 'i':
a0d0e21e 4561 if (strEQ(d,"sin")) return -KEY_sin;
a687059c
LW		 4562 break;
4563 case 'l':
a0d0e21e 4564 if (strEQ(d,"sleep")) return -KEY_sleep;
a687059c
LW		 4565 break;
4566 case 'o':
79072805 4567 if (strEQ(d,"sort")) return KEY_sort;
a0d0e21e
LW		 4568 if (strEQ(d,"socket")) return -KEY_socket;
4569 if (strEQ(d,"socketpair")) return -KEY_socketpair;
a687059c
LW		 4570 break;
4571 case 'p':
79072805 4572 if (strEQ(d,"split")) return KEY_split;
a0d0e21e 4573 if (strEQ(d,"sprintf")) return -KEY_sprintf;
79072805 4574 if (strEQ(d,"splice")) return KEY_splice;
a687059c
LW		 4575 break;
4576 case 'q':
a0d0e21e 4577 if (strEQ(d,"sqrt")) return -KEY_sqrt;
a687059c
LW		 4578 break;
4579 case 'r':
a0d0e21e 4580 if (strEQ(d,"srand")) return -KEY_srand;
a687059c
LW		 4581 break;
4582 case 't':
a0d0e21e 4583 if (strEQ(d,"stat")) return -KEY_stat;
79072805 4584 if (strEQ(d,"study")) return KEY_study;
a687059c
LW		 4585 break;
4586 case 'u':
a0d0e21e 4587 if (strEQ(d,"substr")) return -KEY_substr;
79072805 4588 if (strEQ(d,"sub")) return KEY_sub;
a687059c
LW		 4589 break;
4590 case 'y':
79072805
LW		 4591 switch (len) {
4592 case 6:
a0d0e21e 4593 if (strEQ(d,"system")) return -KEY_system;
79072805
LW		 4594 break;
4595 case 7:
a0d0e21e
LW		 4596 if (strEQ(d,"symlink")) return -KEY_symlink;
4597 if (strEQ(d,"syscall")) return -KEY_syscall;
137443ea 4598 if (strEQ(d,"sysopen")) return -KEY_sysopen;
4599 if (strEQ(d,"sysread")) return -KEY_sysread;
4600 if (strEQ(d,"sysseek")) return -KEY_sysseek;
79072805
LW		 4601 break;
4602 case 8:
a0d0e21e 4603 if (strEQ(d,"syswrite")) return -KEY_syswrite;
79072805 4604 break;
a687059c 4605 }
a687059c
LW		 4606 break;
4607 }
4608 break;
79072805
LW		 4609 case 't':
4610 switch (len) {
4611 case 2:
4612 if (strEQ(d,"tr")) return KEY_tr;
4613 break;
463ee0b2
LW		 4614 case 3:
4615 if (strEQ(d,"tie")) return KEY_tie;
4616 break;
79072805 4617 case 4:
a0d0e21e 4618 if (strEQ(d,"tell")) return -KEY_tell;
c07a80fd 4619 if (strEQ(d,"tied")) return KEY_tied;
a0d0e21e 4620 if (strEQ(d,"time")) return -KEY_time;
79072805
LW		 4621 break;
4622 case 5:
a0d0e21e 4623 if (strEQ(d,"times")) return -KEY_times;
79072805
LW		 4624 break;
4625 case 7:
a0d0e21e 4626 if (strEQ(d,"telldir")) return -KEY_telldir;
79072805
LW		 4627 break;
4628 case 8:
a0d0e21e 4629 if (strEQ(d,"truncate")) return -KEY_truncate;
79072805 4630 break;
378cc40b 4631 }
a687059c 4632 break;
79072805
LW		 4633 case 'u':
4634 switch (len) {
4635 case 2:
a0d0e21e
LW		 4636 if (strEQ(d,"uc")) return -KEY_uc;
4637 break;
4638 case 3:
4639 if (strEQ(d,"use")) return KEY_use;
79072805
LW		 4640 break;
4641 case 5:
4642 if (strEQ(d,"undef")) return KEY_undef;
4643 if (strEQ(d,"until")) return KEY_until;
463ee0b2 4644 if (strEQ(d,"untie")) return KEY_untie;
a0d0e21e
LW		 4645 if (strEQ(d,"utime")) return -KEY_utime;
4646 if (strEQ(d,"umask")) return -KEY_umask;
79072805
LW		 4647 break;
4648 case 6:
4649 if (strEQ(d,"unless")) return KEY_unless;
a0d0e21e
LW		 4650 if (strEQ(d,"unpack")) return -KEY_unpack;
4651 if (strEQ(d,"unlink")) return -KEY_unlink;
79072805
LW		 4652 break;
4653 case 7:
4654 if (strEQ(d,"unshift")) return KEY_unshift;
a0d0e21e 4655 if (strEQ(d,"ucfirst")) return -KEY_ucfirst;
79072805 4656 break;
a687059c
LW		 4657 }
4658 break;
79072805 4659 case 'v':
a0d0e21e
LW		 4660 if (strEQ(d,"values")) return -KEY_values;
4661 if (strEQ(d,"vec")) return -KEY_vec;
a687059c 4662 break;
79072805
LW		 4663 case 'w':
4664 switch (len) {
4665 case 4:
a0d0e21e
LW		 4666 if (strEQ(d,"warn")) return -KEY_warn;
4667 if (strEQ(d,"wait")) return -KEY_wait;
79072805
LW		 4668 break;
4669 case 5:
4670 if (strEQ(d,"while")) return KEY_while;
a0d0e21e 4671 if (strEQ(d,"write")) return -KEY_write;
79072805
LW		 4672 break;
4673 case 7:
a0d0e21e 4674 if (strEQ(d,"waitpid")) return -KEY_waitpid;
79072805
LW		 4675 break;
4676 case 9:
a0d0e21e 4677 if (strEQ(d,"wantarray")) return -KEY_wantarray;
79072805 4678 break;
2f3197b3 4679 }
a687059c 4680 break;
79072805 4681 case 'x':
a0d0e21e
LW		 4682 if (len == 1) return -KEY_x;
4683 if (strEQ(d,"xor")) return -KEY_xor;
a687059c 4684 break;
79072805
LW		 4685 case 'y':
4686 if (len == 1) return KEY_y;
4687 break;
4688 case 'z':
a687059c
LW		 4689 break;
4690 }
79072805 4691 return 0;
a687059c
LW		 4692}
4693
76e3520e 4694STATIC void
8ac85365 4695checkcomma(register char *s, char *name, char *what)
a687059c 4696{
2f3197b3
LW		 4697 char *w;
4698
463ee0b2 4699 if (dowarn && *s == ' ' && s[1] == '(') { /* XXX gotta be a better way */
a0d0e21e
LW		 4700 int level = 1;
4701 for (w = s+2; *w && level; w++) {
4702 if (*w == '(')
4703 ++level;
4704 else if (*w == ')')
4705 --level;
4706 }
4707 if (*w)
4708 for (; *w && isSPACE(*w); w++) ;
d1f3fb15 4709 if (!*w || !strchr(";|})]oaiuw!=", *w)) /* an advisory hack only... */
2f3197b3
LW		 4710 warn("%s (...) interpreted as function",name);
4711 }
4712 while (s < bufend && isSPACE(*s))
4713 s++;
a687059c
LW		 4714 if (*s == '(')
4715 s++;
de3bb511 4716 while (s < bufend && isSPACE(*s))
a687059c 4717 s++;
79072805 4718 if (isIDFIRST(*s)) {
2f3197b3 4719 w = s++;
de3bb511 4720 while (isALNUM(*s))
a687059c 4721 s++;
de3bb511 4722 while (s < bufend && isSPACE(*s))
a687059c 4723 s++;
e929a76b 4724 if (*s == ',') {
463ee0b2 4725 int kw;
e929a76b 4726 *s = '\0';
4633a7c4 4727 kw = keyword(w, s - w) || perl_get_cv(w, FALSE) != 0;
e929a76b 4728 *s = ',';
463ee0b2 4729 if (kw)
e929a76b 4730 return;
463ee0b2
LW		 4731 croak("No comma allowed after %s", what);
4732 }
4733 }
4734}
4735
b3ac6de7
IZ		 4736STATIC SV *
4737new_constant(char *s, STRLEN len, char *key, SV *sv, SV *pv, char *type)
4738{
b3ac6de7 4739 dSP;
25eaa213 4740 HV *table = GvHV(hintgv); /* ^H */
b3ac6de7
IZ		 4741 BINOP myop;
4742 SV *res;
4743 bool oldcatch = CATCH_GET;
4744 SV **cvp;
4745 SV *cv, *typesv;
4746 char buf[128];
4747
4748 if (!table) {
4749 yyerror("%^H is not defined");
4750 return sv;
4751 }
4752 cvp = hv_fetch(table, key, strlen(key), FALSE);
4753 if (!cvp || !SvOK(*cvp)) {
4754 sprintf(buf,"$^H{%s} is not defined", key);
4755 yyerror(buf);
4756 return sv;
4757 }
4758 sv_2mortal(sv); /* Parent created it permanently */
4759 cv = *cvp;
4760 if (!pv)
4761 pv = sv_2mortal(newSVpv(s, len));
4762 if (type)
4763 typesv = sv_2mortal(newSVpv(type, 0));
4764 else
4765 typesv = &sv_undef;
4766 CATCH_SET(TRUE);
4767 Zero(&myop, 1, BINOP);
4768 myop.op_last = (OP *) &myop;
4769 myop.op_next = Nullop;
4770 myop.op_flags = OPf_WANT_SCALAR | OPf_STACKED;
4771
4772 PUSHSTACKi(SI_OVERLOAD);
4773 ENTER;
4774 SAVEOP();
4775 op = (OP *) &myop;
4776 if (PERLDB_SUB && curstash != debstash)
4777 op->op_private |= OPpENTERSUB_DB;
4778 PUTBACK;
4779 pp_pushmark(ARGS);
4780
25eaa213 4781 EXTEND(sp, 4);
b3ac6de7
IZ		 4782 PUSHs(pv);
4783 PUSHs(sv);
4784 PUSHs(typesv);
4785 PUSHs(cv);
4786 PUTBACK;
4787
4788 if (op = pp_entersub(ARGS))
4789 CALLRUNOPS();
4790 LEAVE;
4791 SPAGAIN;
4792
4793 res = POPs;
4794 PUTBACK;
4795 CATCH_SET(oldcatch);
4796 POPSTACK;
4797
4798 if (!SvOK(res)) {
4799 sprintf(buf,"Call to &{$^H{%s}} did not return a defined value", key);
4800 yyerror(buf);
4801 }
4802 return SvREFCNT_inc(res);
4803}
4804
76e3520e 4805STATIC char *
8ac85365 4806scan_word(register char *s, char *dest, STRLEN destlen, int allow_package, STRLEN *slp)
463ee0b2
LW		 4807{
4808 register char *d = dest;
8903cb82 4809 register char *e = d + destlen - 3; /* two-character token, ending NUL */
463ee0b2 4810 for (;;) {
8903cb82 4811 if (d >= e)
fc36a67e 4812 croak(ident_too_long);
463ee0b2
LW		 4813 if (isALNUM(*s))
4814 *d++ = *s++;
4815 else if (*s == '\'' && allow_package && isIDFIRST(s[1])) {
4816 *d++ = ':';
4817 *d++ = ':';
4818 s++;
4819 }
c3e0f903 4820 else if (*s == ':' && s[1] == ':' && allow_package && s[2] != '$') {
463ee0b2
LW		 4821 *d++ = *s++;
4822 *d++ = *s++;
4823 }
4824 else {
4825 *d = '\0';
4826 *slp = d - dest;
4827 return s;
e929a76b 4828 }
378cc40b
LW		 4829 }
4830}
4831
76e3520e 4832STATIC char *
8ac85365 4833scan_ident(register char *s, register char *send, char *dest, STRLEN destlen, I32 ck_uni)
378cc40b
LW		 4834{
4835 register char *d;
8903cb82 4836 register char *e;
79072805 4837 char *bracket = 0;
748a9306 4838 char funny = *s++;
378cc40b 4839
79072805
LW		 4840 if (lex_brackets == 0)
4841 lex_fakebrack = 0;
a0d0e21e
LW		 4842 if (isSPACE(*s))
4843 s = skipspace(s);
378cc40b 4844 d = dest;
8903cb82 4845 e = d + destlen - 3; /* two-character token, ending NUL */
de3bb511 4846 if (isDIGIT(*s)) {
8903cb82 4847 while (isDIGIT(*s)) {
4848 if (d >= e)
fc36a67e 4849 croak(ident_too_long);
378cc40b 4850 *d++ = *s++;
8903cb82 4851 }
378cc40b
LW		 4852 }
4853 else {
463ee0b2 4854 for (;;) {
8903cb82 4855 if (d >= e)
fc36a67e 4856 croak(ident_too_long);
463ee0b2
LW		 4857 if (isALNUM(*s))
4858 *d++ = *s++;
4859 else if (*s == '\'' && isIDFIRST(s[1])) {
4860 *d++ = ':';
4861 *d++ = ':';
4862 s++;
4863 }
a0d0e21e 4864 else if (*s == ':' && s[1] == ':') {
463ee0b2
LW		 4865 *d++ = *s++;
4866 *d++ = *s++;
4867 }
4868 else
4869 break;
4870 }
378cc40b
LW		 4871 }
4872 *d = '\0';
4873 d = dest;
79072805
LW		 4874 if (*d) {
4875 if (lex_state != LEX_NORMAL)
4876 lex_state = LEX_INTERPENDMAYBE;
4877 return s;
378cc40b 4878 }
748a9306 4879 if (*s == '$' && s[1] &&
ff0cee69 4880 (isALNUM(s[1]) || strchr("${", s[1]) || strnEQ(s+1,"::",2)) )
5cd24f17 4881 {
4882 if (isDIGIT(s[1]) && lex_state == LEX_INTERPNORMAL)
4883 deprecate("\"$$<digit>\" to mean \"${$}<digit>\"");
4884 else
4885 return s;
4886 }
79072805
LW		 4887 if (*s == '{') {
4888 bracket = s;
4889 s++;
4890 }
4891 else if (ck_uni)
4892 check_uni();
93a17b20 4893 if (s < send)
79072805
LW		 4894 *d = *s++;
4895 d[1] = '\0';
748a9306 4896 if (*d == '^' && *s && (isUPPER(*s) || strchr("[\\]^_?", *s))) {
bbce6d69 4897 *d = toCTRL(*s);
4898 s++;
de3bb511 4899 }
79072805 4900 if (bracket) {
748a9306 4901 if (isSPACE(s[-1])) {
fa83b5b6 4902 while (s < send) {
4903 char ch = *s++;
4904 if (ch != ' ' && ch != '\t') {
4905 *d = ch;
4906 break;
4907 }
4908 }
748a9306 4909 }
ff68c719 4910 if (isIDFIRST(*d)) {
79072805 4911 d++;
748a9306 4912 while (isALNUM(*s) || *s == ':')
79072805
LW		 4913 *d++ = *s++;
4914 *d = '\0';
748a9306 4915 while (s < send && (*s == ' ' || *s == '\t')) s++;
ff68c719 4916 if ((*s == '[' || (*s == '{' && strNE(dest, "sub")))) {
748a9306
LW		 4917 if (dowarn && keyword(dest, d - dest)) {
4918 char *brack = *s == '[' ? "[...]" : "{...}";
4919 warn("Ambiguous use of %c{%s%s} resolved to %c%s%s",
4920 funny, dest, brack, funny, dest, brack);
4921 }
4922 lex_fakebrack = lex_brackets+1;
79072805 4923 bracket++;
a0d0e21e 4924 lex_brackstack[lex_brackets++] = XOPERATOR;
79072805
LW		 4925 return s;
4926 }
4927 }
4928 if (*s == '}') {
4929 s++;
4930 if (lex_state == LEX_INTERPNORMAL && !lex_brackets)
4931 lex_state = LEX_INTERPEND;
748a9306
LW		 4932 if (funny == '#')
4933 funny = '@';
84902520 4934 if (dowarn && lex_state == LEX_NORMAL &&
748a9306
LW		 4935 (keyword(dest, d - dest) || perl_get_cv(dest, FALSE)))
4936 warn("Ambiguous use of %c{%s} resolved to %c%s",
4937 funny, dest, funny, dest);
79072805
LW		 4938 }
4939 else {
4940 s = bracket; /* let the parser handle it */
93a17b20 4941 *dest = '\0';
79072805
LW		 4942 }
4943 }
4944 else if (lex_state == LEX_INTERPNORMAL && !lex_brackets && !intuit_more(s))
4945 lex_state = LEX_INTERPEND;
378cc40b
LW		 4946 return s;
4947}
4948
8ac85365 4949void pmflag(U16 *pmfl, int ch)
a0d0e21e 4950{
bbce6d69 4951 if (ch == 'i')
a0d0e21e 4952 *pmfl |= PMf_FOLD;
a0d0e21e
LW		 4953 else if (ch == 'g')
4954 *pmfl |= PMf_GLOBAL;
c90c0ff4 4955 else if (ch == 'c')
4956 *pmfl |= PMf_CONTINUE;
a0d0e21e
LW		 4957 else if (ch == 'o')
4958 *pmfl |= PMf_KEEP;
4959 else if (ch == 'm')
4960 *pmfl |= PMf_MULTILINE;
4961 else if (ch == 's')
4962 *pmfl |= PMf_SINGLELINE;
4963 else if (ch == 'x')
4964 *pmfl |= PMf_EXTENDED;
4965}
378cc40b 4966
76e3520e 4967STATIC char *
8ac85365 4968scan_pat(char *start)
378cc40b 4969{
79072805
LW		 4970 PMOP *pm;
4971 char *s;
378cc40b 4972
79072805
LW		 4973 s = scan_str(start);
4974 if (!s) {
4975 if (lex_stuff)
8990e307 4976 SvREFCNT_dec(lex_stuff);
79072805 4977 lex_stuff = Nullsv;
463ee0b2 4978 croak("Search pattern not terminated");
378cc40b 4979 }
bbce6d69 4980
79072805 4981 pm = (PMOP*)newPMOP(OP_MATCH, 0);
a0d0e21e 4982 if (multi_open == '?')
79072805 4983 pm->op_pmflags |= PMf_ONCE;
b3eb6a9b 4984 while (*s && strchr("iogcmsx", *s))
a0d0e21e 4985 pmflag(&pm->op_pmflags,*s++);
4633a7c4 4986 pm->op_pmpermflags = pm->op_pmflags;
bbce6d69 4987
79072805
LW		 4988 lex_op = (OP*)pm;
4989 yylval.ival = OP_MATCH;
378cc40b
LW		 4990 return s;
4991}
4992
76e3520e 4993STATIC char *
8ac85365 4994scan_subst(char *start)
79072805 4995{
a0d0e21e 4996 register char *s;
79072805 4997 register PMOP *pm;
4fdae800 4998 I32 first_start;
79072805
LW		 4999 I32 es = 0;
5000
79072805
LW		 5001 yylval.ival = OP_NULL;
5002
a0d0e21e 5003 s = scan_str(start);
79072805
LW		 5004
5005 if (!s) {
5006 if (lex_stuff)
8990e307 5007 SvREFCNT_dec(lex_stuff);
79072805 5008 lex_stuff = Nullsv;
463ee0b2 5009 croak("Substitution pattern not terminated");
a687059c 5010 }
79072805 5011
a0d0e21e 5012 if (s[-1] == multi_open)
79072805
LW		 5013 s--;
5014
4fdae800 5015 first_start = multi_start;
79072805
LW		 5016 s = scan_str(s);
5017 if (!s) {
5018 if (lex_stuff)
8990e307 5019 SvREFCNT_dec(lex_stuff);
79072805
LW		 5020 lex_stuff = Nullsv;
5021 if (lex_repl)
8990e307 5022 SvREFCNT_dec(lex_repl);
79072805 5023 lex_repl = Nullsv;
463ee0b2 5024 croak("Substitution replacement not terminated");
a687059c 5025 }
4fdae800 5026 multi_start = first_start; /* so whole substitution is taken together */
2f3197b3 5027
79072805 5028 pm = (PMOP*)newPMOP(OP_SUBST, 0);
48c036b1 5029 while (*s) {
a687059c
LW		 5030 if (*s == 'e') {
5031 s++;
2f3197b3 5032 es++;
a687059c 5033 }
b3eb6a9b 5034 else if (strchr("iogcmsx", *s))
a0d0e21e 5035 pmflag(&pm->op_pmflags,*s++);
48c036b1
GS		 5036 else
5037 break;
378cc40b 5038 }
79072805
LW		 5039
5040 if (es) {
5041 SV *repl;
5042 pm->op_pmflags |= PMf_EVAL;
463ee0b2
LW		 5043 repl = newSVpv("",0);
5044 while (es-- > 0)
a0d0e21e 5045 sv_catpv(repl, es ? "eval " : "do ");
79072805
LW		 5046 sv_catpvn(repl, "{ ", 2);
5047 sv_catsv(repl, lex_repl);
5048 sv_catpvn(repl, " };", 2);
5049 SvCOMPILED_on(repl);
8990e307 5050 SvREFCNT_dec(lex_repl);
79072805 5051 lex_repl = repl;
378cc40b 5052 }
79072805 5053
4633a7c4 5054 pm->op_pmpermflags = pm->op_pmflags;
79072805
LW		 5055 lex_op = (OP*)pm;
5056 yylval.ival = OP_SUBST;
378cc40b
LW		 5057 return s;
5058}
5059
76e3520e 5060STATIC char *
8ac85365 5061scan_trans(char *start)
378cc40b 5062{
a0d0e21e 5063 register char* s;
11343788 5064 OP *o;
79072805
LW		 5065 short *tbl;
5066 I32 squash;
8ac85365 5067 I32 Delete;
79072805
LW		 5068 I32 complement;
5069
5070 yylval.ival = OP_NULL;
5071
a0d0e21e 5072 s = scan_str(start);
79072805
LW		 5073 if (!s) {
5074 if (lex_stuff)
8990e307 5075 SvREFCNT_dec(lex_stuff);
79072805 5076 lex_stuff = Nullsv;
2c268ad5 5077 croak("Transliteration pattern not terminated");
a687059c 5078 }
a0d0e21e 5079 if (s[-1] == multi_open)
2f3197b3
LW		 5080 s--;
5081
93a17b20 5082 s = scan_str(s);
79072805
LW		 5083 if (!s) {
5084 if (lex_stuff)
8990e307 5085 SvREFCNT_dec(lex_stuff);
79072805
LW		 5086 lex_stuff = Nullsv;
5087 if (lex_repl)
8990e307 5088 SvREFCNT_dec(lex_repl);
79072805 5089 lex_repl = Nullsv;
2c268ad5 5090 croak("Transliteration replacement not terminated");
a687059c 5091 }
79072805
LW		 5092
5093 New(803,tbl,256,short);
11343788 5094 o = newPVOP(OP_TRANS, 0, (char*)tbl);
2f3197b3 5095
8ac85365 5096 complement = Delete = squash = 0;
395c3793
LW		 5097 while (*s == 'c' || *s == 'd' || *s == 's') {
5098 if (*s == 'c')
79072805 5099 complement = OPpTRANS_COMPLEMENT;
395c3793 5100 else if (*s == 'd')
8ac85365 5101 Delete = OPpTRANS_DELETE;
395c3793 5102 else
79072805 5103 squash = OPpTRANS_SQUASH;
395c3793
LW		 5104 s++;
5105 }
8ac85365 5106 o->op_private = Delete|squash|complement;
79072805 5107
11343788 5108 lex_op = o;
79072805
LW		 5109 yylval.ival = OP_TRANS;
5110 return s;
5111}
5112
76e3520e 5113STATIC char *
8ac85365 5114scan_heredoc(register char *s)
79072805 5115{
11343788 5116 dTHR;
79072805
LW		 5117 SV *herewas;
5118 I32 op_type = OP_SCALAR;
5119 I32 len;
5120 SV *tmpstr;
5121 char term;
5122 register char *d;
fc36a67e 5123 register char *e;
4633a7c4 5124 char *peek;
a2c06652 5125 int outer = (rsfp && !(lex_inwhat == OP_SCALAR));
79072805
LW		 5126
5127 s += 2;
5128 d = tokenbuf;
fc36a67e 5129 e = tokenbuf + sizeof tokenbuf - 1;
fd2d0953 5130 if (!outer)
79072805 5131 *d++ = '\n';
4633a7c4
LW		 5132 for (peek = s; *peek == ' ' || *peek == '\t'; peek++) ;
5133 if (*peek && strchr("`'\"",*peek)) {
5134 s = peek;
79072805 5135 term = *s++;
fc36a67e 5136 s = delimcpy(d, e, s, bufend, term, &len);
5137 d += len;
79072805
LW		 5138 if (s < bufend)
5139 s++;
79072805
LW		 5140 }
5141 else {
5142 if (*s == '\\')
5143 s++, term = '\'';
5144 else
5145 term = '"';
4633a7c4
LW		 5146 if (!isALNUM(*s))
5147 deprecate("bare << to mean <<\"\"");
fc36a67e 5148 for (; isALNUM(*s); s++) {
5149 if (d < e)
5150 *d++ = *s;
5151 }
5152 }
5153 if (d >= tokenbuf + sizeof tokenbuf - 1)
5154 croak("Delimiter for here document is too long");
79072805
LW		 5155 *d++ = '\n';
5156 *d = '\0';
5157 len = d - tokenbuf;
5158 d = "\n";
fd2d0953 5159 if (outer || !(d=ninstr(s,bufend,d,d+1)))
79072805
LW		 5160 herewas = newSVpv(s,bufend-s);
5161 else
5162 s--, herewas = newSVpv(s,d-s);
5163 s += SvCUR(herewas);
748a9306 5164
8d6dde3e 5165 tmpstr = NEWSV(87,79);
748a9306
LW		 5166 sv_upgrade(tmpstr, SVt_PVIV);
5167 if (term == '\'') {
79072805 5168 op_type = OP_CONST;
748a9306
LW		 5169 SvIVX(tmpstr) = -1;
5170 }
5171 else if (term == '`') {
79072805 5172 op_type = OP_BACKTICK;
748a9306
LW		 5173 SvIVX(tmpstr) = '\\';
5174 }
79072805
LW		 5175
5176 CLINE;
5177 multi_start = curcop->cop_line;
5178 multi_open = multi_close = '<';
79072805 5179 term = *tokenbuf;
fd2d0953 5180 if (!outer) {
79072805
LW		 5181 d = s;
5182 while (s < bufend &&
36477c24 5183 (*s != term || memNE(s,tokenbuf,len)) ) {
79072805
LW		 5184 if (*s++ == '\n')
5185 curcop->cop_line++;
5186 }
5187 if (s >= bufend) {
5188 curcop->cop_line = multi_start;
8990e307 5189 missingterm(tokenbuf);
79072805
LW		 5190 }
5191 sv_setpvn(tmpstr,d+1,s-d);
5192 s += len - 1;
d2719217 5193 curcop->cop_line++; /* the preceding stmt passes a newline */
49d8d3a1 5194
79072805
LW		 5195 sv_catpvn(herewas,s,bufend-s);
5196 sv_setsv(linestr,herewas);
fd049845 5197 oldoldbufptr = oldbufptr = bufptr = s = linestart = SvPVX(linestr);
463ee0b2 5198 bufend = SvPVX(linestr) + SvCUR(linestr);
79072805
LW		 5199 }
5200 else
5201 sv_setpvn(tmpstr,"",0); /* avoid "uninitialized" warning */
5202 while (s >= bufend) { /* multiple line string? */
fd2d0953 5203 if (!outer ||
fd049845 5204 !(oldoldbufptr = oldbufptr = s = linestart = filter_gets(linestr, rsfp, 0))) {
79072805 5205 curcop->cop_line = multi_start;
8990e307 5206 missingterm(tokenbuf);
79072805
LW		 5207 }
5208 curcop->cop_line++;
84902520 5209 if (PERLDB_LINE && curstash != debstash) {
79072805
LW		 5210 SV *sv = NEWSV(88,0);
5211
93a17b20 5212 sv_upgrade(sv, SVt_PVMG);
79072805
LW		 5213 sv_setsv(sv,linestr);
5214 av_store(GvAV(curcop->cop_filegv),
5215 (I32)curcop->cop_line,sv);
5216 }
463ee0b2 5217 bufend = SvPVX(linestr) + SvCUR(linestr);
36477c24 5218 if (*s == term && memEQ(s,tokenbuf,len)) {
79072805
LW		 5219 s = bufend - 1;
5220 *s = ' ';
5221 sv_catsv(linestr,herewas);
463ee0b2 5222 bufend = SvPVX(linestr) + SvCUR(linestr);
79072805
LW		 5223 }
5224 else {
5225 s = bufend;
5226 sv_catsv(tmpstr,linestr);
395c3793
LW		 5227 }
5228 }
79072805
LW		 5229 multi_end = curcop->cop_line;
5230 s++;
5231 if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
5232 SvLEN_set(tmpstr, SvCUR(tmpstr) + 1);
463ee0b2 5233 Renew(SvPVX(tmpstr), SvLEN(tmpstr), char);
79072805 5234 }
8990e307 5235 SvREFCNT_dec(herewas);
79072805
LW		 5236 lex_stuff = tmpstr;
5237 yylval.ival = op_type;
5238 return s;
5239}
5240
02aa26ce
NT		 5241/* scan_inputsymbol
5242 takes: current position in input buffer
5243 returns: new position in input buffer
5244 side-effects: yylval and lex_op are set.
5245
5246 This code handles:
5247
5248 <> read from ARGV
5249 <FH> read from filehandle
5250 <pkg::FH> read from package qualified filehandle
5251 <pkg'FH> read from package qualified filehandle
5252 <$fh> read from filehandle in $fh
5253 <*.h> filename glob
5254
5255*/
5256
76e3520e 5257STATIC char *
8ac85365 5258scan_inputsymbol(char *start)
79072805 5259{
02aa26ce 5260 register char *s = start; /* current position in buffer */
79072805 5261 register char *d;
fc36a67e 5262 register char *e;
79072805
LW		 5263 I32 len;
5264
02aa26ce
NT		 5265 d = tokenbuf; /* start of temp holding space */
5266 e = tokenbuf + sizeof tokenbuf; /* end of temp holding space */
5267 s = delimcpy(d, e, s + 1, bufend, '>', &len); /* extract until > */
5268
5269 /* die if we didn't have space for the contents of the <>,
5270 or if it didn't end
5271 */
5272
fc36a67e 5273 if (len >= sizeof tokenbuf)
5274 croak("Excessively long <> operator");
5275 if (s >= bufend)
463ee0b2 5276 croak("Unterminated <> operator");
02aa26ce 5277
fc36a67e 5278 s++;
02aa26ce
NT		 5279
5280 /* check for <$fh>
5281 Remember, only scalar variables are interpreted as filehandles by
5282 this code. Anything more complex (e.g., <$fh{$num}>) will be
5283 treated as a glob() call.
5284 This code makes use of the fact that except for the $ at the front,
5285 a scalar variable and a filehandle look the same.
5286 */
4633a7c4 5287 if (*d == '$' && d[1]) d++;
02aa26ce
NT		 5288
5289 /* allow <Pkg'VALUE> or <Pkg::VALUE> */
a0d0e21e 5290 while (*d && (isALNUM(*d) || *d == '\'' || *d == ':'))
79072805 5291 d++;
02aa26ce
NT		 5292
5293 /* If we've tried to read what we allow filehandles to look like, and
5294 there's still text left, then it must be a glob() and not a getline.
5295 Use scan_str to pull out the stuff between the <> and treat it
5296 as nothing more than a string.
5297 */
5298
79072805
LW		 5299 if (d - tokenbuf != len) {
5300 yylval.ival = OP_GLOB;
5301 set_csh();
5302 s = scan_str(start);
5303 if (!s)
02aa26ce 5304 croak("Glob not terminated");
79072805
LW		 5305 return s;
5306 }
395c3793 5307 else {
02aa26ce 5308 /* we're in a filehandle read situation */
79072805 5309 d = tokenbuf;
02aa26ce
NT		 5310
5311 /* turn <> into <ARGV> */
79072805
LW		 5312 if (!len)
5313 (void)strcpy(d,"ARGV");
02aa26ce
NT		 5314
5315 /* if <$fh>, create the ops to turn the variable into a
5316 filehandle
5317 */
79072805 5318 if (*d == '$') {
a0d0e21e 5319 I32 tmp;
02aa26ce
NT		 5320
5321 /* try to find it in the pad for this block, otherwise find
5322 add symbol table ops
5323 */
11343788
MB		 5324 if ((tmp = pad_findmy(d)) != NOT_IN_PAD) {
5325 OP *o = newOP(OP_PADSV, 0);
5326 o->op_targ = tmp;
5327 lex_op = (OP*)newUNOP(OP_READLINE, 0, newUNOP(OP_RV2GV, 0, o));
a0d0e21e
LW		 5328 }
5329 else {
5330 GV *gv = gv_fetchpv(d+1,TRUE, SVt_PV);
5331 lex_op = (OP*)newUNOP(OP_READLINE, 0,
5332 newUNOP(OP_RV2GV, 0,
5333 newUNOP(OP_RV2SV, 0,
5334 newGVOP(OP_GV, 0, gv))));
5335 }
02aa26ce 5336 /* we created the ops in lex_op, so make yylval.ival a null op */
79072805
LW		 5337 yylval.ival = OP_NULL;
5338 }
02aa26ce
NT		 5339
5340 /* If it's none of the above, it must be a literal filehandle
5341 (<Foo::BAR> or <FOO>) so build a simple readline OP */
79072805 5342 else {
85e6fe83 5343 GV *gv = gv_fetchpv(d,TRUE, SVt_PVIO);
79072805
LW		 5344 lex_op = (OP*)newUNOP(OP_READLINE, 0, newGVOP(OP_GV, 0, gv));
5345 yylval.ival = OP_NULL;
5346 }
5347 }
02aa26ce 5348
79072805
LW		 5349 return s;
5350}
5351
02aa26ce
NT		 5352
5353/* scan_str
5354 takes: start position in buffer
5355 returns: position to continue reading from buffer
5356 side-effects: multi_start, multi_close, lex_repl or lex_stuff, and
5357 updates the read buffer.
5358
5359 This subroutine pulls a string out of the input. It is called for:
5360 q single quotes q(literal text)
5361 ' single quotes 'literal text'
5362 qq double quotes qq(interpolate $here please)
5363 " double quotes "interpolate $here please"
5364 qx backticks qx(/bin/ls -l)
5365 ` backticks `/bin/ls -l`
5366 qw quote words @EXPORT_OK = qw( func() $spam )
5367 m// regexp match m/this/
5368 s/// regexp substitute s/this/that/
5369 tr/// string transliterate tr/this/that/
5370 y/// string transliterate y/this/that/
5371 ($*@) sub prototypes sub foo ($)
5372 <> readline or globs <FOO>, <>, <$fh>, or <*.c>
5373
5374 In most of these cases (all but <>, patterns and transliterate)
5375 yylex() calls scan_str(). m// makes yylex() call scan_pat() which
5376 calls scan_str(). s/// makes yylex() call scan_subst() which calls
5377 scan_str(). tr/// and y/// make yylex() call scan_trans() which
5378 calls scan_str().
5379
5380 It skips whitespace before the string starts, and treats the first
5381 character as the delimiter. If the delimiter is one of ([{< then
5382 the corresponding "close" character )]}> is used as the closing
5383 delimiter. It allows quoting of delimiters, and if the string has
5384 balanced delimiters ([{<>}]) it allows nesting.
5385
5386 The lexer always reads these strings into lex_stuff, except in the
5387 case of the operators which take *two* arguments (s/// and tr///)
5388 when it checks to see if lex_stuff is full (presumably with the 1st
5389 arg to s or tr) and if so puts the string into lex_repl.
5390
5391*/
5392
76e3520e 5393STATIC char *
8ac85365 5394scan_str(char *start)
79072805 5395{
11343788 5396 dTHR;
02aa26ce
NT		 5397 SV *sv; /* scalar value: string */
5398 char *tmps; /* temp string, used for delimiter matching */
5399 register char *s = start; /* current position in the buffer */
5400 register char term; /* terminating character */
5401 register char *to; /* current position in the sv's data */
5402 I32 brackets = 1; /* bracket nesting level */
5403
5404 /* skip space before the delimiter */
fb73857a 5405 if (isSPACE(*s))
5406 s = skipspace(s);
02aa26ce
NT		 5407
5408 /* mark where we are, in case we need to report errors */
79072805 5409 CLINE;
02aa26ce
NT		 5410
5411 /* after skipping whitespace, the next character is the terminator */
a0d0e21e 5412 term = *s;
02aa26ce 5413 /* mark where we are */
79072805
LW		 5414 multi_start = curcop->cop_line;
5415 multi_open = term;
02aa26ce
NT		 5416
5417 /* find corresponding closing delimiter */
93a17b20 5418 if (term && (tmps = strchr("([{< )]}> )]}>",term)))
79072805
LW		 5419 term = tmps[5];
5420 multi_close = term;
5421
02aa26ce 5422 /* create a new SV to hold the contents. 87 is leak category, I'm
8d6dde3e
IZ		 5423 assuming. 79 is the SV's initial length. What a random number. */
5424 sv = NEWSV(87,79);
ed6116ce
LW		 5425 sv_upgrade(sv, SVt_PVIV);
5426 SvIVX(sv) = term;
a0d0e21e 5427 (void)SvPOK_only(sv); /* validate pointer */
02aa26ce
NT		 5428
5429 /* move past delimiter and try to read a complete string */
93a17b20
LW		 5430 s++;
5431 for (;;) {
02aa26ce 5432 /* extend sv if need be */
93a17b20 5433 SvGROW(sv, SvCUR(sv) + (bufend - s) + 1);
02aa26ce 5434 /* set 'to' to the next character in the sv's string */
463ee0b2 5435 to = SvPVX(sv)+SvCUR(sv);
02aa26ce
NT		 5436
5437 /* if open delimiter is the close delimiter read unbridle */
93a17b20
LW		 5438 if (multi_open == multi_close) {
5439 for (; s < bufend; s++,to++) {
02aa26ce 5440 /* embedded newlines increment the current line number */
463ee0b2
LW		 5441 if (*s == '\n' && !rsfp)
5442 curcop->cop_line++;
02aa26ce 5443 /* handle quoted delimiters */
a0d0e21e
LW		 5444 if (*s == '\\' && s+1 < bufend && term != '\\') {
5445 if (s[1] == term)
5446 s++;
02aa26ce 5447 /* any other quotes are simply copied straight through */
a0d0e21e
LW		 5448 else
5449 *to++ = *s++;
5450 }
02aa26ce
NT		 5451 /* terminate when run out of buffer (the for() condition), or
5452 have found the terminator */
93a17b20
LW		 5453 else if (*s == term)
5454 break;
5455 *to = *s;
5456 }
5457 }
02aa26ce
NT		 5458
5459 /* if the terminator isn't the same as the start character (e.g.,
5460 matched brackets), we have to allow more in the quoting, and
5461 be prepared for nested brackets.
5462 */
93a17b20 5463 else {
02aa26ce 5464 /* read until we run out of string, or we find the terminator */
93a17b20 5465 for (; s < bufend; s++,to++) {
02aa26ce 5466 /* embedded newlines increment the line count */
463ee0b2
LW		 5467 if (*s == '\n' && !rsfp)
5468 curcop->cop_line++;
02aa26ce 5469 /* backslashes can escape the open or closing characters */
6d07e5e9
GS		 5470 if (*s == '\\' && s+1 < bufend) {
5471 if ((s[1] == multi_open) || (s[1] == multi_close))
a0d0e21e
LW		 5472 s++;
5473 else
5474 *to++ = *s++;
5475 }
02aa26ce 5476 /* allow nested opens and closes */
6d07e5e9 5477 else if (*s == multi_close && --brackets <= 0)
93a17b20
LW		 5478 break;
5479 else if (*s == multi_open)
5480 brackets++;
5481 *to = *s;
5482 }
5483 }
02aa26ce 5484 /* terminate the copied string and update the sv's end-of-string */
93a17b20 5485 *to = '\0';
463ee0b2 5486 SvCUR_set(sv, to - SvPVX(sv));
93a17b20 5487
02aa26ce
NT		 5488 /*
5489 * this next chunk reads more into the buffer if we're not done yet
5490 */
5491
5492 if (s < bufend) break; /* handle case where we are done yet :-) */
79072805 5493
02aa26ce
NT		 5494 /* if we're out of file, or a read fails, bail and reset the current
5495 line marker so we can report where the unterminated string began
5496 */
79072805 5497 if (!rsfp ||
fd049845 5498 !(oldoldbufptr = oldbufptr = s = linestart = filter_gets(linestr, rsfp, 0))) {
c07a80fd 5499 sv_free(sv);
79072805
LW		 5500 curcop->cop_line = multi_start;
5501 return Nullch;
5502 }
02aa26ce 5503 /* we read a line, so increment our line counter */
79072805 5504 curcop->cop_line++;
02aa26ce
NT		 5505
5506 /* update debugger info */
84902520 5507 if (PERLDB_LINE && curstash != debstash) {
79072805
LW		 5508 SV *sv = NEWSV(88,0);
5509
93a17b20 5510 sv_upgrade(sv, SVt_PVMG);
79072805
LW		 5511 sv_setsv(sv,linestr);
5512 av_store(GvAV(curcop->cop_filegv),
5513 (I32)curcop->cop_line, sv);
395c3793 5514 }
02aa26ce
NT		 5515
5516 /* having changed the buffer, we must update bufend */
463ee0b2 5517 bufend = SvPVX(linestr) + SvCUR(linestr);
378cc40b 5518 }
02aa26ce
NT		 5519
5520 /* at this point, we have successfully read the delimited string */
5521
79072805
LW		 5522 multi_end = curcop->cop_line;
5523 s++;
02aa26ce
NT		 5524
5525 /* if we allocated too much space, give some back */
93a17b20
LW		 5526 if (SvCUR(sv) + 5 < SvLEN(sv)) {
5527 SvLEN_set(sv, SvCUR(sv) + 1);
463ee0b2 5528 Renew(SvPVX(sv), SvLEN(sv), char);
79072805 5529 }
02aa26ce
NT		 5530
5531 /* decide whether this is the first or second quoted string we've read
5532 for this op
5533 */
5534
79072805 5535 if (lex_stuff)
93a17b20 5536 lex_repl = sv;
79072805 5537 else
93a17b20 5538 lex_stuff = sv;
378cc40b
LW		 5539 return s;
5540}
5541
02aa26ce
NT		 5542/*
5543 scan_num
5544 takes: pointer to position in buffer
5545 returns: pointer to new position in buffer
5546 side-effects: builds ops for the constant in yylval.op
5547
5548 Read a number in any of the formats that Perl accepts:
5549
5550 0(x[0-7A-F]+)|([0-7]+)
5551 [\d_]+(\.[\d_]*)?[Ee](\d+)
5552
5553 Underbars (_) are allowed in decimal numbers. If -w is on,
5554 underbars before a decimal point must be at three digit intervals.
5555
5556 Like most scan_ routines, it uses the tokenbuf buffer to hold the
5557 thing it reads.
5558
5559 If it reads a number without a decimal point or an exponent, it will
5560 try converting the number to an integer and see if it can do so
5561 without loss of precision.
5562*/
5563
378cc40b 5564char *
8ac85365 5565scan_num(char *start)
378cc40b 5566{
02aa26ce
NT		 5567 register char *s = start; /* current position in buffer */
5568 register char *d; /* destination in temp buffer */
5569 register char *e; /* end of temp buffer */
5570 I32 tryiv; /* used to see if it can be an int */
5571 double value; /* number read, as a double */
5572 SV *sv; /* place to put the converted number */
5573 I32 floatit; /* boolean: int or float? */
5574 char *lastub = 0; /* position of last underbar */
fc36a67e 5575 static char number_too_long[] = "Number too long";
378cc40b 5576
02aa26ce
NT		 5577 /* We use the first character to decide what type of number this is */
5578
378cc40b 5579 switch (*s) {
79072805 5580 default:
02aa26ce
NT		 5581 croak("panic: scan_num");
5582
5583 /* if it starts with a 0, it could be an octal number, a decimal in
5584 0.13 disguise, or a hexadecimal number.
5585 */
378cc40b
LW		 5586 case '0':
5587 {
02aa26ce
NT		 5588 /* variables:
5589 u holds the "number so far"
5590 shift the power of 2 of the base (hex == 4, octal == 3)
5591 overflowed was the number more than we can hold?
5592
5593 Shift is used when we add a digit. It also serves as an "are
5594 we in octal or hex?" indicator to disallow hex characters when
5595 in octal mode.
5596 */
55497cff 5597 UV u;
79072805 5598 I32 shift;
55497cff 5599 bool overflowed = FALSE;
378cc40b 5600
02aa26ce 5601 /* check for hex */
378cc40b
LW		 5602 if (s[1] == 'x') {
5603 shift = 4;
5604 s += 2;
5605 }
02aa26ce 5606 /* check for a decimal in disguise */
378cc40b
LW		 5607 else if (s[1] == '.')
5608 goto decimal;
02aa26ce 5609 /* so it must be octal */
378cc40b
LW		 5610 else
5611 shift = 3;
55497cff 5612 u = 0;
02aa26ce
NT		 5613
5614 /* read the rest of the octal number */
378cc40b 5615 for (;;) {
02aa26ce 5616 UV n, b; /* n is used in the overflow test, b is the digit we're adding on */
55497cff 5617
378cc40b 5618 switch (*s) {
02aa26ce
NT		 5619
5620 /* if we don't mention it, we're done */
378cc40b
LW		 5621 default:
5622 goto out;
02aa26ce
NT		 5623
5624 /* _ are ignored */
de3bb511
LW		 5625 case '_':
5626 s++;
5627 break;
02aa26ce
NT		 5628
5629 /* 8 and 9 are not octal */
378cc40b
LW		 5630 case '8': case '9':
5631 if (shift != 4)
a687059c 5632 yyerror("Illegal octal digit");
378cc40b 5633 /* FALL THROUGH */
02aa26ce
NT		 5634
5635 /* octal digits */
378cc40b
LW		 5636 case '0': case '1': case '2': case '3': case '4':
5637 case '5': case '6': case '7':
02aa26ce 5638 b = *s++ & 15; /* ASCII digit -> value of digit */
55497cff 5639 goto digit;
02aa26ce
NT		 5640
5641 /* hex digits */
378cc40b
LW		 5642 case 'a': case 'b': case 'c': case 'd': case 'e': case 'f':
5643 case 'A': case 'B': case 'C': case 'D': case 'E': case 'F':
02aa26ce 5644 /* make sure they said 0x */
378cc40b
LW		 5645 if (shift != 4)
5646 goto out;
55497cff 5647 b = (*s++ & 7) + 9;
02aa26ce
NT		 5648
5649 /* Prepare to put the digit we have onto the end
5650 of the number so far. We check for overflows.
5651 */
5652
55497cff 5653 digit:
02aa26ce 5654 n = u << shift; /* make room for the digit */
b3ac6de7
IZ		 5655 if (!overflowed && (n >> shift) != u
5656 && !(hints & HINT_NEW_BINARY)) {
55497cff 5657 warn("Integer overflow in %s number",
5658 (shift == 4) ? "hex" : "octal");
5659 overflowed = TRUE;
5660 }
02aa26ce 5661 u = n | b; /* add the digit to the end */
378cc40b
LW		 5662 break;
5663 }
5664 }
02aa26ce
NT		 5665
5666 /* if we get here, we had success: make a scalar value from
5667 the number.
5668 */
378cc40b 5669 out:
79072805 5670 sv = NEWSV(92,0);
55497cff 5671 sv_setuv(sv, u);
b3ac6de7
IZ		 5672 if ( hints & HINT_NEW_BINARY)
5673 sv = new_constant(start, s - start, "binary", sv, Nullsv, NULL);
378cc40b
LW		 5674 }
5675 break;
02aa26ce
NT		 5676
5677 /*
5678 handle decimal numbers.
5679 we're also sent here when we read a 0 as the first digit
5680 */
378cc40b
LW		 5681 case '1': case '2': case '3': case '4': case '5':
5682 case '6': case '7': case '8': case '9': case '.':
5683 decimal:
378cc40b 5684 d = tokenbuf;
fc36a67e 5685 e = tokenbuf + sizeof tokenbuf - 6; /* room for various punctuation */
79072805 5686 floatit = FALSE;
02aa26ce
NT		 5687
5688 /* read next group of digits and _ and copy into d */
de3bb511 5689 while (isDIGIT(*s) || *s == '_') {
02aa26ce
NT		 5690 /* skip underscores, checking for misplaced ones
5691 if -w is on
5692 */
93a17b20
LW		 5693 if (*s == '_') {
5694 if (dowarn && lastub && s - lastub != 3)
8990e307 5695 warn("Misplaced _ in number");
93a17b20
LW		 5696 lastub = ++s;
5697 }
fc36a67e 5698 else {
02aa26ce 5699 /* check for end of fixed-length buffer */
fc36a67e 5700 if (d >= e)
5701 croak(number_too_long);
02aa26ce 5702 /* if we're ok, copy the character */
378cc40b 5703 *d++ = *s++;
fc36a67e 5704 }
378cc40b 5705 }
02aa26ce
NT		 5706
5707 /* final misplaced underbar check */
93a17b20 5708 if (dowarn && lastub && s - lastub != 3)
8990e307 5709 warn("Misplaced _ in number");
02aa26ce
NT		 5710
5711 /* read a decimal portion if there is one. avoid
5712 3..5 being interpreted as the number 3. followed
5713 by .5
5714 */
2f3197b3 5715 if (*s == '.' && s[1] != '.') {
79072805 5716 floatit = TRUE;
378cc40b 5717 *d++ = *s++;
02aa26ce
NT		 5718
5719 /* copy, ignoring underbars, until we run out of
5720 digits. Note: no misplaced underbar checks!
5721 */
fc36a67e 5722 for (; isDIGIT(*s) || *s == '_'; s++) {
02aa26ce 5723 /* fixed length buffer check */
fc36a67e 5724 if (d >= e)
5725 croak(number_too_long);
5726 if (*s != '_')
5727 *d++ = *s;
378cc40b
LW		 5728 }
5729 }
02aa26ce
NT		 5730
5731 /* read exponent part, if present */
93a17b20 5732 if (*s && strchr("eE",*s) && strchr("+-0123456789",s[1])) {
79072805
LW		 5733 floatit = TRUE;
5734 s++;
02aa26ce
NT		 5735
5736 /* regardless of whether user said 3E5 or 3e5, use lower 'e' */
79072805 5737 *d++ = 'e'; /* At least some Mach atof()s don't grok 'E' */
02aa26ce
NT		 5738
5739 /* allow positive or negative exponent */
378cc40b
LW		 5740 if (*s == '+' || *s == '-')
5741 *d++ = *s++;
02aa26ce
NT		 5742
5743 /* read digits of exponent (no underbars :-) */
fc36a67e 5744 while (isDIGIT(*s)) {
5745 if (d >= e)
5746 croak(number_too_long);
378cc40b 5747 *d++ = *s++;
fc36a67e 5748 }
378cc40b 5749 }
02aa26ce
NT		 5750
5751 /* terminate the string */
378cc40b 5752 *d = '\0';
02aa26ce
NT		 5753
5754 /* make an sv from the string */
79072805 5755 sv = NEWSV(92,0);
02aa26ce 5756 /* reset numeric locale in case we were earlier left in Swaziland */
36477c24 5757 SET_NUMERIC_STANDARD();
79072805 5758 value = atof(tokenbuf);
02aa26ce
NT		 5759
5760 /*
5761 See if we can make do with an integer value without loss of
5762 precision. We use I_V to cast to an int, because some
5763 compilers have issues. Then we try casting it back and see
5764 if it was the same. We only do this if we know we
5765 specifically read an integer.
5766
5767 Note: if floatit is true, then we don't need to do the
5768 conversion at all.
5769 */
1e422769 5770 tryiv = I_V(value);
5771 if (!floatit && (double)tryiv == value)
5772 sv_setiv(sv, tryiv);
2f3197b3 5773 else
1e422769 5774 sv_setnv(sv, value);
b3ac6de7
IZ		 5775 if ( floatit ? (hints & HINT_NEW_FLOAT) : (hints & HINT_NEW_INTEGER) )
5776 sv = new_constant(tokenbuf, d - tokenbuf,
5777 (floatit ? "float" : "integer"), sv, Nullsv, NULL);
378cc40b 5778 break;
79072805 5779 }
a687059c 5780
02aa26ce
NT		 5781 /* make the op for the constant and return */
5782
79072805 5783 yylval.opval = newSVOP(OP_CONST, 0, sv);
a687059c 5784
378cc40b
LW		 5785 return s;
5786}
5787
76e3520e 5788STATIC char *
8ac85365 5789scan_formline(register char *s)
378cc40b 5790{
11343788 5791 dTHR;
79072805 5792 register char *eol;
378cc40b 5793 register char *t;
a0d0e21e 5794 SV *stuff = newSVpv("",0);
79072805 5795 bool needargs = FALSE;
378cc40b 5796
79072805 5797 while (!needargs) {
85e6fe83 5798 if (*s == '.' || *s == '}') {
79072805
LW		 5799 /*SUPPRESS 530*/
5800 for (t = s+1; *t == ' ' || *t == '\t'; t++) ;
5801 if (*t == '\n')
5802 break;
5803 }
0f85fab0 5804 if (in_eval && !rsfp) {
93a17b20 5805 eol = strchr(s,'\n');
0f85fab0
LW		 5806 if (!eol++)
5807 eol = bufend;
5808 }
5809 else
463ee0b2 5810 eol = bufend = SvPVX(linestr) + SvCUR(linestr);
79072805 5811 if (*s != '#') {
a0d0e21e
LW		 5812 for (t = s; t < eol; t++) {
5813 if (*t == '~' && t[1] == '~' && SvCUR(stuff)) {
5814 needargs = FALSE;
5815 goto enough; /* ~~ must be first line in formline */
378cc40b 5816 }
a0d0e21e
LW		 5817 if (*t == '@' || *t == '^')
5818 needargs = TRUE;
378cc40b 5819 }
a0d0e21e 5820 sv_catpvn(stuff, s, eol-s);
79072805
LW		 5821 }
5822 s = eol;
5823 if (rsfp) {
fd049845 5824 s = filter_gets(linestr, rsfp, 0);
5825 oldoldbufptr = oldbufptr = bufptr = linestart = SvPVX(linestr);
a0d0e21e 5826 bufend = bufptr + SvCUR(linestr);
79072805
LW		 5827 if (!s) {
5828 s = bufptr;
5829 yyerror("Format not terminated");
378cc40b
LW		 5830 break;
5831 }
378cc40b 5832 }
463ee0b2 5833 incline(s);
79072805 5834 }
a0d0e21e
LW		 5835 enough:
5836 if (SvCUR(stuff)) {
463ee0b2 5837 expect = XTERM;
79072805 5838 if (needargs) {
a0d0e21e 5839 lex_state = LEX_NORMAL;
79072805
LW		 5840 nextval[nexttoke].ival = 0;
5841 force_next(',');
5842 }
a0d0e21e
LW		 5843 else
5844 lex_state = LEX_FORMLINE;
79072805
LW		 5845 nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, stuff);
5846 force_next(THING);
5847 nextval[nexttoke].ival = OP_FORMLINE;
5848 force_next(LSTOP);
378cc40b 5849 }
79072805 5850 else {
8990e307 5851 SvREFCNT_dec(stuff);
85e6fe83 5852 lex_formbrack = 0;
79072805
LW		 5853 bufptr = s;
5854 }
5855 return s;
378cc40b 5856}
a687059c 5857
76e3520e 5858STATIC void
8ac85365 5859set_csh(void)
a687059c 5860{
ae986130
LW		 5861#ifdef CSH
5862 if (!cshlen)
5863 cshlen = strlen(cshname);
5864#endif
a687059c 5865}
463ee0b2 5866
ba6d6ac9 5867I32
8ac85365 5868start_subparse(I32 is_format, U32 flags)
8990e307 5869{
11343788 5870 dTHR;
ba6d6ac9 5871 I32 oldsavestack_ix = savestack_ix;
748a9306
LW		 5872 CV* outsidecv = compcv;
5873 AV* comppadlist;
8990e307 5874
e9a444f0
LW		 5875 if (compcv) {
5876 assert(SvTYPE(compcv) == SVt_PVCV);
5877 }
8990e307
LW		 5878 save_I32(&subline);
5879 save_item(subname);
55497cff 5880 SAVEI32(padix);
8990e307
LW		 5881 SAVESPTR(curpad);
5882 SAVESPTR(comppad);
5883 SAVESPTR(comppad_name);
748a9306 5884 SAVESPTR(compcv);
55497cff 5885 SAVEI32(comppad_name_fill);
5886 SAVEI32(min_intro_pending);
5887 SAVEI32(max_intro_pending);
5888 SAVEI32(pad_reset_pending);
748a9306
LW		 5889
5890 compcv = (CV*)NEWSV(1104,0);
774d564b 5891 sv_upgrade((SV *)compcv, is_format ? SVt_PVFM : SVt_PVCV);
fa83b5b6 5892 CvFLAGS(compcv) |= flags;
748a9306 5893
8990e307 5894 comppad = newAV();
6d4ff0d2
MB		 5895 av_push(comppad, Nullsv);
5896 curpad = AvARRAY(comppad);
8990e307
LW		 5897 comppad_name = newAV();
5898 comppad_name_fill = 0;
5899 min_intro_pending = 0;
8990e307 5900 padix = 0;
8990e307 5901 subline = curcop->cop_line;
6d4ff0d2
MB		 5902#ifdef USE_THREADS
5903 av_store(comppad_name, 0, newSVpv("@_", 2));
5904 curpad[0] = (SV*)newAV();
5905 SvPADMY_on(curpad[0]); /* XXX Needed? */
5906 CvOWNER(compcv) = 0;
12ca11f6 5907 New(666, CvMUTEXP(compcv), 1, perl_mutex);
6d4ff0d2 5908 MUTEX_INIT(CvMUTEXP(compcv));
6d4ff0d2 5909#endif /* USE_THREADS */
748a9306
LW		 5910
5911 comppadlist = newAV();
5912 AvREAL_off(comppadlist);
8e07c86e
AD		 5913 av_store(comppadlist, 0, (SV*)comppad_name);
5914 av_store(comppadlist, 1, (SV*)comppad);
748a9306
LW		 5915
5916 CvPADLIST(compcv) = comppadlist;
199100c8 5917 CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc(outsidecv);
11343788
MB		 5918#ifdef USE_THREADS
5919 CvOWNER(compcv) = 0;
12ca11f6 5920 New(666, CvMUTEXP(compcv), 1, perl_mutex);
11343788 5921 MUTEX_INIT(CvMUTEXP(compcv));
11343788 5922#endif /* USE_THREADS */
748a9306 5923
8990e307
LW		 5924 return oldsavestack_ix;
5925}
5926
5927int
8ac85365 5928yywarn(char *s)
8990e307 5929{
11343788 5930 dTHR;
8990e307 5931 --error_count;
748a9306
LW		 5932 in_eval |= 2;
5933 yyerror(s);
5934 in_eval &= ~2;
5935 return 0;
8990e307
LW		 5936}
5937
5938int
8ac85365 5939yyerror(char *s)
463ee0b2 5940{
11343788 5941 dTHR;
68dc0745 5942 char *where = NULL;
5943 char *context = NULL;
5944 int contlen = -1;
46fc3d4c 5945 SV *msg;
463ee0b2 5946
54310121 5947 if (!yychar || (yychar == ';' && !rsfp))
5948 where = "at EOF";
5949 else if (bufptr > oldoldbufptr && bufptr - oldoldbufptr < 200 &&
463ee0b2
LW		 5950 oldoldbufptr != oldbufptr && oldbufptr != bufptr) {
5951 while (isSPACE(*oldoldbufptr))
5952 oldoldbufptr++;
68dc0745 5953 context = oldoldbufptr;
5954 contlen = bufptr - oldoldbufptr;
463ee0b2
LW		 5955 }
5956 else if (bufptr > oldbufptr && bufptr - oldbufptr < 200 &&
5957 oldbufptr != bufptr) {
5958 while (isSPACE(*oldbufptr))
5959 oldbufptr++;
68dc0745 5960 context = oldbufptr;
5961 contlen = bufptr - oldbufptr;
463ee0b2
LW		 5962 }
5963 else if (yychar > 255)
68dc0745 5964 where = "next token ???";
463ee0b2
LW		 5965 else if ((yychar & 127) == 127) {
5966 if (lex_state == LEX_NORMAL ||
5967 (lex_state == LEX_KNOWNEXT && lex_defer == LEX_NORMAL))
68dc0745 5968 where = "at end of line";
4633a7c4 5969 else if (lex_inpat)
68dc0745 5970 where = "within pattern";
463ee0b2 5971 else
68dc0745 5972 where = "within string";
463ee0b2 5973 }
46fc3d4c 5974 else {
5975 SV *where_sv = sv_2mortal(newSVpv("next char ", 0));
5976 if (yychar < 32)
5977 sv_catpvf(where_sv, "^%c", toCTRL(yychar));
5978 else if (isPRINT_LC(yychar))
5979 sv_catpvf(where_sv, "%c", yychar);
463ee0b2 5980 else
46fc3d4c 5981 sv_catpvf(where_sv, "\\%03o", yychar & 255);
5982 where = SvPVX(where_sv);
463ee0b2 5983 }
46fc3d4c 5984 msg = sv_2mortal(newSVpv(s, 0));
fc36a67e 5985 sv_catpvf(msg, " at %_ line %ld, ",
46fc3d4c 5986 GvSV(curcop->cop_filegv), (long)curcop->cop_line);
68dc0745 5987 if (context)
46fc3d4c 5988 sv_catpvf(msg, "near \"%.*s\"\n", contlen, context);
463ee0b2 5989 else
46fc3d4c 5990 sv_catpvf(msg, "%s\n", where);
4fdae800 5991 if (multi_start < multi_end && (U32)(curcop->cop_line - multi_end) <= 1) {
46fc3d4c 5992 sv_catpvf(msg,
4fdae800 5993 " (Might be a runaway multi-line %c%c string starting on line %ld)\n",
ff0cee69 5994 (int)multi_open,(int)multi_close,(long)multi_start);
a0d0e21e
LW		 5995 multi_end = 0;
5996 }
748a9306 5997 if (in_eval & 2)
fc36a67e 5998 warn("%_", msg);
748a9306 5999 else if (in_eval)
38a03e6e 6000 sv_catsv(ERRSV, msg);
463ee0b2 6001 else
46fc3d4c 6002 PerlIO_write(PerlIO_stderr(), SvPVX(msg), SvCUR(msg));
463ee0b2 6003 if (++error_count >= 10)
fc36a67e 6004 croak("%_ has too many errors.\n", GvSV(curcop->cop_filegv));
4633a7c4 6005 in_my = 0;
c750a3ec 6006 in_my_stash = Nullhv;
463ee0b2
LW		 6007 return 0;
6008}
4e35701f 6009
161b471a 6010
Unnamed repository; edit this file 'description' to name the repository.