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