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 patch.2b1e to perl5.002beta1. This is simply
[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 */
4633a7c4 1077 if (sv_gets(buf_sv, rsfp, SvCUR(buf_sv)) == NULL)
16d20bd9
AD		 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 }
4633a7c4 1692 TERM(']');
79072805
LW		 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) {
4633a7c4 1810 if (dowarn && 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) {
4633a7c4
LW		 2006 if (intuit_more(s)) {
2007 if (*s == '[')
2008 tokenbuf[0] = '@';
2009 else if (*s == '{')
2010 tokenbuf[0] = '%';
2011 }
a0d0e21e 2012 }
93a17b20 2013 if (tmp = pad_findmy(tokenbuf)) {
ed6116ce 2014 nextval[nexttoke].opval = newOP(OP_PADANY, 0);
93a17b20
LW		 2015 nextval[nexttoke].opval->op_targ = tmp;
2016 force_next(PRIVATEREF);
2017 }
4633a7c4 2018 else
a0d0e21e 2019 force_ident(tokenbuf+1, *tokenbuf);
93a17b20
LW		 2020 }
2021 else
a0d0e21e 2022 force_ident(tokenbuf+1, *tokenbuf);
93a17b20 2023 }
463ee0b2
LW		 2024 else {
2025 if (s == bufend)
2026 yyerror("Final $ should be \\$ or $name");
79072805 2027 PREREF('$');
2f3197b3 2028 }
79072805 2029 TOKEN('$');
378cc40b
LW		 2030
2031 case '@':
93a17b20 2032 s = scan_ident(s, bufend, tokenbuf+1, FALSE);
8990e307
LW		 2033 if (expect == XOPERATOR)
2034 no_op("Array",s);
93a17b20 2035 if (tokenbuf[1]) {
a0d0e21e
LW		 2036 GV* gv;
2037
93a17b20 2038 tokenbuf[0] = '@';
463ee0b2 2039 expect = XOPERATOR;
93a17b20 2040 if (in_my) {
463ee0b2 2041 if (strchr(tokenbuf,':'))
748a9306 2042 croak(no_myglob,tokenbuf);
ed6116ce 2043 nextval[nexttoke].opval = newOP(OP_PADANY, 0);
93a17b20
LW		 2044 nextval[nexttoke].opval->op_targ = pad_allocmy(tokenbuf);
2045 force_next(PRIVATEREF);
2046 TERM('@');
2047 }
463ee0b2 2048 else if (!strchr(tokenbuf,':')) {
4633a7c4
LW		 2049 if (intuit_more(s)) {
2050 if (*s == '{')
2051 tokenbuf[0] = '%';
2052 }
93a17b20 2053 if (tmp = pad_findmy(tokenbuf)) {
ed6116ce 2054 nextval[nexttoke].opval = newOP(OP_PADANY, 0);
93a17b20
LW		 2055 nextval[nexttoke].opval->op_targ = tmp;
2056 force_next(PRIVATEREF);
2057 TERM('@');
2058 }
2059 }
a0d0e21e
LW		 2060
2061 /* Force them to make up their mind on "@foo". */
4633a7c4 2062 if (lex_state != LEX_NORMAL && !lex_brackets &&
a0d0e21e
LW		 2063 ( !(gv = gv_fetchpv(tokenbuf+1, FALSE, SVt_PVAV)) ||
2064 (*tokenbuf == '@'
2065 ? !GvAV(gv)
2066 : !GvHV(gv) )))
2067 {
2068 char tmpbuf[1024];
2069 sprintf(tmpbuf, "Literal @%s now requires backslash",tokenbuf+1);
2070 yyerror(tmpbuf);
2071 }
2072
2073 /* Warn about @ where they meant $. */
2074 if (dowarn) {
2075 if (*s == '[' || *s == '{') {
2076 char *t = s + 1;
2077 while (*t && (isALNUM(*t) || strchr(" \t$#+-'\"", *t)))
2078 t++;
2079 if (*t == '}' || *t == ']') {
2080 t++;
2081 bufptr = skipspace(bufptr);
2082 warn("Scalar value %.*s better written as $%.*s",
2083 t-bufptr, bufptr, t-bufptr-1, bufptr+1);
2084 }
93a17b20
LW		 2085 }
2086 }
a0d0e21e 2087 force_ident(tokenbuf+1, *tokenbuf);
93a17b20 2088 }
463ee0b2
LW		 2089 else {
2090 if (s == bufend)
2091 yyerror("Final @ should be \\@ or @name");
79072805 2092 PREREF('@');
463ee0b2 2093 }
79072805 2094 TERM('@');
378cc40b
LW		 2095
2096 case '/': /* may either be division or pattern */
2097 case '?': /* may either be conditional or pattern */
79072805 2098 if (expect != XOPERATOR) {
2f3197b3 2099 check_uni();
79072805
LW		 2100 s = scan_pat(s);
2101 TERM(sublex_start());
378cc40b
LW		 2102 }
2103 tmp = *s++;
a687059c 2104 if (tmp == '/')
79072805 2105 Mop(OP_DIVIDE);
378cc40b
LW		 2106 OPERATOR(tmp);
2107
2108 case '.':
748a9306
LW		 2109 if (lex_formbrack && lex_brackets == lex_formbrack && s[1] == '\n' &&
2110 (s == SvPVX(linestr) || s[-1] == '\n') ) {
85e6fe83 2111 lex_formbrack = 0;
8990e307 2112 expect = XSTATE;
79072805
LW		 2113 goto rightbracket;
2114 }
2115 if (expect == XOPERATOR || !isDIGIT(s[1])) {
378cc40b 2116 tmp = *s++;
a687059c
LW		 2117 if (*s == tmp) {
2118 s++;
2f3197b3
LW		 2119 if (*s == tmp) {
2120 s++;
79072805 2121 yylval.ival = OPf_SPECIAL;
2f3197b3
LW		 2122 }
2123 else
79072805 2124 yylval.ival = 0;
378cc40b 2125 OPERATOR(DOTDOT);
a687059c 2126 }
79072805 2127 if (expect != XOPERATOR)
2f3197b3 2128 check_uni();
79072805 2129 Aop(OP_CONCAT);
378cc40b
LW		 2130 }
2131 /* FALL THROUGH */
2132 case '0': case '1': case '2': case '3': case '4':
2133 case '5': case '6': case '7': case '8': case '9':
79072805 2134 s = scan_num(s);
8990e307
LW		 2135 if (expect == XOPERATOR)
2136 no_op("Number",s);
79072805
LW		 2137 TERM(THING);
2138
2139 case '\'':
8990e307 2140 s = scan_str(s);
463ee0b2 2141 if (expect == XOPERATOR) {
a0d0e21e
LW		 2142 if (lex_formbrack && lex_brackets == lex_formbrack) {
2143 expect = XTERM;
2144 depcom();
2145 return ','; /* grandfather non-comma-format format */
2146 }
463ee0b2 2147 else
8990e307 2148 no_op("String",s);
463ee0b2 2149 }
79072805 2150 if (!s)
85e6fe83 2151 missingterm((char*)0);
79072805
LW		 2152 yylval.ival = OP_CONST;
2153 TERM(sublex_start());
2154
2155 case '"':
8990e307 2156 s = scan_str(s);
463ee0b2 2157 if (expect == XOPERATOR) {
a0d0e21e
LW		 2158 if (lex_formbrack && lex_brackets == lex_formbrack) {
2159 expect = XTERM;
2160 depcom();
2161 return ','; /* grandfather non-comma-format format */
2162 }
463ee0b2 2163 else
8990e307 2164 no_op("String",s);
463ee0b2 2165 }
79072805 2166 if (!s)
85e6fe83 2167 missingterm((char*)0);
4633a7c4
LW		 2168 yylval.ival = OP_CONST;
2169 for (d = SvPV(lex_stuff, len); len; len--, d++) {
2170 if (*d == '$' || *d == '@' || *d == '\\') {
2171 yylval.ival = OP_STRINGIFY;
2172 break;
2173 }
2174 }
79072805
LW		 2175 TERM(sublex_start());
2176
2177 case '`':
2178 s = scan_str(s);
8990e307
LW		 2179 if (expect == XOPERATOR)
2180 no_op("Backticks",s);
79072805 2181 if (!s)
85e6fe83 2182 missingterm((char*)0);
79072805
LW		 2183 yylval.ival = OP_BACKTICK;
2184 set_csh();
2185 TERM(sublex_start());
2186
2187 case '\\':
2188 s++;
748a9306
LW		 2189 if (dowarn && lex_inwhat && isDIGIT(*s))
2190 warn("Can't use \\%c to mean $%c in expression", *s, *s);
8990e307
LW		 2191 if (expect == XOPERATOR)
2192 no_op("Backslash",s);
79072805
LW		 2193 OPERATOR(REFGEN);
2194
2195 case 'x':
2196 if (isDIGIT(s[1]) && expect == XOPERATOR) {
2197 s++;
2198 Mop(OP_REPEAT);
2f3197b3 2199 }
79072805
LW		 2200 goto keylookup;
2201
378cc40b 2202 case '_':
79072805
LW		 2203 case 'a': case 'A':
2204 case 'b': case 'B':
2205 case 'c': case 'C':
2206 case 'd': case 'D':
2207 case 'e': case 'E':
2208 case 'f': case 'F':
2209 case 'g': case 'G':
2210 case 'h': case 'H':
2211 case 'i': case 'I':
2212 case 'j': case 'J':
2213 case 'k': case 'K':
2214 case 'l': case 'L':
2215 case 'm': case 'M':
2216 case 'n': case 'N':
2217 case 'o': case 'O':
2218 case 'p': case 'P':
2219 case 'q': case 'Q':
2220 case 'r': case 'R':
2221 case 's': case 'S':
2222 case 't': case 'T':
2223 case 'u': case 'U':
2224 case 'v': case 'V':
2225 case 'w': case 'W':
2226 case 'X':
2227 case 'y': case 'Y':
2228 case 'z': case 'Z':
2229
2230 keylookup:
748a9306 2231 bufptr = s;
463ee0b2
LW		 2232 s = scan_word(s, tokenbuf, FALSE, &len);
2233
4633a7c4
LW		 2234 if (*s == ':' && s[1] == ':' && strNE(tokenbuf, "CORE"))
2235 goto just_a_word;
2236
a0d0e21e 2237 tmp = keyword(tokenbuf, len);
748a9306
LW		 2238
2239 /* Is this a word before a => operator? */
2240 d = s;
2241 while (d < bufend && (*d == ' ' || *d == '\t'))
2242 d++; /* no comments skipped here, or s### is misparsed */
2243 if (strnEQ(d,"=>",2)) {
2244 CLINE;
2245 if (dowarn && (tmp || perl_get_cv(tokenbuf, FALSE)))
2246 warn("Ambiguous use of %s => resolved to \"%s\" =>",
2247 tokenbuf, tokenbuf);
2248 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
2249 yylval.opval->op_private = OPpCONST_BARE;
2250 TERM(WORD);
2251 }
2252
a0d0e21e
LW		 2253 if (tmp < 0) { /* second-class keyword? */
2254 GV* gv;
2255 if (expect != XOPERATOR &&
2256 (*s != ':' || s[1] != ':') &&
2257 (gv = gv_fetchpv(tokenbuf,FALSE, SVt_PVCV)) &&
2258 (GvFLAGS(gv) & GVf_IMPORTED) &&
2259 GvCV(gv))
2260 {
2261 tmp = 0;
2262 }
2263 else
2264 tmp = -tmp;
2265 }
2266
2267 reserved_word:
2268 switch (tmp) {
79072805
LW		 2269
2270 default: /* not a keyword */
93a17b20
LW		 2271 just_a_word: {
2272 GV *gv;
748a9306 2273 char lastchar = (bufptr == oldoldbufptr ? 0 : bufptr[-1]);
8990e307
LW		 2274
2275 /* Get the rest if it looks like a package qualifier */
2276
a0d0e21e 2277 if (*s == '\'' || *s == ':' && s[1] == ':') {
463ee0b2 2278 s = scan_word(s, tokenbuf + len, TRUE, &len);
a0d0e21e
LW		 2279 if (!len)
2280 croak("Bad name after %s::", tokenbuf);
2281 }
8990e307
LW		 2282
2283 /* Do special processing at start of statement. */
2284
2285 if (expect == XSTATE) {
93a17b20 2286 while (isSPACE(*s)) s++;
8990e307 2287 if (*s == ':') { /* It's a label. */
a0d0e21e 2288 yylval.pval = savepv(tokenbuf);
93a17b20
LW		 2289 s++;
2290 CLINE;
2291 TOKEN(LABEL);
2292 }
2293 }
a0d0e21e 2294 else if (expect == XOPERATOR) {
463ee0b2
LW		 2295 if (bufptr == SvPVX(linestr)) {
2296 curcop->cop_line--;
2297 warn(warn_nosemi);
2298 curcop->cop_line++;
2299 }
2300 else
8990e307 2301 no_op("Bare word",s);
463ee0b2 2302 }
8990e307
LW		 2303
2304 /* Look for a subroutine with this name in current package. */
2305
85e6fe83 2306 gv = gv_fetchpv(tokenbuf,FALSE, SVt_PVCV);
8990e307 2307
a0d0e21e
LW		 2308 /* Presume this is going to be a bareword of some sort. */
2309
2310 CLINE;
2311 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
2312 yylval.opval->op_private = OPpCONST_BARE;
2313
8990e307
LW		 2314 /* See if it's the indirect object for a list operator. */
2315
a0d0e21e
LW		 2316 if (oldoldbufptr &&
2317 oldoldbufptr < bufptr &&
2318 (oldoldbufptr == last_lop || oldoldbufptr == last_uni) &&
2319 /* NO SKIPSPACE BEFORE HERE! */
2320 (expect == XREF ||
2321 (opargs[last_lop_op] >> OASHIFT & 7) == OA_FILEREF) )
2322 {
748a9306
LW		 2323 bool immediate_paren = *s == '(';
2324
a0d0e21e
LW		 2325 /* (Now we can afford to cross potential line boundary.) */
2326 s = skipspace(s);
2327
2328 /* Two barewords in a row may indicate method call. */
2329
2330 if ((isALPHA(*s) || *s == '$') && (tmp=intuit_method(s,gv)))
2331 return tmp;
2332
2333 /* If not a declared subroutine, it's an indirect object. */
2334 /* (But it's an indir obj regardless for sort.) */
2335
8e07c86e
AD		 2336 if ((last_lop_op == OP_SORT ||
2337 (!immediate_paren && (!gv || !GvCV(gv))) ) &&
2338 (last_lop_op != OP_MAPSTART && last_lop_op != OP_GREPSTART)){
748a9306
LW		 2339 expect = (last_lop == oldoldbufptr) ? XTERM : XOPERATOR;
2340 goto bareword;
93a17b20
LW		 2341 }
2342 }
8990e307
LW		 2343
2344 /* If followed by a paren, it's certainly a subroutine. */
2345
2346 expect = XOPERATOR;
2347 s = skipspace(s);
93a17b20 2348 if (*s == '(') {
79072805 2349 CLINE;
a0d0e21e 2350 nextval[nexttoke].opval = yylval.opval;
463ee0b2 2351 expect = XOPERATOR;
93a17b20 2352 force_next(WORD);
463ee0b2 2353 TOKEN('&');
79072805 2354 }
93a17b20 2355
a0d0e21e 2356 /* If followed by var or block, call it a method (unless sub) */
8990e307
LW		 2357
2358 if ((*s == '$' || *s == '{') && (!gv || !GvCV(gv))) {
463ee0b2 2359 last_lop = oldbufptr;
8990e307 2360 last_lop_op = OP_METHOD;
93a17b20 2361 PREBLOCK(METHOD);
463ee0b2
LW		 2362 }
2363
8990e307
LW		 2364 /* If followed by a bareword, see if it looks like indir obj. */
2365
a0d0e21e
LW		 2366 if ((isALPHA(*s) || *s == '$') && (tmp = intuit_method(s,gv)))
2367 return tmp;
93a17b20 2368
8990e307
LW		 2369 /* Not a method, so call it a subroutine (if defined) */
2370
2371 if (gv && GvCV(gv)) {
4633a7c4 2372 CV* cv = GvCV(gv);
8990e307
LW		 2373 nextval[nexttoke].opval = yylval.opval;
2374 if (*s == '(') {
2375 expect = XTERM;
2376 force_next(WORD);
2377 TOKEN('&');
2378 }
748a9306 2379 if (lastchar == '-')
c2960299 2380 warn("Ambiguous use of -%s resolved as -&%s()",
748a9306 2381 tokenbuf, tokenbuf);
8990e307 2382 last_lop = oldbufptr;
a0d0e21e 2383 last_lop_op = OP_ENTERSUB;
4633a7c4
LW		 2384 /* Is there a prototype? */
2385 if (SvPOK(cv)) {
2386 STRLEN len;
2387 char *proto = SvPV((SV*)cv, len);
2388 if (!len)
2389 TERM(FUNC0SUB);
2390 if (strEQ(proto, "$"))
2391 OPERATOR(UNIOPSUB);
2392 if (*proto == '&' && *s == '{') {
2393 sv_setpv(subname,"__ANON__");
2394 PREBLOCK(LSTOPSUB);
2395 }
2396 }
8990e307
LW		 2397 expect = XTERM;
2398 force_next(WORD);
2399 TOKEN(NOAMP);
2400 }
748a9306
LW		 2401
2402 if (hints & HINT_STRICT_SUBS &&
2403 lastchar != '-' &&
a0d0e21e
LW		 2404 strnNE(s,"->",2) &&
2405 last_lop_op != OP_ACCEPT &&
2406 last_lop_op != OP_PIPE_OP &&
2407 last_lop_op != OP_SOCKPAIR)
2408 {
2409 warn(
2410 "Bareword \"%s\" not allowed while \"strict subs\" in use",
85e6fe83
LW		 2411 tokenbuf);
2412 ++error_count;
2413 }
8990e307
LW		 2414
2415 /* Call it a bare word */
2416
748a9306
LW		 2417 bareword:
2418 if (dowarn) {
2419 if (lastchar != '-') {
2420 for (d = tokenbuf; *d && isLOWER(*d); d++) ;
2421 if (!*d)
2422 warn(warn_reserved, tokenbuf);
2423 }
2424 }
2425 if (lastchar && strchr("*%&", lastchar)) {
2426 warn("Operator or semicolon missing before %c%s",
2427 lastchar, tokenbuf);
c2960299 2428 warn("Ambiguous use of %c resolved as operator %c",
748a9306
LW		 2429 lastchar, lastchar);
2430 }
93a17b20 2431 TOKEN(WORD);
79072805 2432 }
79072805
LW		 2433
2434 case KEY___LINE__:
2435 case KEY___FILE__: {
2436 if (tokenbuf[2] == 'L')
2437 (void)sprintf(tokenbuf,"%ld",(long)curcop->cop_line);
2438 else
463ee0b2 2439 strcpy(tokenbuf, SvPVX(GvSV(curcop->cop_filegv)));
79072805
LW		 2440 yylval.opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(tokenbuf,0));
2441 TERM(THING);
2442 }
2443
e50aee73 2444 case KEY___DATA__:
79072805
LW		 2445 case KEY___END__: {
2446 GV *gv;
79072805
LW		 2447
2448 /*SUPPRESS 560*/
e50aee73
AD		 2449 if (!in_eval || tokenbuf[2] == 'D') {
2450 char dname[256];
2451 char *pname = "main";
2452 if (tokenbuf[2] == 'D')
2453 pname = HvNAME(curstash ? curstash : defstash);
2454 sprintf(dname,"%s::DATA", pname);
2455 gv = gv_fetchpv(dname,TRUE, SVt_PVIO);
79072805
LW		 2456 SvMULTI_on(gv);
2457 if (!GvIO(gv))
a0d0e21e
LW		 2458 GvIOp(gv) = newIO();
2459 IoIFP(GvIOp(gv)) = rsfp;
2460#if defined(HAS_FCNTL) && defined(F_SETFD)
2461 {
2462 int fd = fileno(rsfp);
2463 fcntl(fd,F_SETFD,fd >= 3);
2464 }
79072805
LW		 2465#endif
2466 if (preprocess)
a0d0e21e 2467 IoTYPE(GvIOp(gv)) = '|';
79072805 2468 else if ((FILE*)rsfp == stdin)
a0d0e21e 2469 IoTYPE(GvIOp(gv)) = '-';
79072805 2470 else
a0d0e21e 2471 IoTYPE(GvIOp(gv)) = '<';
79072805
LW		 2472 rsfp = Nullfp;
2473 }
2474 goto fake_eof;
e929a76b 2475 }
de3bb511 2476
8990e307 2477 case KEY_AUTOLOAD:
ed6116ce 2478 case KEY_DESTROY:
79072805
LW		 2479 case KEY_BEGIN:
2480 case KEY_END:
a0d0e21e 2481 if (expect == XSTATE) {
93a17b20
LW		 2482 s = bufptr;
2483 goto really_sub;
79072805
LW		 2484 }
2485 goto just_a_word;
2486
a0d0e21e
LW		 2487 case KEY_CORE:
2488 if (*s == ':' && s[1] == ':') {
2489 s += 2;
748a9306 2490 d = s;
a0d0e21e
LW		 2491 s = scan_word(s, tokenbuf, FALSE, &len);
2492 tmp = keyword(tokenbuf, len);
2493 if (tmp < 0)
2494 tmp = -tmp;
2495 goto reserved_word;
2496 }
2497 goto just_a_word;
2498
463ee0b2
LW		 2499 case KEY_abs:
2500 UNI(OP_ABS);
2501
79072805
LW		 2502 case KEY_alarm:
2503 UNI(OP_ALARM);
2504
2505 case KEY_accept:
a0d0e21e 2506 LOP(OP_ACCEPT,XTERM);
79072805 2507
463ee0b2
LW		 2508 case KEY_and:
2509 OPERATOR(ANDOP);
2510
79072805 2511 case KEY_atan2:
a0d0e21e 2512 LOP(OP_ATAN2,XTERM);
85e6fe83 2513
79072805 2514 case KEY_bind:
a0d0e21e 2515 LOP(OP_BIND,XTERM);
79072805
LW		 2516
2517 case KEY_binmode:
2518 UNI(OP_BINMODE);
2519
2520 case KEY_bless:
a0d0e21e 2521 LOP(OP_BLESS,XTERM);
79072805
LW		 2522
2523 case KEY_chop:
2524 UNI(OP_CHOP);
2525
2526 case KEY_continue:
2527 PREBLOCK(CONTINUE);
2528
2529 case KEY_chdir:
85e6fe83 2530 (void)gv_fetchpv("ENV",TRUE, SVt_PVHV); /* may use HOME */
79072805
LW		 2531 UNI(OP_CHDIR);
2532
2533 case KEY_close:
2534 UNI(OP_CLOSE);
2535
2536 case KEY_closedir:
2537 UNI(OP_CLOSEDIR);
2538
2539 case KEY_cmp:
2540 Eop(OP_SCMP);
2541
2542 case KEY_caller:
2543 UNI(OP_CALLER);
2544
2545 case KEY_crypt:
2546#ifdef FCRYPT
de3bb511
LW		 2547 if (!cryptseen++)
2548 init_des();
a687059c 2549#endif
a0d0e21e 2550 LOP(OP_CRYPT,XTERM);
79072805
LW		 2551
2552 case KEY_chmod:
748a9306
LW		 2553 if (dowarn) {
2554 for (d = s; d < bufend && (isSPACE(*d) || *d == '('); d++) ;
2555 if (*d != '0' && isDIGIT(*d))
2556 yywarn("chmod: mode argument is missing initial 0");
2557 }
a0d0e21e 2558 LOP(OP_CHMOD,XTERM);
79072805
LW		 2559
2560 case KEY_chown:
a0d0e21e 2561 LOP(OP_CHOWN,XTERM);
79072805
LW		 2562
2563 case KEY_connect:
a0d0e21e 2564 LOP(OP_CONNECT,XTERM);
79072805 2565
463ee0b2
LW		 2566 case KEY_chr:
2567 UNI(OP_CHR);
2568
79072805
LW		 2569 case KEY_cos:
2570 UNI(OP_COS);
2571
2572 case KEY_chroot:
2573 UNI(OP_CHROOT);
2574
2575 case KEY_do:
2576 s = skipspace(s);
2577 if (*s == '{')
a0d0e21e 2578 PRETERMBLOCK(DO);
79072805 2579 if (*s != '\'')
a0d0e21e 2580 s = force_word(s,WORD,FALSE,TRUE,FALSE);
378cc40b 2581 OPERATOR(DO);
79072805
LW		 2582
2583 case KEY_die:
a0d0e21e
LW		 2584 hints |= HINT_BLOCK_SCOPE;
2585 LOP(OP_DIE,XTERM);
79072805
LW		 2586
2587 case KEY_defined:
2588 UNI(OP_DEFINED);
2589
2590 case KEY_delete:
a0d0e21e 2591 UNI(OP_DELETE);
79072805
LW		 2592
2593 case KEY_dbmopen:
a0d0e21e
LW		 2594 gv_fetchpv("AnyDBM_File::ISA", GV_ADDMULTI, SVt_PVAV);
2595 LOP(OP_DBMOPEN,XTERM);
79072805
LW		 2596
2597 case KEY_dbmclose:
2598 UNI(OP_DBMCLOSE);
2599
2600 case KEY_dump:
a0d0e21e 2601 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 2602 LOOPX(OP_DUMP);
2603
2604 case KEY_else:
2605 PREBLOCK(ELSE);
2606
2607 case KEY_elsif:
2608 yylval.ival = curcop->cop_line;
2609 OPERATOR(ELSIF);
2610
2611 case KEY_eq:
2612 Eop(OP_SEQ);
2613
a0d0e21e
LW		 2614 case KEY_exists:
2615 UNI(OP_EXISTS);
2616
79072805
LW		 2617 case KEY_exit:
2618 UNI(OP_EXIT);
2619
2620 case KEY_eval:
79072805 2621 s = skipspace(s);
a0d0e21e 2622 expect = (*s == '{') ? XTERMBLOCK : XTERM;
463ee0b2 2623 UNIBRACK(OP_ENTEREVAL);
79072805
LW		 2624
2625 case KEY_eof:
2626 UNI(OP_EOF);
2627
2628 case KEY_exp:
2629 UNI(OP_EXP);
2630
2631 case KEY_each:
2632 UNI(OP_EACH);
2633
2634 case KEY_exec:
2635 set_csh();
a0d0e21e 2636 LOP(OP_EXEC,XREF);
79072805
LW		 2637
2638 case KEY_endhostent:
2639 FUN0(OP_EHOSTENT);
2640
2641 case KEY_endnetent:
2642 FUN0(OP_ENETENT);
2643
2644 case KEY_endservent:
2645 FUN0(OP_ESERVENT);
2646
2647 case KEY_endprotoent:
2648 FUN0(OP_EPROTOENT);
2649
2650 case KEY_endpwent:
2651 FUN0(OP_EPWENT);
2652
2653 case KEY_endgrent:
2654 FUN0(OP_EGRENT);
2655
2656 case KEY_for:
2657 case KEY_foreach:
2658 yylval.ival = curcop->cop_line;
2659 while (s < bufend && isSPACE(*s))
2660 s++;
2661 if (isIDFIRST(*s))
463ee0b2 2662 croak("Missing $ on loop variable");
79072805
LW		 2663 OPERATOR(FOR);
2664
2665 case KEY_formline:
a0d0e21e 2666 LOP(OP_FORMLINE,XTERM);
79072805
LW		 2667
2668 case KEY_fork:
2669 FUN0(OP_FORK);
2670
2671 case KEY_fcntl:
a0d0e21e 2672 LOP(OP_FCNTL,XTERM);
79072805
LW		 2673
2674 case KEY_fileno:
2675 UNI(OP_FILENO);
2676
2677 case KEY_flock:
a0d0e21e 2678 LOP(OP_FLOCK,XTERM);
79072805
LW		 2679
2680 case KEY_gt:
2681 Rop(OP_SGT);
2682
2683 case KEY_ge:
2684 Rop(OP_SGE);
2685
2686 case KEY_grep:
a0d0e21e 2687 LOP(OP_GREPSTART, *s == '(' ? XTERM : XREF);
79072805
LW		 2688
2689 case KEY_goto:
a0d0e21e 2690 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 2691 LOOPX(OP_GOTO);
2692
2693 case KEY_gmtime:
2694 UNI(OP_GMTIME);
2695
2696 case KEY_getc:
2697 UNI(OP_GETC);
2698
2699 case KEY_getppid:
2700 FUN0(OP_GETPPID);
2701
2702 case KEY_getpgrp:
2703 UNI(OP_GETPGRP);
2704
2705 case KEY_getpriority:
a0d0e21e 2706 LOP(OP_GETPRIORITY,XTERM);
79072805
LW		 2707
2708 case KEY_getprotobyname:
2709 UNI(OP_GPBYNAME);
2710
2711 case KEY_getprotobynumber:
a0d0e21e 2712 LOP(OP_GPBYNUMBER,XTERM);
79072805
LW		 2713
2714 case KEY_getprotoent:
2715 FUN0(OP_GPROTOENT);
2716
2717 case KEY_getpwent:
2718 FUN0(OP_GPWENT);
2719
2720 case KEY_getpwnam:
2721 FUN1(OP_GPWNAM);
2722
2723 case KEY_getpwuid:
2724 FUN1(OP_GPWUID);
2725
2726 case KEY_getpeername:
2727 UNI(OP_GETPEERNAME);
2728
2729 case KEY_gethostbyname:
2730 UNI(OP_GHBYNAME);
2731
2732 case KEY_gethostbyaddr:
a0d0e21e 2733 LOP(OP_GHBYADDR,XTERM);
79072805
LW		 2734
2735 case KEY_gethostent:
2736 FUN0(OP_GHOSTENT);
2737
2738 case KEY_getnetbyname:
2739 UNI(OP_GNBYNAME);
2740
2741 case KEY_getnetbyaddr:
a0d0e21e 2742 LOP(OP_GNBYADDR,XTERM);
79072805
LW		 2743
2744 case KEY_getnetent:
2745 FUN0(OP_GNETENT);
2746
2747 case KEY_getservbyname:
a0d0e21e 2748 LOP(OP_GSBYNAME,XTERM);
79072805
LW		 2749
2750 case KEY_getservbyport:
a0d0e21e 2751 LOP(OP_GSBYPORT,XTERM);
79072805
LW		 2752
2753 case KEY_getservent:
2754 FUN0(OP_GSERVENT);
2755
2756 case KEY_getsockname:
2757 UNI(OP_GETSOCKNAME);
2758
2759 case KEY_getsockopt:
a0d0e21e 2760 LOP(OP_GSOCKOPT,XTERM);
79072805
LW		 2761
2762 case KEY_getgrent:
2763 FUN0(OP_GGRENT);
2764
2765 case KEY_getgrnam:
2766 FUN1(OP_GGRNAM);
2767
2768 case KEY_getgrgid:
2769 FUN1(OP_GGRGID);
2770
2771 case KEY_getlogin:
2772 FUN0(OP_GETLOGIN);
2773
93a17b20 2774 case KEY_glob:
a0d0e21e
LW		 2775 set_csh();
2776 LOP(OP_GLOB,XTERM);
93a17b20 2777
79072805
LW		 2778 case KEY_hex:
2779 UNI(OP_HEX);
2780
2781 case KEY_if:
2782 yylval.ival = curcop->cop_line;
2783 OPERATOR(IF);
2784
2785 case KEY_index:
a0d0e21e 2786 LOP(OP_INDEX,XTERM);
79072805
LW		 2787
2788 case KEY_int:
2789 UNI(OP_INT);
2790
2791 case KEY_ioctl:
a0d0e21e 2792 LOP(OP_IOCTL,XTERM);
79072805
LW		 2793
2794 case KEY_join:
a0d0e21e 2795 LOP(OP_JOIN,XTERM);
79072805
LW		 2796
2797 case KEY_keys:
2798 UNI(OP_KEYS);
2799
2800 case KEY_kill:
a0d0e21e 2801 LOP(OP_KILL,XTERM);
79072805
LW		 2802
2803 case KEY_last:
a0d0e21e 2804 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805 2805 LOOPX(OP_LAST);
a0d0e21e 2806
79072805
LW		 2807 case KEY_lc:
2808 UNI(OP_LC);
2809
2810 case KEY_lcfirst:
2811 UNI(OP_LCFIRST);
2812
2813 case KEY_local:
93a17b20 2814 yylval.ival = 0;
79072805
LW		 2815 OPERATOR(LOCAL);
2816
2817 case KEY_length:
2818 UNI(OP_LENGTH);
2819
2820 case KEY_lt:
2821 Rop(OP_SLT);
2822
2823 case KEY_le:
2824 Rop(OP_SLE);
2825
2826 case KEY_localtime:
2827 UNI(OP_LOCALTIME);
2828
2829 case KEY_log:
2830 UNI(OP_LOG);
2831
2832 case KEY_link:
a0d0e21e 2833 LOP(OP_LINK,XTERM);
79072805
LW		 2834
2835 case KEY_listen:
a0d0e21e 2836 LOP(OP_LISTEN,XTERM);
79072805
LW		 2837
2838 case KEY_lstat:
2839 UNI(OP_LSTAT);
2840
2841 case KEY_m:
2842 s = scan_pat(s);
2843 TERM(sublex_start());
2844
a0d0e21e
LW		 2845 case KEY_map:
2846 LOP(OP_MAPSTART,XREF);
2847
79072805 2848 case KEY_mkdir:
a0d0e21e 2849 LOP(OP_MKDIR,XTERM);
79072805
LW		 2850
2851 case KEY_msgctl:
a0d0e21e 2852 LOP(OP_MSGCTL,XTERM);
79072805
LW		 2853
2854 case KEY_msgget:
a0d0e21e 2855 LOP(OP_MSGGET,XTERM);
79072805
LW		 2856
2857 case KEY_msgrcv:
a0d0e21e 2858 LOP(OP_MSGRCV,XTERM);
79072805
LW		 2859
2860 case KEY_msgsnd:
a0d0e21e 2861 LOP(OP_MSGSND,XTERM);
79072805 2862
93a17b20
LW		 2863 case KEY_my:
2864 in_my = TRUE;
2865 yylval.ival = 1;
2866 OPERATOR(LOCAL);
2867
79072805 2868 case KEY_next:
a0d0e21e 2869 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 2870 LOOPX(OP_NEXT);
2871
2872 case KEY_ne:
2873 Eop(OP_SNE);
2874
a0d0e21e
LW		 2875 case KEY_no:
2876 if (expect != XSTATE)
2877 yyerror("\"no\" not allowed in expression");
2878 s = force_word(s,WORD,FALSE,TRUE,FALSE);
2879 yylval.ival = 0;
2880 OPERATOR(USE);
2881
2882 case KEY_not:
2883 OPERATOR(NOTOP);
2884
79072805 2885 case KEY_open:
93a17b20
LW		 2886 s = skipspace(s);
2887 if (isIDFIRST(*s)) {
2888 char *t;
2889 for (d = s; isALNUM(*d); d++) ;
2890 t = skipspace(d);
2891 if (strchr("|&*+-=!?:.", *t))
2892 warn("Precedence problem: open %.*s should be open(%.*s)",
2893 d-s,s, d-s,s);
2894 }
a0d0e21e 2895 LOP(OP_OPEN,XTERM);
79072805 2896
463ee0b2 2897 case KEY_or:
a0d0e21e 2898 yylval.ival = OP_OR;
463ee0b2
LW		 2899 OPERATOR(OROP);
2900
79072805
LW		 2901 case KEY_ord:
2902 UNI(OP_ORD);
2903
2904 case KEY_oct:
2905 UNI(OP_OCT);
2906
2907 case KEY_opendir:
a0d0e21e 2908 LOP(OP_OPEN_DIR,XTERM);
79072805
LW		 2909
2910 case KEY_print:
2911 checkcomma(s,tokenbuf,"filehandle");
a0d0e21e 2912 LOP(OP_PRINT,XREF);
79072805
LW		 2913
2914 case KEY_printf:
2915 checkcomma(s,tokenbuf,"filehandle");
a0d0e21e 2916 LOP(OP_PRTF,XREF);
79072805
LW		 2917
2918 case KEY_push:
a0d0e21e 2919 LOP(OP_PUSH,XTERM);
79072805
LW		 2920
2921 case KEY_pop:
2922 UNI(OP_POP);
2923
a0d0e21e
LW		 2924 case KEY_pos:
2925 UNI(OP_POS);
2926
79072805 2927 case KEY_pack:
a0d0e21e 2928 LOP(OP_PACK,XTERM);
79072805
LW		 2929
2930 case KEY_package:
a0d0e21e 2931 s = force_word(s,WORD,FALSE,TRUE,FALSE);
79072805
LW		 2932 OPERATOR(PACKAGE);
2933
2934 case KEY_pipe:
a0d0e21e 2935 LOP(OP_PIPE_OP,XTERM);
79072805
LW		 2936
2937 case KEY_q:
2938 s = scan_str(s);
2939 if (!s)
85e6fe83 2940 missingterm((char*)0);
79072805
LW		 2941 yylval.ival = OP_CONST;
2942 TERM(sublex_start());
2943
a0d0e21e
LW		 2944 case KEY_quotemeta:
2945 UNI(OP_QUOTEMETA);
2946
8990e307
LW		 2947 case KEY_qw:
2948 s = scan_str(s);
2949 if (!s)
85e6fe83 2950 missingterm((char*)0);
8990e307
LW		 2951 force_next(')');
2952 nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, q(lex_stuff));
2953 lex_stuff = Nullsv;
2954 force_next(THING);
2955 force_next(',');
2956 nextval[nexttoke].opval = (OP*)newSVOP(OP_CONST, 0, newSVpv(" ",1));
2957 force_next(THING);
2958 force_next('(');
a0d0e21e
LW		 2959 yylval.ival = OP_SPLIT;
2960 CLINE;
2961 expect = XTERM;
2962 bufptr = s;
2963 last_lop = oldbufptr;
2964 last_lop_op = OP_SPLIT;
2965 return FUNC;
8990e307 2966
79072805
LW		 2967 case KEY_qq:
2968 s = scan_str(s);
2969 if (!s)
85e6fe83 2970 missingterm((char*)0);
a0d0e21e 2971 yylval.ival = OP_STRINGIFY;
ed6116ce
LW		 2972 if (SvIVX(lex_stuff) == '\'')
2973 SvIVX(lex_stuff) = 0; /* qq'$foo' should intepolate */
79072805
LW		 2974 TERM(sublex_start());
2975
2976 case KEY_qx:
2977 s = scan_str(s);
2978 if (!s)
85e6fe83 2979 missingterm((char*)0);
79072805
LW		 2980 yylval.ival = OP_BACKTICK;
2981 set_csh();
2982 TERM(sublex_start());
2983
2984 case KEY_return:
2985 OLDLOP(OP_RETURN);
2986
2987 case KEY_require:
748a9306 2988 *tokenbuf = '\0';
a0d0e21e 2989 s = force_word(s,WORD,TRUE,TRUE,FALSE);
748a9306
LW		 2990 if (isIDFIRST(*tokenbuf))
2991 gv_stashpv(tokenbuf, TRUE);
2992 else if (*s == '<')
a0d0e21e 2993 yyerror("<> should be quotes");
463ee0b2 2994 UNI(OP_REQUIRE);
79072805
LW		 2995
2996 case KEY_reset:
2997 UNI(OP_RESET);
2998
2999 case KEY_redo:
a0d0e21e 3000 s = force_word(s,WORD,TRUE,FALSE,FALSE);
79072805
LW		 3001 LOOPX(OP_REDO);
3002
3003 case KEY_rename:
a0d0e21e 3004 LOP(OP_RENAME,XTERM);
79072805
LW		 3005
3006 case KEY_rand:
3007 UNI(OP_RAND);
3008
3009 case KEY_rmdir:
3010 UNI(OP_RMDIR);
3011
3012 case KEY_rindex:
a0d0e21e 3013 LOP(OP_RINDEX,XTERM);
79072805
LW		 3014
3015 case KEY_read:
a0d0e21e 3016 LOP(OP_READ,XTERM);
79072805
LW		 3017
3018 case KEY_readdir:
3019 UNI(OP_READDIR);
3020
93a17b20
LW		 3021 case KEY_readline:
3022 set_csh();
3023 UNI(OP_READLINE);
3024
3025 case KEY_readpipe:
3026 set_csh();
3027 UNI(OP_BACKTICK);
3028
79072805
LW		 3029 case KEY_rewinddir:
3030 UNI(OP_REWINDDIR);
3031
3032 case KEY_recv:
a0d0e21e 3033 LOP(OP_RECV,XTERM);
79072805
LW		 3034
3035 case KEY_reverse:
a0d0e21e 3036 LOP(OP_REVERSE,XTERM);
79072805
LW		 3037
3038 case KEY_readlink:
3039 UNI(OP_READLINK);
3040
3041 case KEY_ref:
3042 UNI(OP_REF);
3043
3044 case KEY_s:
3045 s = scan_subst(s);
3046 if (yylval.opval)
3047 TERM(sublex_start());
3048 else
3049 TOKEN(1); /* force error */
3050
a0d0e21e
LW		 3051 case KEY_chomp:
3052 UNI(OP_CHOMP);
3053
79072805
LW		 3054 case KEY_scalar:
3055 UNI(OP_SCALAR);
3056
3057 case KEY_select:
a0d0e21e 3058 LOP(OP_SELECT,XTERM);
79072805
LW		 3059
3060 case KEY_seek:
a0d0e21e 3061 LOP(OP_SEEK,XTERM);
79072805
LW		 3062
3063 case KEY_semctl:
a0d0e21e 3064 LOP(OP_SEMCTL,XTERM);
79072805
LW		 3065
3066 case KEY_semget:
a0d0e21e 3067 LOP(OP_SEMGET,XTERM);
79072805
LW		 3068
3069 case KEY_semop:
a0d0e21e 3070 LOP(OP_SEMOP,XTERM);
79072805
LW		 3071
3072 case KEY_send:
a0d0e21e 3073 LOP(OP_SEND,XTERM);
79072805
LW		 3074
3075 case KEY_setpgrp:
a0d0e21e 3076 LOP(OP_SETPGRP,XTERM);
79072805
LW		 3077
3078 case KEY_setpriority:
a0d0e21e 3079 LOP(OP_SETPRIORITY,XTERM);
79072805
LW		 3080
3081 case KEY_sethostent:
3082 FUN1(OP_SHOSTENT);
3083
3084 case KEY_setnetent:
3085 FUN1(OP_SNETENT);
3086
3087 case KEY_setservent:
3088 FUN1(OP_SSERVENT);
3089
3090 case KEY_setprotoent:
3091 FUN1(OP_SPROTOENT);
3092
3093 case KEY_setpwent:
3094 FUN0(OP_SPWENT);
3095
3096 case KEY_setgrent:
3097 FUN0(OP_SGRENT);
3098
3099 case KEY_seekdir:
a0d0e21e 3100 LOP(OP_SEEKDIR,XTERM);
79072805
LW		 3101
3102 case KEY_setsockopt:
a0d0e21e 3103 LOP(OP_SSOCKOPT,XTERM);
79072805
LW		 3104
3105 case KEY_shift:
3106 UNI(OP_SHIFT);
3107
3108 case KEY_shmctl:
a0d0e21e 3109 LOP(OP_SHMCTL,XTERM);
79072805
LW		 3110
3111 case KEY_shmget:
a0d0e21e 3112 LOP(OP_SHMGET,XTERM);
79072805
LW		 3113
3114 case KEY_shmread:
a0d0e21e 3115 LOP(OP_SHMREAD,XTERM);
79072805
LW		 3116
3117 case KEY_shmwrite:
a0d0e21e 3118 LOP(OP_SHMWRITE,XTERM);
79072805
LW		 3119
3120 case KEY_shutdown:
a0d0e21e 3121 LOP(OP_SHUTDOWN,XTERM);
79072805
LW		 3122
3123 case KEY_sin:
3124 UNI(OP_SIN);
3125
3126 case KEY_sleep:
3127 UNI(OP_SLEEP);
3128
3129 case KEY_socket:
a0d0e21e 3130 LOP(OP_SOCKET,XTERM);
79072805
LW		 3131
3132 case KEY_socketpair:
a0d0e21e 3133 LOP(OP_SOCKPAIR,XTERM);
79072805
LW		 3134
3135 case KEY_sort:
3136 checkcomma(s,tokenbuf,"subroutine name");
3137 s = skipspace(s);
3138 if (*s == ';' || *s == ')') /* probably a close */
463ee0b2
LW		 3139 croak("sort is now a reserved word");
3140 expect = XTERM;
a0d0e21e
LW		 3141 s = force_word(s,WORD,TRUE,TRUE,TRUE);
3142 LOP(OP_SORT,XREF);
79072805
LW		 3143
3144 case KEY_split:
a0d0e21e 3145 LOP(OP_SPLIT,XTERM);
79072805
LW		 3146
3147 case KEY_sprintf:
a0d0e21e 3148 LOP(OP_SPRINTF,XTERM);
79072805
LW		 3149
3150 case KEY_splice:
a0d0e21e 3151 LOP(OP_SPLICE,XTERM);
79072805
LW		 3152
3153 case KEY_sqrt:
3154 UNI(OP_SQRT);
3155
3156 case KEY_srand:
3157 UNI(OP_SRAND);
3158
3159 case KEY_stat:
3160 UNI(OP_STAT);
3161
3162 case KEY_study:
3163 sawstudy++;
3164 UNI(OP_STUDY);
3165
3166 case KEY_substr:
a0d0e21e 3167 LOP(OP_SUBSTR,XTERM);
79072805
LW		 3168
3169 case KEY_format:
3170 case KEY_sub:
93a17b20 3171 really_sub:
79072805 3172 s = skipspace(s);
4633a7c4 3173
463ee0b2
LW		 3174 if (isIDFIRST(*s) || *s == '\'' || *s == ':') {
3175 char tmpbuf[128];
4633a7c4 3176 expect = XBLOCK;
463ee0b2
LW		 3177 d = scan_word(s, tmpbuf, TRUE, &len);
3178 if (strchr(tmpbuf, ':'))
3179 sv_setpv(subname, tmpbuf);
3180 else {
3181 sv_setsv(subname,curstname);
8990e307 3182 sv_catpvn(subname,"::",2);
463ee0b2
LW		 3183 sv_catpvn(subname,tmpbuf,len);
3184 }
a0d0e21e 3185 s = force_word(s,WORD,FALSE,TRUE,TRUE);
4633a7c4 3186 s = skipspace(s);
79072805 3187 }
4633a7c4
LW		 3188 else {
3189 expect = XTERMBLOCK;
79072805 3190 sv_setpv(subname,"?");
4633a7c4
LW		 3191 }
3192
3193 if (tmp == KEY_format) {
3194 s = skipspace(s);
3195 if (*s == '=')
3196 lex_formbrack = lex_brackets + 1;
3197 OPERATOR(FORMAT);
3198 }
79072805 3199
4633a7c4
LW		 3200 /* Look for a prototype */
3201 if (*s == '(') {
3202 s = scan_str(s);
3203 if (!s) {
3204 if (lex_stuff)
3205 SvREFCNT_dec(lex_stuff);
3206 lex_stuff = Nullsv;
3207 croak("Prototype not terminated");
3208 }
3209 nexttoke++;
3210 nextval[1] = nextval[0];
3211 nexttype[1] = nexttype[0];
3212 nextval[0].opval = (OP*)newSVOP(OP_CONST, 0, lex_stuff);
3213 nexttype[0] = THING;
3214 if (nexttoke == 1) {
3215 lex_defer = lex_state;
3216 lex_expect = expect;
3217 lex_state = LEX_KNOWNEXT;
3218 }
3219 lex_stuff = Nullsv;
3220 }
79072805 3221
4633a7c4
LW		 3222 if (*SvPV(subname,na) == '?') {
3223 sv_setpv(subname,"__ANON__");
3224 TOKEN(ANONSUB);
3225 }
3226 PREBLOCK(SUB);
79072805
LW		 3227
3228 case KEY_system:
3229 set_csh();
a0d0e21e 3230 LOP(OP_SYSTEM,XREF);
79072805
LW		 3231
3232 case KEY_symlink:
a0d0e21e 3233 LOP(OP_SYMLINK,XTERM);
79072805
LW		 3234
3235 case KEY_syscall:
a0d0e21e 3236 LOP(OP_SYSCALL,XTERM);
79072805
LW		 3237
3238 case KEY_sysread:
a0d0e21e 3239 LOP(OP_SYSREAD,XTERM);
79072805
LW		 3240
3241 case KEY_syswrite:
a0d0e21e 3242 LOP(OP_SYSWRITE,XTERM);
79072805
LW		 3243
3244 case KEY_tr:
3245 s = scan_trans(s);
3246 TERM(sublex_start());
3247
3248 case KEY_tell:
3249 UNI(OP_TELL);
3250
3251 case KEY_telldir:
3252 UNI(OP_TELLDIR);
3253
463ee0b2 3254 case KEY_tie:
a0d0e21e 3255 LOP(OP_TIE,XTERM);
463ee0b2 3256
79072805
LW		 3257 case KEY_time:
3258 FUN0(OP_TIME);
3259
3260 case KEY_times:
3261 FUN0(OP_TMS);
3262
3263 case KEY_truncate:
a0d0e21e 3264 LOP(OP_TRUNCATE,XTERM);
79072805
LW		 3265
3266 case KEY_uc:
3267 UNI(OP_UC);
3268
3269 case KEY_ucfirst:
3270 UNI(OP_UCFIRST);
3271
463ee0b2
LW		 3272 case KEY_untie:
3273 UNI(OP_UNTIE);
3274
79072805
LW		 3275 case KEY_until:
3276 yylval.ival = curcop->cop_line;
3277 OPERATOR(UNTIL);
3278
3279 case KEY_unless:
3280 yylval.ival = curcop->cop_line;
3281 OPERATOR(UNLESS);
3282
3283 case KEY_unlink:
a0d0e21e 3284 LOP(OP_UNLINK,XTERM);
79072805
LW		 3285
3286 case KEY_undef:
3287 UNI(OP_UNDEF);
3288
3289 case KEY_unpack:
a0d0e21e 3290 LOP(OP_UNPACK,XTERM);
79072805
LW		 3291
3292 case KEY_utime:
a0d0e21e 3293 LOP(OP_UTIME,XTERM);
79072805
LW		 3294
3295 case KEY_umask:
748a9306
LW		 3296 if (dowarn) {
3297 for (d = s; d < bufend && (isSPACE(*d) || *d == '('); d++) ;
3298 if (*d != '0' && isDIGIT(*d))
3299 yywarn("umask: argument is missing initial 0");
3300 }
79072805
LW		 3301 UNI(OP_UMASK);
3302
3303 case KEY_unshift:
a0d0e21e
LW		 3304 LOP(OP_UNSHIFT,XTERM);
3305
3306 case KEY_use:
3307 if (expect != XSTATE)
3308 yyerror("\"use\" not allowed in expression");
3309 s = force_word(s,WORD,FALSE,TRUE,FALSE);
3310 yylval.ival = 1;
3311 OPERATOR(USE);
79072805
LW		 3312
3313 case KEY_values:
3314 UNI(OP_VALUES);
3315
3316 case KEY_vec:
3317 sawvec = TRUE;
a0d0e21e 3318 LOP(OP_VEC,XTERM);
79072805
LW		 3319
3320 case KEY_while:
3321 yylval.ival = curcop->cop_line;
3322 OPERATOR(WHILE);
3323
3324 case KEY_warn:
a0d0e21e
LW		 3325 hints |= HINT_BLOCK_SCOPE;
3326 LOP(OP_WARN,XTERM);
79072805
LW		 3327
3328 case KEY_wait:
3329 FUN0(OP_WAIT);
3330
3331 case KEY_waitpid:
a0d0e21e 3332 LOP(OP_WAITPID,XTERM);
79072805
LW		 3333
3334 case KEY_wantarray:
3335 FUN0(OP_WANTARRAY);
3336
3337 case KEY_write:
85e6fe83 3338 gv_fetchpv("\f",TRUE, SVt_PV); /* Make sure $^L is defined */
79072805
LW		 3339 UNI(OP_ENTERWRITE);
3340
3341 case KEY_x:
3342 if (expect == XOPERATOR)
3343 Mop(OP_REPEAT);
3344 check_uni();
3345 goto just_a_word;
3346
a0d0e21e
LW		 3347 case KEY_xor:
3348 yylval.ival = OP_XOR;
3349 OPERATOR(OROP);
3350
79072805
LW		 3351 case KEY_y:
3352 s = scan_trans(s);
3353 TERM(sublex_start());
3354 }
3355 }
3356}
3357
3358I32
3359keyword(d, len)
3360register char *d;
3361I32 len;
3362{
3363 switch (*d) {
3364 case '_':
3365 if (d[1] == '_') {
a0d0e21e
LW		 3366 if (strEQ(d,"__LINE__")) return -KEY___LINE__;
3367 if (strEQ(d,"__FILE__")) return -KEY___FILE__;
e50aee73 3368 if (strEQ(d,"__DATA__")) return KEY___DATA__;
79072805
LW		 3369 if (strEQ(d,"__END__")) return KEY___END__;
3370 }
3371 break;
8990e307
LW		 3372 case 'A':
3373 if (strEQ(d,"AUTOLOAD")) return KEY_AUTOLOAD;
3374 break;
79072805 3375 case 'a':
463ee0b2
LW		 3376 switch (len) {
3377 case 3:
a0d0e21e
LW		 3378 if (strEQ(d,"and")) return -KEY_and;
3379 if (strEQ(d,"abs")) return -KEY_abs;
85e6fe83 3380 break;
463ee0b2 3381 case 5:
a0d0e21e
LW		 3382 if (strEQ(d,"alarm")) return -KEY_alarm;
3383 if (strEQ(d,"atan2")) return -KEY_atan2;
463ee0b2
LW		 3384 break;
3385 case 6:
a0d0e21e 3386 if (strEQ(d,"accept")) return -KEY_accept;
463ee0b2
LW		 3387 break;
3388 }
79072805
LW		 3389 break;
3390 case 'B':
3391 if (strEQ(d,"BEGIN")) return KEY_BEGIN;
93a17b20 3392 break;
79072805 3393 case 'b':
a0d0e21e
LW		 3394 if (strEQ(d,"bless")) return -KEY_bless;
3395 if (strEQ(d,"bind")) return -KEY_bind;
3396 if (strEQ(d,"binmode")) return -KEY_binmode;
3397 break;
3398 case 'C':
3399 if (strEQ(d,"CORE")) return -KEY_CORE;
79072805
LW		 3400 break;
3401 case 'c':
3402 switch (len) {
3403 case 3:
a0d0e21e
LW		 3404 if (strEQ(d,"cmp")) return -KEY_cmp;
3405 if (strEQ(d,"chr")) return -KEY_chr;
3406 if (strEQ(d,"cos")) return -KEY_cos;
79072805
LW		 3407 break;
3408 case 4:
3409 if (strEQ(d,"chop")) return KEY_chop;
3410 break;
3411 case 5:
a0d0e21e
LW		 3412 if (strEQ(d,"close")) return -KEY_close;
3413 if (strEQ(d,"chdir")) return -KEY_chdir;
3414 if (strEQ(d,"chomp")) return KEY_chomp;
3415 if (strEQ(d,"chmod")) return -KEY_chmod;
3416 if (strEQ(d,"chown")) return -KEY_chown;
3417 if (strEQ(d,"crypt")) return -KEY_crypt;
79072805
LW		 3418 break;
3419 case 6:
a0d0e21e
LW		 3420 if (strEQ(d,"chroot")) return -KEY_chroot;
3421 if (strEQ(d,"caller")) return -KEY_caller;
79072805
LW		 3422 break;
3423 case 7:
a0d0e21e 3424 if (strEQ(d,"connect")) return -KEY_connect;
79072805
LW		 3425 break;
3426 case 8:
a0d0e21e
LW		 3427 if (strEQ(d,"closedir")) return -KEY_closedir;
3428 if (strEQ(d,"continue")) return -KEY_continue;
79072805
LW		 3429 break;
3430 }
3431 break;
ed6116ce
LW		 3432 case 'D':
3433 if (strEQ(d,"DESTROY")) return KEY_DESTROY;
3434 break;
79072805
LW		 3435 case 'd':
3436 switch (len) {
3437 case 2:
3438 if (strEQ(d,"do")) return KEY_do;
3439 break;
3440 case 3:
a0d0e21e 3441 if (strEQ(d,"die")) return -KEY_die;
79072805
LW		 3442 break;
3443 case 4:
a0d0e21e 3444 if (strEQ(d,"dump")) return -KEY_dump;
79072805
LW		 3445 break;
3446 case 6:
3447 if (strEQ(d,"delete")) return KEY_delete;
3448 break;
3449 case 7:
3450 if (strEQ(d,"defined")) return KEY_defined;
a0d0e21e 3451 if (strEQ(d,"dbmopen")) return -KEY_dbmopen;
79072805
LW		 3452 break;
3453 case 8:
a0d0e21e 3454 if (strEQ(d,"dbmclose")) return -KEY_dbmclose;
79072805
LW		 3455 break;
3456 }
3457 break;
3458 case 'E':
a0d0e21e 3459 if (strEQ(d,"EQ")) { deprecate(d); return -KEY_eq;}
79072805
LW		 3460 if (strEQ(d,"END")) return KEY_END;
3461 break;
3462 case 'e':
3463 switch (len) {
3464 case 2:
a0d0e21e 3465 if (strEQ(d,"eq")) return -KEY_eq;
79072805
LW		 3466 break;
3467 case 3:
a0d0e21e
LW		 3468 if (strEQ(d,"eof")) return -KEY_eof;
3469 if (strEQ(d,"exp")) return -KEY_exp;
79072805
LW		 3470 break;
3471 case 4:
3472 if (strEQ(d,"else")) return KEY_else;
a0d0e21e 3473 if (strEQ(d,"exit")) return -KEY_exit;
79072805 3474 if (strEQ(d,"eval")) return KEY_eval;
a0d0e21e 3475 if (strEQ(d,"exec")) return -KEY_exec;
79072805
LW		 3476 if (strEQ(d,"each")) return KEY_each;
3477 break;
3478 case 5:
3479 if (strEQ(d,"elsif")) return KEY_elsif;
3480 break;
a0d0e21e
LW		 3481 case 6:
3482 if (strEQ(d,"exists")) return KEY_exists;
4633a7c4 3483 if (strEQ(d,"elseif")) warn("elseif should be elsif");
a0d0e21e 3484 break;
79072805 3485 case 8:
a0d0e21e
LW		 3486 if (strEQ(d,"endgrent")) return -KEY_endgrent;
3487 if (strEQ(d,"endpwent")) return -KEY_endpwent;
79072805
LW		 3488 break;
3489 case 9:
a0d0e21e 3490 if (strEQ(d,"endnetent")) return -KEY_endnetent;
79072805
LW		 3491 break;
3492 case 10:
a0d0e21e
LW		 3493 if (strEQ(d,"endhostent")) return -KEY_endhostent;
3494 if (strEQ(d,"endservent")) return -KEY_endservent;
79072805
LW		 3495 break;
3496 case 11:
a0d0e21e 3497 if (strEQ(d,"endprotoent")) return -KEY_endprotoent;
79072805 3498 break;
a687059c 3499 }
a687059c 3500 break;
79072805
LW		 3501 case 'f':
3502 switch (len) {
3503 case 3:
3504 if (strEQ(d,"for")) return KEY_for;
3505 break;
3506 case 4:
a0d0e21e 3507 if (strEQ(d,"fork")) return -KEY_fork;
79072805
LW		 3508 break;
3509 case 5:
a0d0e21e
LW		 3510 if (strEQ(d,"fcntl")) return -KEY_fcntl;
3511 if (strEQ(d,"flock")) return -KEY_flock;
79072805
LW		 3512 break;
3513 case 6:
3514 if (strEQ(d,"format")) return KEY_format;
a0d0e21e 3515 if (strEQ(d,"fileno")) return -KEY_fileno;
79072805
LW		 3516 break;
3517 case 7:
3518 if (strEQ(d,"foreach")) return KEY_foreach;
3519 break;
3520 case 8:
a0d0e21e 3521 if (strEQ(d,"formline")) return -KEY_formline;
79072805 3522 break;
378cc40b 3523 }
a687059c 3524 break;
79072805
LW		 3525 case 'G':
3526 if (len == 2) {
a0d0e21e
LW		 3527 if (strEQ(d,"GT")) { deprecate(d); return -KEY_gt;}
3528 if (strEQ(d,"GE")) { deprecate(d); return -KEY_ge;}
9f68db38 3529 }
a687059c 3530 break;
79072805 3531 case 'g':
a687059c
LW		 3532 if (strnEQ(d,"get",3)) {
3533 d += 3;
3534 if (*d == 'p') {
79072805
LW		 3535 switch (len) {
3536 case 7:
a0d0e21e
LW		 3537 if (strEQ(d,"ppid")) return -KEY_getppid;
3538 if (strEQ(d,"pgrp")) return -KEY_getpgrp;
79072805
LW		 3539 break;
3540 case 8:
a0d0e21e
LW		 3541 if (strEQ(d,"pwent")) return -KEY_getpwent;
3542 if (strEQ(d,"pwnam")) return -KEY_getpwnam;
3543 if (strEQ(d,"pwuid")) return -KEY_getpwuid;
79072805
LW		 3544 break;
3545 case 11:
a0d0e21e
LW		 3546 if (strEQ(d,"peername")) return -KEY_getpeername;
3547 if (strEQ(d,"protoent")) return -KEY_getprotoent;
3548 if (strEQ(d,"priority")) return -KEY_getpriority;
79072805
LW		 3549 break;
3550 case 14:
a0d0e21e 3551 if (strEQ(d,"protobyname")) return -KEY_getprotobyname;
79072805
LW		 3552 break;
3553 case 16:
a0d0e21e 3554 if (strEQ(d,"protobynumber"))return -KEY_getprotobynumber;
79072805
LW		 3555 break;
3556 }
a687059c
LW		 3557 }
3558 else if (*d == 'h') {
a0d0e21e
LW		 3559 if (strEQ(d,"hostbyname")) return -KEY_gethostbyname;
3560 if (strEQ(d,"hostbyaddr")) return -KEY_gethostbyaddr;
3561 if (strEQ(d,"hostent")) return -KEY_gethostent;
a687059c
LW		 3562 }
3563 else if (*d == 'n') {
a0d0e21e
LW		 3564 if (strEQ(d,"netbyname")) return -KEY_getnetbyname;
3565 if (strEQ(d,"netbyaddr")) return -KEY_getnetbyaddr;
3566 if (strEQ(d,"netent")) return -KEY_getnetent;
a687059c
LW		 3567 }
3568 else if (*d == 's') {
a0d0e21e
LW		 3569 if (strEQ(d,"servbyname")) return -KEY_getservbyname;
3570 if (strEQ(d,"servbyport")) return -KEY_getservbyport;
3571 if (strEQ(d,"servent")) return -KEY_getservent;
3572 if (strEQ(d,"sockname")) return -KEY_getsockname;
3573 if (strEQ(d,"sockopt")) return -KEY_getsockopt;
a687059c
LW		 3574 }
3575 else if (*d == 'g') {
a0d0e21e
LW		 3576 if (strEQ(d,"grent")) return -KEY_getgrent;
3577 if (strEQ(d,"grnam")) return -KEY_getgrnam;
3578 if (strEQ(d,"grgid")) return -KEY_getgrgid;
a687059c
LW		 3579 }
3580 else if (*d == 'l') {
a0d0e21e 3581 if (strEQ(d,"login")) return -KEY_getlogin;
a687059c 3582 }
a0d0e21e 3583 else if (strEQ(d,"c")) return -KEY_getc;
79072805 3584 break;
a687059c 3585 }
79072805
LW		 3586 switch (len) {
3587 case 2:
a0d0e21e
LW		 3588 if (strEQ(d,"gt")) return -KEY_gt;
3589 if (strEQ(d,"ge")) return -KEY_ge;
79072805
LW		 3590 break;
3591 case 4:
3592 if (strEQ(d,"grep")) return KEY_grep;
3593 if (strEQ(d,"goto")) return KEY_goto;
a0d0e21e 3594 if (strEQ(d,"glob")) return -KEY_glob;
79072805
LW		 3595 break;
3596 case 6:
a0d0e21e 3597 if (strEQ(d,"gmtime")) return -KEY_gmtime;
79072805 3598 break;
378cc40b 3599 }
a687059c 3600 break;
79072805 3601 case 'h':
a0d0e21e 3602 if (strEQ(d,"hex")) return -KEY_hex;
a687059c 3603 break;
79072805
LW		 3604 case 'i':
3605 switch (len) {
3606 case 2:
3607 if (strEQ(d,"if")) return KEY_if;
3608 break;
3609 case 3:
a0d0e21e 3610 if (strEQ(d,"int")) return -KEY_int;
79072805
LW		 3611 break;
3612 case 5:
a0d0e21e
LW		 3613 if (strEQ(d,"index")) return -KEY_index;
3614 if (strEQ(d,"ioctl")) return -KEY_ioctl;
79072805
LW		 3615 break;
3616 }
a687059c 3617 break;
79072805 3618 case 'j':
a0d0e21e 3619 if (strEQ(d,"join")) return -KEY_join;
a687059c 3620 break;
79072805
LW		 3621 case 'k':
3622 if (len == 4) {
3623 if (strEQ(d,"keys")) return KEY_keys;
a0d0e21e 3624 if (strEQ(d,"kill")) return -KEY_kill;
663a0e37 3625 }
79072805
LW		 3626 break;
3627 case 'L':
3628 if (len == 2) {
a0d0e21e
LW		 3629 if (strEQ(d,"LT")) { deprecate(d); return -KEY_lt;}
3630 if (strEQ(d,"LE")) { deprecate(d); return -KEY_le;}
378cc40b 3631 }
79072805
LW		 3632 break;
3633 case 'l':
3634 switch (len) {
3635 case 2:
a0d0e21e
LW		 3636 if (strEQ(d,"lt")) return -KEY_lt;
3637 if (strEQ(d,"le")) return -KEY_le;
3638 if (strEQ(d,"lc")) return -KEY_lc;
79072805
LW		 3639 break;
3640 case 3:
a0d0e21e 3641 if (strEQ(d,"log")) return -KEY_log;
79072805
LW		 3642 break;
3643 case 4:
3644 if (strEQ(d,"last")) return KEY_last;
a0d0e21e 3645 if (strEQ(d,"link")) return -KEY_link;
395c3793 3646 break;
79072805
LW		 3647 case 5:
3648 if (strEQ(d,"local")) return KEY_local;
a0d0e21e 3649 if (strEQ(d,"lstat")) return -KEY_lstat;
79072805
LW		 3650 break;
3651 case 6:
a0d0e21e
LW		 3652 if (strEQ(d,"length")) return -KEY_length;
3653 if (strEQ(d,"listen")) return -KEY_listen;
79072805
LW		 3654 break;
3655 case 7:
a0d0e21e 3656 if (strEQ(d,"lcfirst")) return -KEY_lcfirst;
79072805
LW		 3657 break;
3658 case 9:
a0d0e21e 3659 if (strEQ(d,"localtime")) return -KEY_localtime;
395c3793
LW		 3660 break;
3661 }
a687059c 3662 break;
79072805
LW		 3663 case 'm':
3664 switch (len) {
3665 case 1: return KEY_m;
93a17b20
LW		 3666 case 2:
3667 if (strEQ(d,"my")) return KEY_my;
3668 break;
a0d0e21e
LW		 3669 case 3:
3670 if (strEQ(d,"map")) return KEY_map;
3671 break;
79072805 3672 case 5:
a0d0e21e 3673 if (strEQ(d,"mkdir")) return -KEY_mkdir;
79072805
LW		 3674 break;
3675 case 6:
a0d0e21e
LW		 3676 if (strEQ(d,"msgctl")) return -KEY_msgctl;
3677 if (strEQ(d,"msgget")) return -KEY_msgget;
3678 if (strEQ(d,"msgrcv")) return -KEY_msgrcv;
3679 if (strEQ(d,"msgsnd")) return -KEY_msgsnd;
79072805
LW		 3680 break;
3681 }
a687059c 3682 break;
79072805 3683 case 'N':
a0d0e21e 3684 if (strEQ(d,"NE")) { deprecate(d); return -KEY_ne;}
a687059c 3685 break;
79072805
LW		 3686 case 'n':
3687 if (strEQ(d,"next")) return KEY_next;
a0d0e21e
LW		 3688 if (strEQ(d,"ne")) return -KEY_ne;
3689 if (strEQ(d,"not")) return -KEY_not;
3690 if (strEQ(d,"no")) return KEY_no;
a687059c 3691 break;
79072805
LW		 3692 case 'o':
3693 switch (len) {
463ee0b2 3694 case 2:
a0d0e21e 3695 if (strEQ(d,"or")) return -KEY_or;
463ee0b2 3696 break;
79072805 3697 case 3:
a0d0e21e
LW		 3698 if (strEQ(d,"ord")) return -KEY_ord;
3699 if (strEQ(d,"oct")) return -KEY_oct;
79072805
LW		 3700 break;
3701 case 4:
a0d0e21e 3702 if (strEQ(d,"open")) return -KEY_open;
79072805
LW		 3703 break;
3704 case 7:
a0d0e21e 3705 if (strEQ(d,"opendir")) return -KEY_opendir;
79072805 3706 break;
fe14fcc3 3707 }
a687059c 3708 break;
79072805
LW		 3709 case 'p':
3710 switch (len) {
3711 case 3:
3712 if (strEQ(d,"pop")) return KEY_pop;
a0d0e21e 3713 if (strEQ(d,"pos")) return KEY_pos;
79072805
LW		 3714 break;
3715 case 4:
3716 if (strEQ(d,"push")) return KEY_push;
a0d0e21e
LW		 3717 if (strEQ(d,"pack")) return -KEY_pack;
3718 if (strEQ(d,"pipe")) return -KEY_pipe;
79072805
LW		 3719 break;
3720 case 5:
3721 if (strEQ(d,"print")) return KEY_print;
3722 break;
3723 case 6:
3724 if (strEQ(d,"printf")) return KEY_printf;
3725 break;
3726 case 7:
3727 if (strEQ(d,"package")) return KEY_package;
3728 break;
663a0e37 3729 }
79072805
LW		 3730 break;
3731 case 'q':
3732 if (len <= 2) {
3733 if (strEQ(d,"q")) return KEY_q;
3734 if (strEQ(d,"qq")) return KEY_qq;
8990e307 3735 if (strEQ(d,"qw")) return KEY_qw;
79072805 3736 if (strEQ(d,"qx")) return KEY_qx;
663a0e37 3737 }
a0d0e21e 3738 else if (strEQ(d,"quotemeta")) return -KEY_quotemeta;
79072805
LW		 3739 break;
3740 case 'r':
3741 switch (len) {
3742 case 3:
a0d0e21e 3743 if (strEQ(d,"ref")) return -KEY_ref;
79072805
LW		 3744 break;
3745 case 4:
a0d0e21e
LW		 3746 if (strEQ(d,"read")) return -KEY_read;
3747 if (strEQ(d,"rand")) return -KEY_rand;
3748 if (strEQ(d,"recv")) return -KEY_recv;
79072805
LW		 3749 if (strEQ(d,"redo")) return KEY_redo;
3750 break;
3751 case 5:
a0d0e21e
LW		 3752 if (strEQ(d,"rmdir")) return -KEY_rmdir;
3753 if (strEQ(d,"reset")) return -KEY_reset;
79072805
LW		 3754 break;
3755 case 6:
3756 if (strEQ(d,"return")) return KEY_return;
a0d0e21e
LW		 3757 if (strEQ(d,"rename")) return -KEY_rename;
3758 if (strEQ(d,"rindex")) return -KEY_rindex;
79072805
LW		 3759 break;
3760 case 7:
a0d0e21e
LW		 3761 if (strEQ(d,"require")) return -KEY_require;
3762 if (strEQ(d,"reverse")) return -KEY_reverse;
3763 if (strEQ(d,"readdir")) return -KEY_readdir;
79072805
LW		 3764 break;
3765 case 8:
a0d0e21e
LW		 3766 if (strEQ(d,"readlink")) return -KEY_readlink;
3767 if (strEQ(d,"readline")) return -KEY_readline;
3768 if (strEQ(d,"readpipe")) return -KEY_readpipe;
79072805
LW		 3769 break;
3770 case 9:
a0d0e21e 3771 if (strEQ(d,"rewinddir")) return -KEY_rewinddir;
79072805 3772 break;
a687059c 3773 }
79072805
LW		 3774 break;
3775 case 's':
a687059c 3776 switch (d[1]) {
79072805 3777 case 0: return KEY_s;
a687059c 3778 case 'c':
79072805 3779 if (strEQ(d,"scalar")) return KEY_scalar;
a687059c
LW		 3780 break;
3781 case 'e':
79072805
LW		 3782 switch (len) {
3783 case 4:
a0d0e21e
LW		 3784 if (strEQ(d,"seek")) return -KEY_seek;
3785 if (strEQ(d,"send")) return -KEY_send;
79072805
LW		 3786 break;
3787 case 5:
a0d0e21e 3788 if (strEQ(d,"semop")) return -KEY_semop;
79072805
LW		 3789 break;
3790 case 6:
a0d0e21e
LW		 3791 if (strEQ(d,"select")) return -KEY_select;
3792 if (strEQ(d,"semctl")) return -KEY_semctl;
3793 if (strEQ(d,"semget")) return -KEY_semget;
79072805
LW		 3794 break;
3795 case 7:
a0d0e21e
LW		 3796 if (strEQ(d,"setpgrp")) return -KEY_setpgrp;
3797 if (strEQ(d,"seekdir")) return -KEY_seekdir;
79072805
LW		 3798 break;
3799 case 8:
a0d0e21e
LW		 3800 if (strEQ(d,"setpwent")) return -KEY_setpwent;
3801 if (strEQ(d,"setgrent")) return -KEY_setgrent;
79072805
LW		 3802 break;
3803 case 9:
a0d0e21e 3804 if (strEQ(d,"setnetent")) return -KEY_setnetent;
79072805
LW		 3805 break;
3806 case 10:
a0d0e21e
LW		 3807 if (strEQ(d,"setsockopt")) return -KEY_setsockopt;
3808 if (strEQ(d,"sethostent")) return -KEY_sethostent;
3809 if (strEQ(d,"setservent")) return -KEY_setservent;
79072805
LW		 3810 break;
3811 case 11:
a0d0e21e
LW		 3812 if (strEQ(d,"setpriority")) return -KEY_setpriority;
3813 if (strEQ(d,"setprotoent")) return -KEY_setprotoent;
79072805
LW		 3814 break;
3815 }
a687059c
LW		 3816 break;
3817 case 'h':
79072805
LW		 3818 switch (len) {
3819 case 5:
3820 if (strEQ(d,"shift")) return KEY_shift;
3821 break;
3822 case 6:
a0d0e21e
LW		 3823 if (strEQ(d,"shmctl")) return -KEY_shmctl;
3824 if (strEQ(d,"shmget")) return -KEY_shmget;
79072805
LW		 3825 break;
3826 case 7:
a0d0e21e 3827 if (strEQ(d,"shmread")) return -KEY_shmread;
79072805
LW		 3828 break;
3829 case 8:
a0d0e21e
LW		 3830 if (strEQ(d,"shmwrite")) return -KEY_shmwrite;
3831 if (strEQ(d,"shutdown")) return -KEY_shutdown;
79072805
LW		 3832 break;
3833 }
a687059c
LW		 3834 break;
3835 case 'i':
a0d0e21e 3836 if (strEQ(d,"sin")) return -KEY_sin;
a687059c
LW		 3837 break;
3838 case 'l':
a0d0e21e 3839 if (strEQ(d,"sleep")) return -KEY_sleep;
a687059c
LW		 3840 break;
3841 case 'o':
79072805 3842 if (strEQ(d,"sort")) return KEY_sort;
a0d0e21e
LW		 3843 if (strEQ(d,"socket")) return -KEY_socket;
3844 if (strEQ(d,"socketpair")) return -KEY_socketpair;
a687059c
LW		 3845 break;
3846 case 'p':
79072805 3847 if (strEQ(d,"split")) return KEY_split;
a0d0e21e 3848 if (strEQ(d,"sprintf")) return -KEY_sprintf;
79072805 3849 if (strEQ(d,"splice")) return KEY_splice;
a687059c
LW		 3850 break;
3851 case 'q':
a0d0e21e 3852 if (strEQ(d,"sqrt")) return -KEY_sqrt;
a687059c
LW		 3853 break;
3854 case 'r':
a0d0e21e 3855 if (strEQ(d,"srand")) return -KEY_srand;
a687059c
LW		 3856 break;
3857 case 't':
a0d0e21e 3858 if (strEQ(d,"stat")) return -KEY_stat;
79072805 3859 if (strEQ(d,"study")) return KEY_study;
a687059c
LW		 3860 break;
3861 case 'u':
a0d0e21e 3862 if (strEQ(d,"substr")) return -KEY_substr;
79072805 3863 if (strEQ(d,"sub")) return KEY_sub;
a687059c
LW		 3864 break;
3865 case 'y':
79072805
LW		 3866 switch (len) {
3867 case 6:
a0d0e21e 3868 if (strEQ(d,"system")) return -KEY_system;
79072805
LW		 3869 break;
3870 case 7:
a0d0e21e
LW		 3871 if (strEQ(d,"sysread")) return -KEY_sysread;
3872 if (strEQ(d,"symlink")) return -KEY_symlink;
3873 if (strEQ(d,"syscall")) return -KEY_syscall;
79072805
LW		 3874 break;
3875 case 8:
a0d0e21e 3876 if (strEQ(d,"syswrite")) return -KEY_syswrite;
79072805 3877 break;
a687059c 3878 }
a687059c
LW		 3879 break;
3880 }
3881 break;
79072805
LW		 3882 case 't':
3883 switch (len) {
3884 case 2:
3885 if (strEQ(d,"tr")) return KEY_tr;
3886 break;
463ee0b2
LW		 3887 case 3:
3888 if (strEQ(d,"tie")) return KEY_tie;
3889 break;