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