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