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