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