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