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