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