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