pp_hot.c

   1 /*    pp_hot.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  * Then he heard Merry change the note, and up went the Horn-cry of Buckland,
  12  * shaking the air.
  13  *
  14  *            Awake!  Awake!  Fear, Fire, Foes!  Awake!
  15  *                     Fire, Foes!  Awake!
  16  */
  17
  18 #include "EXTERN.h"
  19 #include "perl.h"
  20
  21 /* Hot code. */
  22
  23 PP(pp_const)
  24 {
  25     dSP;
  26     XPUSHs(cSVOP->op_sv);
  27     RETURN;
  28 }
  29
  30 PP(pp_nextstate)
  31 {
  32     curcop = (COP*)op;
  33     TAINT_NOT;          /* Each statement is presumed innocent */
  34     stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
  35     FREETMPS;
  36     return NORMAL;
  37 }
  38
  39 PP(pp_gvsv)
  40 {
  41     dSP;
  42     EXTEND(sp,1);
  43     if (op->op_private & OPpLVAL_INTRO)
  44         PUSHs(save_scalar(cGVOP->op_gv));
  45     else
  46         PUSHs(GvSV(cGVOP->op_gv));
  47     RETURN;
  48 }
  49
  50 PP(pp_null)
  51 {
  52     return NORMAL;
  53 }
  54
  55 PP(pp_pushmark)
  56 {
  57     PUSHMARK(stack_sp);
  58     return NORMAL;
  59 }
  60
  61 PP(pp_stringify)
  62 {
  63     dSP; dTARGET;
  64     STRLEN len;
  65     char *s;
  66     s = SvPV(TOPs,len);
  67     sv_setpvn(TARG,s,len);
  68     SETTARG;
  69     RETURN;
  70 }
  71
  72 PP(pp_gv)
  73 {
  74     dSP;
  75     XPUSHs((SV*)cGVOP->op_gv);
  76     RETURN;
  77 }
  78
  79 PP(pp_and)
  80 {
  81     dSP;
  82     if (!SvTRUE(TOPs))
  83         RETURN;
  84     else {
  85         --SP;
  86         RETURNOP(cLOGOP->op_other);
  87     }
  88 }
  89
  90 PP(pp_sassign)
  91 {
  92     dSP; dPOPTOPssrl;
  93     if (op->op_private & OPpASSIGN_BACKWARDS) {
  94         SV *temp;
  95         temp = left; left = right; right = temp;
  96     }
  97     if (tainting && tainted && (!SvGMAGICAL(left) || !SvSMAGICAL(left) ||
  98                                 !mg_find(left, 't'))) {
  99         TAINT_NOT;
 100     }
 101     SvSetSV(right, left);
 102     SvSETMAGIC(right);
 103     SETs(right);
 104     RETURN;
 105 }
 106
 107 PP(pp_cond_expr)
 108 {
 109     dSP;
 110     if (SvTRUEx(POPs))
 111         RETURNOP(cCONDOP->op_true);
 112     else
 113         RETURNOP(cCONDOP->op_false);
 114 }
 115
 116 PP(pp_unstack)
 117 {
 118     I32 oldsave;
 119     TAINT_NOT;          /* Each statement is presumed innocent */
 120     stack_sp = stack_base + cxstack[cxstack_ix].blk_oldsp;
 121     FREETMPS;
 122     oldsave = scopestack[scopestack_ix - 1];
 123     LEAVE_SCOPE(oldsave);
 124     return NORMAL;
 125 }
 126
 127 PP(pp_seq)
 128 {
 129     dSP; tryAMAGICbinSET(seq,0);
 130     {
 131       dPOPTOPssrl;
 132       SETs( sv_eq(left, right) ? &sv_yes : &sv_no );
 133       RETURN;
 134     }
 135 }
 136
 137 PP(pp_concat)
 138 {
 139     dSP; dATARGET; dPOPTOPssrl;
 140     STRLEN len;
 141     char *s;
 142     if (TARG != left) {
 143         s = SvPV(left,len);
 144         sv_setpvn(TARG,s,len);
 145     }
 146     s = SvPV(right,len);
 147     sv_catpvn(TARG,s,len);
 148     SETTARG;
 149     RETURN;
 150 }
 151
 152 PP(pp_padsv)
 153 {
 154     dSP; dTARGET;
 155     XPUSHs(TARG);
 156     if (op->op_private & OPpLVAL_INTRO)
 157         SAVECLEARSV(curpad[op->op_targ]);
 158     RETURN;
 159 }
 160
 161 PP(pp_readline)
 162 {
 163     last_in_gv = (GV*)(*stack_sp--);
 164     return do_readline();
 165 }
 166
 167 PP(pp_eq)
 168 {
 169     dSP; tryAMAGICbinSET(eq,0);
 170     {
 171       dPOPnv;
 172       SETs((TOPn == value) ? &sv_yes : &sv_no);
 173       RETURN;
 174     }
 175 }
 176
 177 PP(pp_preinc)
 178 {
 179     dSP;
 180     sv_inc(TOPs);
 181     SvSETMAGIC(TOPs);
 182     return NORMAL;
 183 }
 184
 185 PP(pp_or)
 186 {
 187     dSP;
 188     if (SvTRUE(TOPs))
 189         RETURN;
 190     else {
 191         --SP;
 192         RETURNOP(cLOGOP->op_other);
 193     }
 194 }
 195
 196 PP(pp_add)
 197 {
 198     dSP; dATARGET; tryAMAGICbin(add,opASSIGN);
 199     {
 200       dPOPTOPnnrl;
 201       SETn( left + right );
 202       RETURN;
 203     }
 204 }
 205
 206 PP(pp_aelemfast)
 207 {
 208     dSP;
 209     AV *av = GvAV((GV*)cSVOP->op_sv);
 210     SV** svp = av_fetch(av, op->op_private, op->op_flags & OPf_MOD);
 211     PUSHs(svp ? *svp : &sv_undef);
 212     RETURN;
 213 }
 214
 215 PP(pp_join)
 216 {
 217     dSP; dMARK; dTARGET;
 218     MARK++;
 219     do_join(TARG, *MARK, MARK, SP);
 220     SP = MARK;
 221     SETs(TARG);
 222     RETURN;
 223 }
 224
 225 PP(pp_pushre)
 226 {
 227     dSP;
 228     XPUSHs((SV*)op);
 229     RETURN;
 230 }
 231
 232 /* Oversized hot code. */
 233
 234 PP(pp_print)
 235 {
 236     dSP; dMARK; dORIGMARK;
 237     GV *gv;
 238     IO *io;
 239     register FILE *fp;
 240
 241     if (op->op_flags & OPf_STACKED)
 242         gv = (GV*)*++MARK;
 243     else
 244         gv = defoutgv;
 245     if (!(io = GvIO(gv))) {
 246         if (dowarn)
 247             warn("Filehandle %s never opened", GvNAME(gv));
 248         errno = EBADF;
 249         goto just_say_no;
 250     }
 251     else if (!(fp = IoOFP(io))) {
 252         if (dowarn)  {
 253             if (IoIFP(io))
 254                 warn("Filehandle %s opened only for input", GvNAME(gv));
 255             else
 256                 warn("print on closed filehandle %s", GvNAME(gv));
 257         }
 258         errno = EBADF;
 259         goto just_say_no;
 260     }
 261     else {
 262         MARK++;
 263         if (ofslen) {
 264             while (MARK <= SP) {
 265                 if (!do_print(*MARK, fp))
 266                     break;
 267                 MARK++;
 268                 if (MARK <= SP) {
 269                     if (fwrite1(ofs, 1, ofslen, fp) == 0 || ferror(fp)) {
 270                         MARK--;
 271                         break;
 272                     }
 273                 }
 274             }
 275         }
 276         else {
 277             while (MARK <= SP) {
 278                 if (!do_print(*MARK, fp))
 279                     break;
 280                 MARK++;
 281             }
 282         }
 283         if (MARK <= SP)
 284             goto just_say_no;
 285         else {
 286             if (orslen)
 287                 if (fwrite1(ors, 1, orslen, fp) == 0 || ferror(fp))
 288                     goto just_say_no;
 289
 290             if (IoFLAGS(io) & IOf_FLUSH)
 291                 if (fflush(fp) == EOF)
 292                     goto just_say_no;
 293         }
 294     }
 295     SP = ORIGMARK;
 296     PUSHs(&sv_yes);
 297     RETURN;
 298
 299   just_say_no:
 300     SP = ORIGMARK;
 301     PUSHs(&sv_undef);
 302     RETURN;
 303 }
 304
 305 PP(pp_rv2av)
 306 {
 307     dSP; dPOPss;
 308
 309     AV *av;
 310
 311     if (SvROK(sv)) {
 312       wasref:
 313         av = (AV*)SvRV(sv);
 314         if (SvTYPE(av) != SVt_PVAV)
 315             DIE("Not an ARRAY reference");
 316         if (op->op_private & OPpLVAL_INTRO)
 317             av = (AV*)save_svref((SV**)sv);
 318         if (op->op_flags & OPf_REF) {
 319             PUSHs((SV*)av);
 320             RETURN;
 321         }
 322     }
 323     else {
 324         if (SvTYPE(sv) == SVt_PVAV) {
 325             av = (AV*)sv;
 326             if (op->op_flags & OPf_REF) {
 327                 PUSHs((SV*)av);
 328                 RETURN;
 329             }
 330         }
 331         else {
 332             if (SvTYPE(sv) != SVt_PVGV) {
 333                 if (SvGMAGICAL(sv)) {
 334                     mg_get(sv);
 335                     if (SvROK(sv))
 336                         goto wasref;
 337                 }
 338                 if (!SvOK(sv)) {
 339                     if (op->op_flags & OPf_REF ||
 340                       op->op_private & HINT_STRICT_REFS)
 341                         DIE(no_usym, "an ARRAY");
 342                     RETPUSHUNDEF;
 343                 }
 344                 if (op->op_private & HINT_STRICT_REFS)
 345                     DIE(no_symref, "an ARRAY");
 346                 sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE, SVt_PVAV);
 347             }
 348             av = GvAVn(sv);
 349             if (op->op_private & OPpLVAL_INTRO)
 350                 av = save_ary(sv);
 351             if (op->op_flags & OPf_REF) {
 352                 PUSHs((SV*)av);
 353                 RETURN;
 354             }
 355         }
 356     }
 357
 358     if (GIMME == G_ARRAY) {
 359         I32 maxarg = AvFILL(av) + 1;
 360         EXTEND(SP, maxarg);
 361         Copy(AvARRAY(av), SP+1, maxarg, SV*);
 362         SP += maxarg;
 363     }
 364     else {
 365         dTARGET;
 366         I32 maxarg = AvFILL(av) + 1;
 367         PUSHi(maxarg);
 368     }
 369     RETURN;
 370 }
 371
 372 PP(pp_rv2hv)
 373 {
 374
 375     dSP; dTOPss;
 376
 377     HV *hv;
 378
 379     if (SvROK(sv)) {
 380       wasref:
 381         hv = (HV*)SvRV(sv);
 382         if (SvTYPE(hv) != SVt_PVHV)
 383             DIE("Not a HASH reference");
 384         if (op->op_private & OPpLVAL_INTRO)
 385             hv = (HV*)save_svref((SV**)sv);
 386         if (op->op_flags & OPf_REF) {
 387             SETs((SV*)hv);
 388             RETURN;
 389         }
 390     }
 391     else {
 392         if (SvTYPE(sv) == SVt_PVHV) {
 393             hv = (HV*)sv;
 394             if (op->op_flags & OPf_REF) {
 395                 SETs((SV*)hv);
 396                 RETURN;
 397             }
 398         }
 399         else {
 400             if (SvTYPE(sv) != SVt_PVGV) {
 401                 if (SvGMAGICAL(sv)) {
 402                     mg_get(sv);
 403                     if (SvROK(sv))
 404                         goto wasref;
 405                 }
 406                 if (!SvOK(sv)) {
 407                     if (op->op_flags & OPf_REF ||
 408                       op->op_private & HINT_STRICT_REFS)
 409                         DIE(no_usym, "a HASH");
 410                     RETSETUNDEF;
 411                 }
 412                 if (op->op_private & HINT_STRICT_REFS)
 413                     DIE(no_symref, "a HASH");
 414                 sv = (SV*)gv_fetchpv(SvPV(sv, na), TRUE, SVt_PVHV);
 415             }
 416             hv = GvHVn(sv);
 417             if (op->op_private & OPpLVAL_INTRO)
 418                 hv = save_hash(sv);
 419             if (op->op_flags & OPf_REF) {
 420                 SETs((SV*)hv);
 421                 RETURN;
 422             }
 423         }
 424     }
 425
 426     if (GIMME == G_ARRAY) { /* array wanted */
 427         *stack_sp = (SV*)hv;
 428         return do_kv(ARGS);
 429     }
 430     else {
 431         dTARGET;
 432         if (HvFILL(hv)) {
 433             sprintf(buf, "%d/%d", HvFILL(hv), HvMAX(hv)+1);
 434             sv_setpv(TARG, buf);
 435         }
 436         else
 437             sv_setiv(TARG, 0);
 438         SETTARG;
 439         RETURN;
 440     }
 441 }
 442
 443 PP(pp_aassign)
 444 {
 445     dSP;
 446     SV **lastlelem = stack_sp;
 447     SV **lastrelem = stack_base + POPMARK;
 448     SV **firstrelem = stack_base + POPMARK + 1;
 449     SV **firstlelem = lastrelem + 1;
 450
 451     register SV **relem;
 452     register SV **lelem;
 453
 454     register SV *sv;
 455     register AV *ary;
 456
 457     HV *hash;
 458     I32 i;
 459     int magic;
 460
 461     delaymagic = DM_DELAY;              /* catch simultaneous items */
 462
 463     /* If there's a common identifier on both sides we have to take
 464      * special care that assigning the identifier on the left doesn't
 465      * clobber a value on the right that's used later in the list.
 466      */
 467     if (op->op_private & OPpASSIGN_COMMON) {
 468         for (relem = firstrelem; relem <= lastrelem; relem++) {
 469             /*SUPPRESS 560*/
 470             if (sv = *relem)
 471                 *relem = sv_mortalcopy(sv);
 472         }
 473     }
 474
 475     relem = firstrelem;
 476     lelem = firstlelem;
 477     ary = Null(AV*);
 478     hash = Null(HV*);
 479     while (lelem <= lastlelem) {
 480         sv = *lelem++;
 481         switch (SvTYPE(sv)) {
 482         case SVt_PVAV:
 483             ary = (AV*)sv;
 484             magic = SvSMAGICAL(ary) != 0;
 485
 486             av_clear(ary);
 487             i = 0;
 488             while (relem <= lastrelem) {        /* gobble up all the rest */
 489                 sv = NEWSV(28,0);
 490                 assert(*relem);
 491                 sv_setsv(sv,*relem);
 492                 *(relem++) = sv;
 493                 (void)av_store(ary,i++,sv);
 494                 if (magic)
 495                     mg_set(sv);
 496             }
 497             break;
 498         case SVt_PVHV: {
 499                 char *tmps;
 500                 SV *tmpstr;
 501
 502                 hash = (HV*)sv;
 503                 magic = SvSMAGICAL(hash) != 0;
 504                 hv_clear(hash);
 505
 506                 while (relem < lastrelem) {     /* gobble up all the rest */
 507                     STRLEN len;
 508                     if (*relem)
 509                         sv = *(relem++);
 510                     else
 511                         sv = &sv_no, relem++;
 512                     tmps = SvPV(sv, len);
 513                     tmpstr = NEWSV(29,0);
 514                     if (*relem)
 515                         sv_setsv(tmpstr,*relem);        /* value */
 516                     *(relem++) = tmpstr;
 517                     (void)hv_store(hash,tmps,len,tmpstr,0);
 518                     if (magic)
 519                         mg_set(tmpstr);
 520                 }
 521             }
 522             break;
 523         default:
 524             if (SvTHINKFIRST(sv)) {
 525                 if (SvREADONLY(sv) && curcop != &compiling) {
 526                     if (sv != &sv_undef && sv != &sv_yes && sv != &sv_no)
 527                         DIE(no_modify);
 528                     if (relem <= lastrelem)
 529                         relem++;
 530                     break;
 531                 }
 532                 if (SvROK(sv))
 533                     sv_unref(sv);
 534             }
 535             if (relem <= lastrelem) {
 536                 sv_setsv(sv, *relem);
 537                 *(relem++) = sv;
 538             }
 539             else
 540                 sv_setsv(sv, &sv_undef);
 541             SvSETMAGIC(sv);
 542             break;
 543         }
 544     }
 545     if (delaymagic & ~DM_DELAY) {
 546         if (delaymagic & DM_UID) {
 547 #ifdef HAS_SETRESUID
 548             (void)setresuid(uid,euid,(Uid_t)-1);
 549 #else /* not HAS_SETRESUID */
 550 #ifdef HAS_SETREUID
 551             (void)setreuid(uid,euid);
 552 #else /* not HAS_SETREUID */
 553 #ifdef HAS_SETRUID
 554             if ((delaymagic & DM_UID) == DM_RUID) {
 555                 (void)setruid(uid);
 556                 delaymagic =~ DM_RUID;
 557             }
 558 #endif /* HAS_SETRUID */
 559 #endif /* HAS_SETRESUID */
 560 #ifdef HAS_SETEUID
 561             if ((delaymagic & DM_UID) == DM_EUID) {
 562                 (void)seteuid(uid);
 563                 delaymagic =~ DM_EUID;
 564             }
 565 #endif /* HAS_SETEUID */
 566             if (delaymagic & DM_UID) {
 567                 if (uid != euid)
 568                     DIE("No setreuid available");
 569                 (void)setuid(uid);
 570             }
 571 #endif /* not HAS_SETREUID */
 572             uid = (int)getuid();
 573             euid = (int)geteuid();
 574         }
 575         if (delaymagic & DM_GID) {
 576 #ifdef HAS_SETRESGID
 577             (void)setresgid(gid,egid,(Gid_t)-1);
 578 #else /* not HAS_SETREGID */
 579 #ifdef HAS_SETREGID
 580             (void)setregid(gid,egid);
 581 #else /* not HAS_SETREGID */
 582 #endif /* not HAS_SETRESGID */
 583 #ifdef HAS_SETRGID
 584             if ((delaymagic & DM_GID) == DM_RGID) {
 585                 (void)setrgid(gid);
 586                 delaymagic =~ DM_RGID;
 587             }
 588 #endif /* HAS_SETRGID */
 589 #ifdef HAS_SETRESGID
 590             (void)setresgid(gid,egid,(Gid_t)-1);
 591 #else /* not HAS_SETREGID */
 592 #ifdef HAS_SETEGID
 593             if ((delaymagic & DM_GID) == DM_EGID) {
 594                 (void)setegid(gid);
 595                 delaymagic =~ DM_EGID;
 596             }
 597 #endif /* HAS_SETEGID */
 598             if (delaymagic & DM_GID) {
 599                 if (gid != egid)
 600                     DIE("No setregid available");
 601                 (void)setgid(gid);
 602             }
 603 #endif /* not HAS_SETRESGID */
 604 #endif /* not HAS_SETREGID */
 605             gid = (int)getgid();
 606             egid = (int)getegid();
 607         }
 608         tainting |= (euid != uid || egid != gid);
 609     }
 610     delaymagic = 0;
 611     if (GIMME == G_ARRAY) {
 612         if (ary || hash)
 613             SP = lastrelem;
 614         else
 615             SP = firstrelem + (lastlelem - firstlelem);
 616         RETURN;
 617     }
 618     else {
 619         SP = firstrelem;
 620         for (relem = firstrelem; relem <= lastrelem; ++relem) {
 621             if (SvOK(*relem)) {
 622                 dTARGET;
 623
 624                 SETi(lastrelem - firstrelem + 1);
 625                 RETURN;
 626             }
 627         }
 628         RETSETUNDEF;
 629     }
 630 }
 631
 632 PP(pp_match)
 633 {
 634     dSP; dTARG;
 635     register PMOP *pm = cPMOP;
 636     register char *t;
 637     register char *s;
 638     char *strend;
 639     I32 global;
 640     I32 safebase;
 641     char *truebase;
 642     register REGEXP *rx = pm->op_pmregexp;
 643     I32 gimme = GIMME;
 644     STRLEN len;
 645
 646     if (op->op_flags & OPf_STACKED)
 647         TARG = POPs;
 648     else {
 649         TARG = GvSV(defgv);
 650         EXTEND(SP,1);
 651     }
 652     s = SvPV(TARG, len);
 653     strend = s + len;
 654     if (!s)
 655         DIE("panic: do_match");
 656
 657     if (pm->op_pmflags & PMf_USED) {
 658         if (gimme == G_ARRAY)
 659             RETURN;
 660         RETPUSHNO;
 661     }
 662
 663     if (!rx->prelen && curpm) {
 664         pm = curpm;
 665         rx = pm->op_pmregexp;
 666     }
 667     truebase = t = s;
 668     if (global = pm->op_pmflags & PMf_GLOBAL) {
 669         rx->startp[0] = 0;
 670         if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
 671             MAGIC* mg = mg_find(TARG, 'g');
 672             if (mg && mg->mg_len >= 0)
 673                 rx->endp[0] = rx->startp[0] = s + mg->mg_len;
 674         }
 675     }
 676     safebase = (gimme == G_ARRAY) || global;
 677     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
 678         SAVEINT(multiline);
 679         multiline = pm->op_pmflags & PMf_MULTILINE;
 680     }
 681
 682 play_it_again:
 683     if (global && rx->startp[0]) {
 684         t = s = rx->endp[0];
 685         if (s > strend)
 686             goto nope;
 687     }
 688     if (pm->op_pmshort) {
 689         if (pm->op_pmflags & PMf_SCANFIRST) {
 690             if (SvSCREAM(TARG)) {
 691                 if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
 692                     goto nope;
 693                 else if (!(s = screaminstr(TARG, pm->op_pmshort)))
 694                     goto nope;
 695                 else if (pm->op_pmflags & PMf_ALL)
 696                     goto yup;
 697             }
 698             else if (!(s = fbm_instr((unsigned char*)s,
 699               (unsigned char*)strend, pm->op_pmshort)))
 700                 goto nope;
 701             else if (pm->op_pmflags & PMf_ALL)
 702                 goto yup;
 703             if (s && rx->regback >= 0) {
 704                 ++BmUSEFUL(pm->op_pmshort);
 705                 s -= rx->regback;
 706                 if (s < t)
 707                     s = t;
 708             }
 709             else
 710                 s = t;
 711         }
 712         else if (!multiline) {
 713             if (*SvPVX(pm->op_pmshort) != *s ||
 714               bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
 715                 if (pm->op_pmflags & PMf_FOLD) {
 716                     if (ibcmp((U8*)SvPVX(pm->op_pmshort), (U8*)s, pm->op_pmslen) )
 717                         goto nope;
 718                 }
 719                 else
 720                     goto nope;
 721             }
 722         }
 723         if (!rx->naughty && --BmUSEFUL(pm->op_pmshort) < 0) {
 724             SvREFCNT_dec(pm->op_pmshort);
 725             pm->op_pmshort = Nullsv;    /* opt is being useless */
 726         }
 727     }
 728     if (!rx->nparens && !global) {
 729         gimme = G_SCALAR;                       /* accidental array context? */
 730         safebase = FALSE;
 731     }
 732     if (regexec(rx, s, strend, truebase, 0,
 733       SvSCREAM(TARG) ? TARG : Nullsv,
 734       safebase)) {
 735         curpm = pm;
 736         if (pm->op_pmflags & PMf_ONCE)
 737             pm->op_pmflags |= PMf_USED;
 738         goto gotcha;
 739     }
 740     else
 741         goto ret_no;
 742     /*NOTREACHED*/
 743
 744   gotcha:
 745     if (gimme == G_ARRAY) {
 746         I32 iters, i, len;
 747
 748         iters = rx->nparens;
 749         if (global && !iters)
 750             i = 1;
 751         else
 752             i = 0;
 753         EXTEND(SP, iters + i);
 754         for (i = !i; i <= iters; i++) {
 755             PUSHs(sv_newmortal());
 756             /*SUPPRESS 560*/
 757             if ((s = rx->startp[i]) && rx->endp[i] ) {
 758                 len = rx->endp[i] - s;
 759                 sv_setpvn(*SP, s, len);
 760             }
 761         }
 762         if (global) {
 763             truebase = rx->subbeg;
 764             if (rx->startp[0] && rx->startp[0] == rx->endp[0])
 765                 ++rx->endp[0];
 766             goto play_it_again;
 767         }
 768         RETURN;
 769     }
 770     else {
 771         if (global) {
 772             MAGIC* mg = 0;
 773             if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG))
 774                 mg = mg_find(TARG, 'g');
 775             if (!mg) {
 776                 sv_magic(TARG, (SV*)0, 'g', Nullch, 0);
 777                 mg = mg_find(TARG, 'g');
 778             }
 779             mg->mg_len = rx->startp[0] ? rx->endp[0] - truebase : -1;
 780         }
 781         RETPUSHYES;
 782     }
 783
 784 yup:
 785     ++BmUSEFUL(pm->op_pmshort);
 786     curpm = pm;
 787     if (pm->op_pmflags & PMf_ONCE)
 788         pm->op_pmflags |= PMf_USED;
 789     if (global) {
 790         rx->subbeg = truebase;
 791         rx->subend = strend;
 792         rx->startp[0] = s;
 793         rx->endp[0] = s + SvCUR(pm->op_pmshort);
 794         goto gotcha;
 795     }
 796     if (sawampersand) {
 797         char *tmps;
 798
 799         if (rx->subbase)
 800             Safefree(rx->subbase);
 801         tmps = rx->subbase = savepvn(t, strend-t);
 802         rx->subbeg = tmps;
 803         rx->subend = tmps + (strend-t);
 804         tmps = rx->startp[0] = tmps + (s - t);
 805         rx->endp[0] = tmps + SvCUR(pm->op_pmshort);
 806     }
 807     RETPUSHYES;
 808
 809 nope:
 810     if (pm->op_pmshort)
 811         ++BmUSEFUL(pm->op_pmshort);
 812
 813 ret_no:
 814     if (global) {
 815         if (SvTYPE(TARG) >= SVt_PVMG && SvMAGIC(TARG)) {
 816             MAGIC* mg = mg_find(TARG, 'g');
 817             if (mg)
 818                 mg->mg_len = -1;
 819         }
 820     }
 821     if (gimme == G_ARRAY)
 822         RETURN;
 823     RETPUSHNO;
 824 }
 825
 826 OP *
 827 do_readline()
 828 {
 829     dSP; dTARGETSTACKED;
 830     register SV *sv;
 831     STRLEN tmplen = 0;
 832     STRLEN offset;
 833     FILE *fp;
 834     register IO *io = GvIO(last_in_gv);
 835     register I32 type = op->op_type;
 836
 837     fp = Nullfp;
 838     if (io) {
 839         fp = IoIFP(io);
 840         if (!fp) {
 841             if (IoFLAGS(io) & IOf_ARGV) {
 842                 if (IoFLAGS(io) & IOf_START) {
 843                     IoFLAGS(io) &= ~IOf_START;
 844                     IoLINES(io) = 0;
 845                     if (av_len(GvAVn(last_in_gv)) < 0) {
 846                         SV *tmpstr = newSVpv("-", 1); /* assume stdin */
 847                         av_push(GvAVn(last_in_gv), tmpstr);
 848                     }
 849                 }
 850                 fp = nextargv(last_in_gv);
 851                 if (!fp) { /* Note: fp != IoIFP(io) */
 852                     (void)do_close(last_in_gv, FALSE); /* now it does*/
 853                     IoFLAGS(io) |= IOf_START;
 854                 }
 855             }
 856             else if (type == OP_GLOB) {
 857                 SV *tmpcmd = NEWSV(55, 0);
 858                 SV *tmpglob = POPs;
 859                 ENTER;
 860                 SAVEFREESV(tmpcmd);
 861 #ifdef VMS /* expand the wildcards right here, rather than opening a pipe, */
 862            /* since spawning off a process is a real performance hit */
 863                 {
 864 #include <descrip.h>
 865 #include <lib$routines.h>
 866 #include <nam.h>
 867 #include <rmsdef.h>
 868                     char rslt[NAM$C_MAXRSS+1+sizeof(unsigned short int)] = {'\0','\0'};
 869                     char vmsspec[NAM$C_MAXRSS+1];
 870                     char *rstr = rslt + sizeof(unsigned short int), *begin, *end, *cp;
 871                     char tmpfnam[L_tmpnam] = "SYS$SCRATCH:";
 872                     $DESCRIPTOR(dfltdsc,"SYS$DISK:[]*.*;");
 873                     FILE *tmpfp;
 874                     STRLEN i;
 875                     struct dsc$descriptor_s wilddsc
 876                        = {0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
 877                     struct dsc$descriptor_vs rsdsc
 878                        = {sizeof rslt, DSC$K_DTYPE_VT, DSC$K_CLASS_VS, rslt};
 879                     unsigned long int cxt = 0, sts = 0, ok = 1, hasdir = 0, hasver = 0, isunix = 0;
 880
 881                     /* We could find out if there's an explicit dev/dir or version
 882                        by peeking into lib$find_file's internal context at
 883                        ((struct NAM *)((struct FAB *)cxt)->fab$l_nam)->nam$l_fnb
 884                        but that's unsupported, so I don't want to do it now and
 885                        have it bite someone in the future. */
 886                     strcat(tmpfnam,tmpnam(NULL));
 887                     cp = SvPV(tmpglob,i);
 888                     for (; i; i--) {
 889                        if (cp[i] == ';') hasver = 1;
 890                        if (cp[i] == '.') {
 891                            if (sts) hasver = 1;
 892                            else sts = 1;
 893                        }
 894                        if (cp[i] == '/') {
 895                           hasdir = isunix = 1;
 896                           break;
 897                }
 898                        if (cp[i] == ']' || cp[i] == '>' || cp[i] == ':') {
 899                            hasdir = 1;
 900                            break;
 901                        }
 902                     }
 903                     if ((tmpfp = fopen(tmpfnam,"w+","fop=dlt")) != NULL) {
 904                         ok = ((wilddsc.dsc$a_pointer = tovmsspec(SvPVX(tmpglob),vmsspec)) != NULL);
 905                         if (ok) wilddsc.dsc$w_length = (unsigned short int) strlen(wilddsc.dsc$a_pointer);
 906                         while (ok && ((sts = lib$find_file(&wilddsc,&rsdsc,&cxt,
 907                                                     &dfltdsc,NULL,NULL,NULL))&1)) {
 908                             end = rstr + (unsigned long int) *rslt;
 909                             if (!hasver) while (*end != ';') end--;
 910                             *(end++) = '\n';  *end = '\0';
 911                             for (cp = rstr; *cp; cp++) *cp = _tolower(*cp);
 912                             if (hasdir) {
 913                               if (isunix) trim_unixpath(SvPVX(tmpglob),rstr);
 914                               begin = rstr;
 915                             }
 916                             else {
 917                                 begin = end;
 918                                 while (*(--begin) != ']' && *begin != '>') ;
 919                                 ++begin;
 920                             }
 921                             ok = (fputs(begin,tmpfp) != EOF);
 922                         }
 923                         if (cxt) (void)lib$find_file_end(&cxt);
 924                         if (ok && sts != RMS$_NMF) ok = 0;
 925                         if (!ok) {
 926                             fp = NULL;
 927                         }
 928                         else {
 929                            rewind(tmpfp);
 930                            IoTYPE(io) = '<';
 931                            IoIFP(io) = fp = tmpfp;
 932                         }
 933                     }
 934                 }
 935 #else /* !VMS */
 936 #ifdef DOSISH
 937                 sv_setpv(tmpcmd, "perlglob ");
 938                 sv_catsv(tmpcmd, tmpglob);
 939                 sv_catpv(tmpcmd, " |");
 940 #else
 941 #ifdef CSH
 942                 sv_setpvn(tmpcmd, cshname, cshlen);
 943                 sv_catpv(tmpcmd, " -cf 'set nonomatch; glob ");
 944                 sv_catsv(tmpcmd, tmpglob);
 945                 sv_catpv(tmpcmd, "'|");
 946 #else
 947                 sv_setpv(tmpcmd, "echo ");
 948                 sv_catsv(tmpcmd, tmpglob);
 949 #if 'z' - 'a' == 25
 950                 sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\012\\012\\012\\012'|");
 951 #else
 952                 sv_catpv(tmpcmd, "|tr -s ' \t\f\r' '\\n\\n\\n\\n'|");
 953 #endif
 954 #endif /* !CSH */
 955 #endif /* !MSDOS */
 956                 (void)do_open(last_in_gv, SvPVX(tmpcmd), SvCUR(tmpcmd),Nullfp);
 957                 fp = IoIFP(io);
 958 #endif /* !VMS */
 959                 LEAVE;
 960             }
 961         }
 962         else if (type == OP_GLOB)
 963             SP--;
 964     }
 965     if (!fp) {
 966         if (dowarn)
 967             warn("Read on closed filehandle <%s>", GvENAME(last_in_gv));
 968         if (GIMME == G_SCALAR) {
 969             (void)SvOK_off(TARG);
 970             PUSHTARG;
 971         }
 972         RETURN;
 973     }
 974     if (GIMME == G_ARRAY) {
 975         sv = sv_2mortal(NEWSV(57, 80));
 976         offset = 0;
 977     }
 978     else {
 979         sv = TARG;
 980         (void)SvUPGRADE(sv, SVt_PV);
 981         tmplen = SvLEN(sv);     /* remember if already alloced */
 982         if (!tmplen)
 983             Sv_Grow(sv, 80);    /* try short-buffering it */
 984         if (type == OP_RCATLINE)
 985             offset = SvCUR(sv);
 986         else
 987             offset = 0;
 988     }
 989     for (;;) {
 990         if (!sv_gets(sv, fp, offset)) {
 991             clearerr(fp);
 992             if (IoFLAGS(io) & IOf_ARGV) {
 993                 fp = nextargv(last_in_gv);
 994                 if (fp)
 995                     continue;
 996                 (void)do_close(last_in_gv, FALSE);
 997                 IoFLAGS(io) |= IOf_START;
 998             }
 999             else if (type == OP_GLOB) {
1000                 (void)do_close(last_in_gv, FALSE);
1001             }
1002             if (GIMME == G_SCALAR) {
1003                 (void)SvOK_off(TARG);
1004                 PUSHTARG;
1005             }
1006             RETURN;
1007         }
1008         IoLINES(io)++;
1009         XPUSHs(sv);
1010         if (tainting) {
1011             tainted = TRUE;
1012             SvTAINT(sv); /* Anything from the outside world...*/
1013         }
1014         if (type == OP_GLOB) {
1015             char *tmps;
1016
1017             if (SvCUR(sv) > 0)
1018                 SvCUR(sv)--;
1019             if (*SvEND(sv) == rschar)
1020                 *SvEND(sv) = '\0';
1021             else
1022                 SvCUR(sv)++;
1023             for (tmps = SvPVX(sv); *tmps; tmps++)
1024                 if (!isALPHA(*tmps) && !isDIGIT(*tmps) &&
1025                     strchr("$&*(){}[]'\";\\|?<>~`", *tmps))
1026                         break;
1027             if (*tmps && Stat(SvPVX(sv), &statbuf) < 0) {
1028                 (void)POPs;             /* Unmatched wildcard?  Chuck it... */
1029                 continue;
1030             }
1031         }
1032         if (GIMME == G_ARRAY) {
1033             if (SvLEN(sv) - SvCUR(sv) > 20) {
1034                 SvLEN_set(sv, SvCUR(sv)+1);
1035                 Renew(SvPVX(sv), SvLEN(sv), char);
1036             }
1037             sv = sv_2mortal(NEWSV(58, 80));
1038             continue;
1039         }
1040         else if (!tmplen && SvLEN(sv) - SvCUR(sv) > 80) {
1041             /* try to reclaim a bit of scalar space (only on 1st alloc) */
1042             if (SvCUR(sv) < 60)
1043                 SvLEN_set(sv, 80);
1044             else
1045                 SvLEN_set(sv, SvCUR(sv)+40);    /* allow some slop */
1046             Renew(SvPVX(sv), SvLEN(sv), char);
1047         }
1048         RETURN;
1049     }
1050 }
1051
1052 PP(pp_enter)
1053 {
1054     dSP;
1055     register CONTEXT *cx;
1056     I32 gimme;
1057
1058     /*
1059      * We don't just use the GIMME macro here because it assumes there's
1060      * already a context, which ain't necessarily so at initial startup.
1061      */
1062
1063     if (op->op_flags & OPf_KNOW)
1064         gimme = op->op_flags & OPf_LIST;
1065     else if (cxstack_ix >= 0)
1066         gimme = cxstack[cxstack_ix].blk_gimme;
1067     else
1068         gimme = G_SCALAR;
1069
1070     ENTER;
1071
1072     SAVETMPS;
1073     PUSHBLOCK(cx, CXt_BLOCK, sp);
1074
1075     RETURN;
1076 }
1077
1078 PP(pp_helem)
1079 {
1080     dSP;
1081     SV** svp;
1082     SV *keysv = POPs;
1083     STRLEN keylen;
1084     char *key = SvPV(keysv, keylen);
1085     HV *hv = (HV*)POPs;
1086     I32 lval = op->op_flags & OPf_MOD;
1087
1088     if (SvTYPE(hv) != SVt_PVHV)
1089         RETPUSHUNDEF;
1090     svp = hv_fetch(hv, key, keylen, lval);
1091     if (lval) {
1092         if (!svp || *svp == &sv_undef)
1093             DIE(no_helem, key);
1094         if (op->op_private & OPpLVAL_INTRO)
1095             save_svref(svp);
1096         else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) {
1097             SV* sv = *svp;
1098             if (SvGMAGICAL(sv))
1099                 mg_get(sv);
1100             if (!SvOK(sv)) {
1101                 (void)SvUPGRADE(sv, SVt_RV);
1102                 SvRV(sv) = (op->op_private & OPpDEREF_HV ?
1103                             (SV*)newHV() : (SV*)newAV());
1104                 SvROK_on(sv);
1105                 SvSETMAGIC(sv);
1106             }
1107         }
1108     }
1109     PUSHs(svp ? *svp : &sv_undef);
1110     RETURN;
1111 }
1112
1113 PP(pp_leave)
1114 {
1115     dSP;
1116     register CONTEXT *cx;
1117     register SV **mark;
1118     SV **newsp;
1119     PMOP *newpm;
1120     I32 gimme;
1121
1122     if (op->op_flags & OPf_SPECIAL) {
1123         cx = &cxstack[cxstack_ix];
1124         cx->blk_oldpm = curpm;  /* fake block should preserve $1 et al */
1125     }
1126
1127     POPBLOCK(cx,newpm);
1128
1129     if (op->op_flags & OPf_KNOW)
1130         gimme = op->op_flags & OPf_LIST;
1131     else if (cxstack_ix >= 0)
1132         gimme = cxstack[cxstack_ix].blk_gimme;
1133     else
1134         gimme = G_SCALAR;
1135
1136     if (gimme == G_SCALAR) {
1137         if (op->op_private & OPpLEAVE_VOID)
1138             SP = newsp;
1139         else {
1140             MARK = newsp + 1;
1141             if (MARK <= SP)
1142                 if (SvFLAGS(TOPs) & (SVs_PADTMP|SVs_TEMP))
1143                     *MARK = TOPs;
1144                 else
1145                     *MARK = sv_mortalcopy(TOPs);
1146             else {
1147                 MEXTEND(mark,0);
1148                 *MARK = &sv_undef;
1149             }
1150             SP = MARK;
1151         }
1152     }
1153     else {
1154         for (mark = newsp + 1; mark <= SP; mark++)
1155             if (!(SvFLAGS(*mark) & (SVs_PADTMP|SVs_TEMP)))
1156                 *mark = sv_mortalcopy(*mark);
1157                 /* in case LEAVE wipes old return values */
1158     }
1159     curpm = newpm;      /* Don't pop $1 et al till now */
1160
1161     LEAVE;
1162
1163     RETURN;
1164 }
1165
1166 PP(pp_iter)
1167 {
1168     dSP;
1169     register CONTEXT *cx;
1170     SV *sv;
1171
1172     EXTEND(sp, 1);
1173     cx = &cxstack[cxstack_ix];
1174     if (cx->cx_type != CXt_LOOP)
1175         DIE("panic: pp_iter");
1176
1177     if (cx->blk_loop.iterix >= cx->blk_oldsp)
1178         RETPUSHNO;
1179
1180     if (sv = AvARRAY(cx->blk_loop.iterary)[++cx->blk_loop.iterix]) {
1181         SvTEMP_off(sv);
1182         *cx->blk_loop.itervar = sv;
1183     }
1184     else
1185         *cx->blk_loop.itervar = &sv_undef;
1186
1187     RETPUSHYES;
1188 }
1189
1190 PP(pp_subst)
1191 {
1192     dSP; dTARG;
1193     register PMOP *pm = cPMOP;
1194     PMOP *rpm = pm;
1195     register SV *dstr;
1196     register char *s;
1197     char *strend;
1198     register char *m;
1199     char *c;
1200     register char *d;
1201     STRLEN clen;
1202     I32 iters = 0;
1203     I32 maxiters;
1204     register I32 i;
1205     bool once;
1206     char *orig;
1207     I32 safebase;
1208     register REGEXP *rx = pm->op_pmregexp;
1209     STRLEN len;
1210     int force_on_match = 0;
1211
1212     if (pm->op_pmflags & PMf_CONST)     /* known replacement string? */
1213         dstr = POPs;
1214     if (op->op_flags & OPf_STACKED)
1215         TARG = POPs;
1216     else {
1217         TARG = GvSV(defgv);
1218         EXTEND(SP,1);
1219     }
1220     s = SvPV(TARG, len);
1221     if (!SvPOKp(TARG))
1222         force_on_match = 1;
1223
1224   force_it:
1225     if (!pm || !s)
1226         DIE("panic: do_subst");
1227
1228     strend = s + len;
1229     maxiters = (strend - s) + 10;
1230
1231     if (!rx->prelen && curpm) {
1232         pm = curpm;
1233         rx = pm->op_pmregexp;
1234     }
1235     safebase = ((!rx || !rx->nparens) && !sawampersand);
1236     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
1237         SAVEINT(multiline);
1238         multiline = pm->op_pmflags & PMf_MULTILINE;
1239     }
1240     orig = m = s;
1241     if (pm->op_pmshort) {
1242         if (pm->op_pmflags & PMf_SCANFIRST) {
1243             if (SvSCREAM(TARG)) {
1244                 if (screamfirst[BmRARE(pm->op_pmshort)] < 0)
1245                     goto nope;
1246                 else if (!(s = screaminstr(TARG, pm->op_pmshort)))
1247                     goto nope;
1248             }
1249             else if (!(s = fbm_instr((unsigned char*)s, (unsigned char*)strend,
1250               pm->op_pmshort)))
1251                 goto nope;
1252             if (s && rx->regback >= 0) {
1253                 ++BmUSEFUL(pm->op_pmshort);
1254                 s -= rx->regback;
1255                 if (s < m)
1256                     s = m;
1257             }
1258             else
1259                 s = m;
1260         }
1261         else if (!multiline) {
1262             if (*SvPVX(pm->op_pmshort) != *s ||
1263               bcmp(SvPVX(pm->op_pmshort), s, pm->op_pmslen) ) {
1264                 if (pm->op_pmflags & PMf_FOLD) {
1265                     if (ibcmp((U8*)SvPVX(pm->op_pmshort), (U8*)s, pm->op_pmslen) )
1266                         goto nope;
1267                 }
1268                 else
1269                     goto nope;
1270             }
1271         }
1272         if (!rx->naughty && --BmUSEFUL(pm->op_pmshort) < 0) {
1273             SvREFCNT_dec(pm->op_pmshort);
1274             pm->op_pmshort = Nullsv;    /* opt is being useless */
1275         }
1276     }
1277     once = !(rpm->op_pmflags & PMf_GLOBAL);
1278     if (rpm->op_pmflags & PMf_CONST) {  /* known replacement string? */
1279         c = SvPV(dstr, clen);
1280         if (clen <= rx->minlen) {
1281                                         /* can do inplace substitution */
1282             if (regexec(rx, s, strend, orig, 0,
1283               SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
1284                 if (force_on_match) {
1285                     force_on_match = 0;
1286                     s = SvPV_force(TARG, len);
1287                     goto force_it;
1288                 }
1289                 if (rx->subbase)        /* oops, no we can't */
1290                     goto long_way;
1291                 d = s;
1292                 curpm = pm;
1293                 SvSCREAM_off(TARG);     /* disable possible screamer */
1294                 if (once) {
1295                     m = rx->startp[0];
1296                     d = rx->endp[0];
1297                     s = orig;
1298                     if (m - s > strend - d) {   /* faster to shorten from end */
1299                         if (clen) {
1300                             Copy(c, m, clen, char);
1301                             m += clen;
1302                         }
1303                         i = strend - d;
1304                         if (i > 0) {
1305                             Move(d, m, i, char);
1306                             m += i;
1307                         }
1308                         *m = '\0';
1309                         SvCUR_set(TARG, m - s);
1310                         (void)SvPOK_only(TARG);
1311                         SvSETMAGIC(TARG);
1312                         PUSHs(&sv_yes);
1313                         RETURN;
1314                     }
1315                     /*SUPPRESS 560*/
1316                     else if (i = m - s) {       /* faster from front */
1317                         d -= clen;
1318                         m = d;
1319                         sv_chop(TARG, d-i);
1320                         s += i;
1321                         while (i--)
1322                             *--d = *--s;
1323                         if (clen)
1324                             Copy(c, m, clen, char);
1325                         (void)SvPOK_only(TARG);
1326                         SvSETMAGIC(TARG);
1327                         PUSHs(&sv_yes);
1328                         RETURN;
1329                     }
1330                     else if (clen) {
1331                         d -= clen;
1332                         sv_chop(TARG, d);
1333                         Copy(c, d, clen, char);
1334                         (void)SvPOK_only(TARG);
1335                         SvSETMAGIC(TARG);
1336                         PUSHs(&sv_yes);
1337                         RETURN;
1338                     }
1339                     else {
1340                         sv_chop(TARG, d);
1341                         (void)SvPOK_only(TARG);
1342                         SvSETMAGIC(TARG);
1343                         PUSHs(&sv_yes);
1344                         RETURN;
1345                     }
1346                     /* NOTREACHED */
1347                 }
1348                 do {
1349                     if (iters++ > maxiters)
1350                         DIE("Substitution loop");
1351                     m = rx->startp[0];
1352                     /*SUPPRESS 560*/
1353                     if (i = m - s) {
1354                         if (s != d)
1355                             Move(s, d, i, char);
1356                         d += i;
1357                     }
1358                     if (clen) {
1359                         Copy(c, d, clen, char);
1360                         d += clen;
1361                     }
1362                     s = rx->endp[0];
1363                 } while (regexec(rx, s, strend, orig, s == m,
1364                     Nullsv, TRUE));     /* (don't match same null twice) */
1365                 if (s != d) {
1366                     i = strend - s;
1367                     SvCUR_set(TARG, d - SvPVX(TARG) + i);
1368                     Move(s, d, i+1, char);              /* include the Null */
1369                 }
1370                 (void)SvPOK_only(TARG);
1371                 SvSETMAGIC(TARG);
1372                 PUSHs(sv_2mortal(newSViv((I32)iters)));
1373                 RETURN;
1374             }
1375             PUSHs(&sv_no);
1376             RETURN;
1377         }
1378     }
1379     else
1380         c = Nullch;
1381     if (regexec(rx, s, strend, orig, 0,
1382       SvSCREAM(TARG) ? TARG : Nullsv, safebase)) {
1383     long_way:
1384         if (force_on_match) {
1385             force_on_match = 0;
1386             s = SvPV_force(TARG, len);
1387             goto force_it;
1388         }
1389         dstr = NEWSV(25, sv_len(TARG));
1390         sv_setpvn(dstr, m, s-m);
1391         curpm = pm;
1392         if (!c) {
1393             register CONTEXT *cx;
1394             PUSHSUBST(cx);
1395             RETURNOP(cPMOP->op_pmreplroot);
1396         }
1397         do {
1398             if (iters++ > maxiters)
1399                 DIE("Substitution loop");
1400             if (rx->subbase && rx->subbase != orig) {
1401                 m = s;
1402                 s = orig;
1403                 orig = rx->subbase;
1404                 s = orig + (m - s);
1405                 strend = s + (strend - m);
1406             }
1407             m = rx->startp[0];
1408             sv_catpvn(dstr, s, m-s);
1409             s = rx->endp[0];
1410             if (clen)
1411                 sv_catpvn(dstr, c, clen);
1412             if (once)
1413                 break;
1414         } while (regexec(rx, s, strend, orig, s == m, Nullsv,
1415             safebase));
1416         sv_catpvn(dstr, s, strend - s);
1417         sv_replace(TARG, dstr);
1418         (void)SvPOK_only(TARG);
1419         SvSETMAGIC(TARG);
1420         PUSHs(sv_2mortal(newSViv((I32)iters)));
1421         RETURN;
1422     }
1423     PUSHs(&sv_no);
1424     RETURN;
1425
1426 nope:
1427     ++BmUSEFUL(pm->op_pmshort);
1428     PUSHs(&sv_no);
1429     RETURN;
1430 }
1431
1432 PP(pp_grepwhile)
1433 {
1434     dSP;
1435
1436     if (SvTRUEx(POPs))
1437         stack_base[markstack_ptr[-1]++] = stack_base[*markstack_ptr];
1438     ++*markstack_ptr;
1439     LEAVE;                                      /* exit inner scope */
1440
1441     /* All done yet? */
1442     if (stack_base + *markstack_ptr > sp) {
1443         I32 items;
1444
1445         LEAVE;                                  /* exit outer scope */
1446         (void)POPMARK;                          /* pop src */
1447         items = --*markstack_ptr - markstack_ptr[-1];
1448         (void)POPMARK;                          /* pop dst */
1449         SP = stack_base + POPMARK;              /* pop original mark */
1450         if (GIMME != G_ARRAY) {
1451             dTARGET;
1452             XPUSHi(items);
1453             RETURN;
1454         }
1455         SP += items;
1456         RETURN;
1457     }
1458     else {
1459         SV *src;
1460
1461         ENTER;                                  /* enter inner scope */
1462         SAVESPTR(curpm);
1463
1464         src = stack_base[*markstack_ptr];
1465         SvTEMP_off(src);
1466         GvSV(defgv) = src;
1467
1468         RETURNOP(cLOGOP->op_other);
1469     }
1470 }
1471
1472 PP(pp_leavesub)
1473 {
1474     dSP;
1475     SV **mark;
1476     SV **newsp;
1477     PMOP *newpm;
1478     I32 gimme;
1479     register CONTEXT *cx;
1480
1481     POPBLOCK(cx,newpm);
1482     POPSUB(cx);
1483
1484     if (gimme == G_SCALAR) {
1485         MARK = newsp + 1;
1486         if (MARK <= SP)
1487             if (SvFLAGS(TOPs) & SVs_TEMP)
1488                 *MARK = TOPs;
1489             else
1490                 *MARK = sv_mortalcopy(TOPs);
1491         else {
1492             MEXTEND(mark,0);
1493             *MARK = &sv_undef;
1494         }
1495         SP = MARK;
1496     }
1497     else {
1498         for (mark = newsp + 1; mark <= SP; mark++)
1499             if (!(SvFLAGS(*mark) & SVs_TEMP))
1500                 *mark = sv_mortalcopy(*mark);
1501                 /* in case LEAVE wipes old return values */
1502     }
1503
1504     if (cx->blk_sub.hasargs) {          /* You don't exist; go away. */
1505         AV* av = cx->blk_sub.argarray;
1506
1507         av_clear(av);
1508         AvREAL_off(av);
1509     }
1510     curpm = newpm;      /* Don't pop $1 et al till now */
1511
1512     LEAVE;
1513     PUTBACK;
1514     return pop_return();
1515 }
1516
1517 PP(pp_entersub)
1518 {
1519     dSP; dPOPss;
1520     GV *gv;
1521     HV *stash;
1522     register CV *cv;
1523     register CONTEXT *cx;
1524
1525     if (!sv)
1526         DIE("Not a CODE reference");
1527     switch (SvTYPE(sv)) {
1528     default:
1529         if (!SvROK(sv)) {
1530             if (sv == &sv_yes)          /* unfound import, ignore */
1531                 RETURN;
1532             if (!SvOK(sv))
1533                 DIE(no_usym, "a subroutine");
1534             if (op->op_private & HINT_STRICT_REFS)
1535                 DIE(no_symref, "a subroutine");
1536             gv = gv_fetchpv(SvPV(sv, na), FALSE, SVt_PVCV);
1537             if (!gv)
1538                 cv = 0;
1539             else
1540                 cv = GvCV(gv);
1541             break;
1542         }
1543         cv = (CV*)SvRV(sv);
1544         if (SvTYPE(cv) == SVt_PVCV)
1545             break;
1546         /* FALL THROUGH */
1547     case SVt_PVHV:
1548     case SVt_PVAV:
1549         DIE("Not a CODE reference");
1550     case SVt_PVCV:
1551         cv = (CV*)sv;
1552         break;
1553     case SVt_PVGV:
1554         if (!(cv = GvCV((GV*)sv)))
1555             cv = sv_2cv(sv, &stash, &gv, TRUE);
1556         break;
1557     }
1558
1559     ENTER;
1560     SAVETMPS;
1561
1562   retry:
1563     if (!cv)
1564         DIE("Not a CODE reference");
1565
1566     if (!CvROOT(cv) && !CvXSUB(cv)) {
1567         if (gv = CvGV(cv)) {
1568             SV *tmpstr = sv_newmortal();
1569             GV *ngv;
1570             gv_efullname(tmpstr, gv);
1571             ngv = gv_fetchmethod(GvESTASH(gv), "AUTOLOAD");
1572             if (ngv && ngv != gv && (cv = GvCV(ngv))) { /* One more chance... */
1573                 gv = ngv;
1574                 sv_setsv(GvSV(CvGV(cv)), tmpstr);       /* Set CV's $AUTOLOAD */
1575                 goto retry;
1576             }
1577             else
1578                 DIE("Undefined subroutine &%s called",SvPVX(tmpstr));
1579         }
1580         DIE("Undefined subroutine called");
1581     }
1582
1583     if ((op->op_private & OPpDEREF_DB) && !CvXSUB(cv)) {
1584         sv = GvSV(DBsub);
1585         save_item(sv);
1586         gv = CvGV(cv);
1587         gv_efullname(sv,gv);
1588         cv = GvCV(DBsub);
1589         if (!cv)
1590             DIE("No DBsub routine");
1591     }
1592
1593     if (CvXSUB(cv)) {
1594         if (CvOLDSTYLE(cv)) {
1595             I32 (*fp3)_((int,int,int));
1596             dMARK;
1597             register I32 items = SP - MARK;
1598             while (sp > mark) {
1599                 sp[1] = sp[0];
1600                 sp--;
1601             }
1602             stack_sp = mark + 1;
1603             fp3 = (I32(*)_((int,int,int)))CvXSUB(cv);
1604             items = (*fp3)(CvXSUBANY(cv).any_i32,
1605                            MARK - stack_base + 1,
1606                            items);
1607             stack_sp = stack_base + items;
1608         }
1609         else {
1610             PUTBACK;
1611             (void)(*CvXSUB(cv))(cv);
1612         }
1613         LEAVE;
1614         return NORMAL;
1615     }
1616     else {
1617         dMARK;
1618         register I32 items = SP - MARK;
1619         I32 hasargs = (op->op_flags & OPf_STACKED) != 0;
1620         I32 gimme = GIMME;
1621         AV* padlist = CvPADLIST(cv);
1622         SV** svp = AvARRAY(padlist);
1623         push_return(op->op_next);
1624         PUSHBLOCK(cx, CXt_SUB, MARK);
1625         PUSHSUB(cx);
1626         CvDEPTH(cv)++;
1627         if (CvDEPTH(cv) < 2)
1628             (void)SvREFCNT_inc(cv);
1629         else {  /* save temporaries on recursion? */
1630             if (CvDEPTH(cv) == 100 && dowarn)
1631                 warn("Deep recursion on subroutine \"%s\"",GvENAME(CvGV(cv)));
1632             if (CvDEPTH(cv) > AvFILL(padlist)) {
1633                 AV *av;
1634                 AV *newpad = newAV();
1635                 I32 ix = AvFILL((AV*)svp[1]);
1636                 svp = AvARRAY(svp[0]);
1637                 while (ix > 0) {
1638                     if (svp[ix] != &sv_undef) {
1639                         char *name = SvPVX(svp[ix]);    /* XXX */
1640                         if (*name == '@')
1641                             av_store(newpad, ix--, sv = (SV*)newAV());
1642                         else if (*name == '%')
1643                             av_store(newpad, ix--, sv = (SV*)newHV());
1644                         else
1645                             av_store(newpad, ix--, sv = NEWSV(0,0));
1646                         SvPADMY_on(sv);
1647                     }
1648                     else {
1649                         av_store(newpad, ix--, sv = NEWSV(0,0));
1650                         SvPADTMP_on(sv);
1651                     }
1652                 }
1653                 av = newAV();           /* will be @_ */
1654                 av_extend(av, 0);
1655                 av_store(newpad, 0, (SV*)av);
1656                 AvFLAGS(av) = AVf_REIFY;
1657                 av_store(padlist, CvDEPTH(cv), (SV*)newpad);
1658                 AvFILL(padlist) = CvDEPTH(cv);
1659                 svp = AvARRAY(padlist);
1660             }
1661         }
1662         SAVESPTR(curpad);
1663         curpad = AvARRAY((AV*)svp[CvDEPTH(cv)]);
1664         if (hasargs) {
1665             AV* av = (AV*)curpad[0];
1666             SV** ary;
1667
1668             if (AvREAL(av)) {
1669                 av_clear(av);
1670                 AvREAL_off(av);
1671             }
1672             cx->blk_sub.savearray = GvAV(defgv);
1673             cx->blk_sub.argarray = av;
1674             GvAV(defgv) = cx->blk_sub.argarray;
1675             ++MARK;
1676
1677             if (items > AvMAX(av) + 1) {
1678                 ary = AvALLOC(av);
1679                 if (AvARRAY(av) != ary) {
1680                     AvMAX(av) += AvARRAY(av) - AvALLOC(av);
1681                     SvPVX(av) = (char*)ary;
1682                 }
1683                 if (items > AvMAX(av) + 1) {
1684                     AvMAX(av) = items - 1;
1685                     Renew(ary,items,SV*);
1686                     AvALLOC(av) = ary;
1687                     SvPVX(av) = (char*)ary;
1688                 }
1689             }
1690             Copy(MARK,AvARRAY(av),items,SV*);
1691             AvFILL(av) = items - 1;
1692
1693             while (items--) {
1694                 if (*MARK)
1695                     SvTEMP_off(*MARK);
1696                 MARK++;
1697             }
1698         }
1699         RETURNOP(CvSTART(cv));
1700     }
1701 }
1702
1703 PP(pp_aelem)
1704 {
1705     dSP;
1706     SV** svp;
1707     I32 elem = POPi - curcop->cop_arybase;
1708     AV *av = (AV*)POPs;
1709     I32 lval = op->op_flags & OPf_MOD;
1710
1711     if (SvTYPE(av) != SVt_PVAV)
1712         RETPUSHUNDEF;
1713     svp = av_fetch(av, elem, lval);
1714     if (lval) {
1715         if (!svp || *svp == &sv_undef)
1716             DIE(no_aelem, elem);
1717         if (op->op_private & OPpLVAL_INTRO)
1718             save_svref(svp);
1719         else if (op->op_private & (OPpDEREF_HV|OPpDEREF_AV)) {
1720             SV* sv = *svp;
1721             if (SvGMAGICAL(sv))
1722                 mg_get(sv);
1723             if (!SvOK(sv)) {
1724                 (void)SvUPGRADE(sv, SVt_RV);
1725                 SvRV(sv) = (op->op_private & OPpDEREF_HV ?
1726                             (SV*)newHV() : (SV*)newAV());
1727                 SvROK_on(sv);
1728                 SvSETMAGIC(sv);
1729             }
1730         }
1731     }
1732     PUSHs(svp ? *svp : &sv_undef);
1733     RETURN;
1734 }
1735
1736 PP(pp_method)
1737 {
1738     dSP;
1739     SV* sv;
1740     SV* ob;
1741     GV* gv;
1742     SV* nm;
1743
1744     nm = TOPs;
1745     sv = *(stack_base + TOPMARK + 1);
1746
1747     gv = 0;
1748     if (SvROK(sv))
1749         ob = SvRV(sv);
1750     else {
1751         GV* iogv;
1752         char* packname = 0;
1753
1754         if (!SvOK(sv) ||
1755             !(packname = SvPV(sv, na)) ||
1756             !(iogv = gv_fetchpv(packname, FALSE, SVt_PVIO)) ||
1757             !(ob=(SV*)GvIO(iogv)))
1758         {
1759             char *name = SvPV(nm, na);
1760             HV *stash;
1761             if (!packname || !isALPHA(*packname))
1762 DIE("Can't call method \"%s\" without a package or object reference", name);
1763             if (!(stash = gv_stashpv(packname, FALSE))) {
1764                 if (gv_stashpv("UNIVERSAL", FALSE))
1765                     stash = gv_stashpv(packname, TRUE);
1766                 else
1767                     DIE("Can't call method \"%s\" in empty package \"%s\"",
1768                         name, packname);
1769             }
1770             gv = gv_fetchmethod(stash,name);
1771             if (!gv)
1772                 DIE("Can't locate object method \"%s\" via package \"%s\"",
1773                     name, packname);
1774             SETs(gv);
1775             RETURN;
1776         }
1777     }
1778
1779     if (!ob || !SvOBJECT(ob)) {
1780         char *name = SvPV(nm, na);
1781         DIE("Can't call method \"%s\" on unblessed reference", name);
1782     }
1783
1784     if (!gv) {          /* nothing cached */
1785         char *name = SvPV(nm, na);
1786         gv = gv_fetchmethod(SvSTASH(ob),name);
1787         if (!gv)
1788             DIE("Can't locate object method \"%s\" via package \"%s\"",
1789                 name, HvNAME(SvSTASH(ob)));
1790     }
1791
1792     SETs(gv);
1793     RETURN;
1794 }
1795