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