pp.c

   1 /*    pp.c
   2  *
   3  *    Copyright (c) 1991-1994, Larry Wall
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  */
   9
  10 /*
  11  * "It's a big house this, and very peculiar.  Always a bit more to discover,
  12  * and no knowing what you'll find around a corner.  And Elves, sir!" --Samwise
  13  */
  14
  15 #include "EXTERN.h"
  16 #include "perl.h"
  17
  18 /*
  19  * Types used in bitwise operations.
  20  *
  21  * Normally we'd just use IV and UV.  However, some hardware and
  22  * software combinations (e.g. Alpha and current OSF/1) don't have a
  23  * floating-point type to use for NV that has adequate bits to fully
  24  * hold an IV/UV.  (In other words, sizeof(long) == sizeof(double).)
  25  *
  26  * It just so happens that "int" is the right size everywhere, at
  27  * least today.
  28  */
  29 typedef int IBW;
  30 typedef unsigned UBW;
  31
  32 static SV* refto _((SV* sv));
  33 static void doencodes _((SV* sv, char* s, I32 len));
  34
  35 /* variations on pp_null */
  36
  37 PP(pp_stub)
  38 {
  39     dSP;
  40     if (GIMME != G_ARRAY) {
  41         XPUSHs(&sv_undef);
  42     }
  43     RETURN;
  44 }
  45
  46 PP(pp_scalar)
  47 {
  48     return NORMAL;
  49 }
  50
  51 /* Pushy stuff. */
  52
  53 PP(pp_padav)
  54 {
  55     dSP; dTARGET;
  56     if (op->op_private & OPpLVAL_INTRO)
  57         SAVECLEARSV(curpad[op->op_targ]);
  58     EXTEND(SP, 1);
  59     if (op->op_flags & OPf_REF) {
  60         PUSHs(TARG);
  61         RETURN;
  62     }
  63     if (GIMME == G_ARRAY) {
  64         I32 maxarg = AvFILL((AV*)TARG) + 1;
  65         EXTEND(SP, maxarg);
  66         Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
  67         SP += maxarg;
  68     }
  69     else {
  70         SV* sv = sv_newmortal();
  71         I32 maxarg = AvFILL((AV*)TARG) + 1;
  72         sv_setiv(sv, maxarg);
  73         PUSHs(sv);
  74     }
  75     RETURN;
  76 }
  77
  78 PP(pp_padhv)
  79 {
  80     dSP; dTARGET;
  81     XPUSHs(TARG);
  82     if (op->op_private & OPpLVAL_INTRO)
  83         SAVECLEARSV(curpad[op->op_targ]);
  84     if (op->op_flags & OPf_REF)
  85         RETURN;
  86     if (GIMME == G_ARRAY) { /* array wanted */
  87         RETURNOP(do_kv(ARGS));
  88     }
  89     else {
  90         SV* sv = sv_newmortal();
  91         if (HvFILL((HV*)TARG)) {
  92             sprintf(buf, "%d/%d", HvFILL((HV*)TARG), HvMAX((HV*)TARG)+1);
  93             sv_setpv(sv, buf);
  94         }
  95         else
  96             sv_setiv(sv, 0);
  97         SETs(sv);
  98         RETURN;
  99     }
 100 }
 101
 102 PP(pp_padany)
 103 {
 104     DIE("NOT IMPL LINE %d",__LINE__);
 105 }
 106
 107 /* Translations. */
 108
 109 PP(pp_rv2gv)
 110 {
 111     dSP; dTOPss;
 112
 113     if (SvROK(sv)) {
 114       wasref:
 115         sv = SvRV(sv);
 116         if (SvTYPE(sv) == SVt_PVIO) {
 117             GV *gv = (GV*) sv_newmortal();
 118             gv_init(gv, 0, "", 0, 0);
 119             GvIOp(gv) = (IO *)sv;
 120             SvREFCNT_inc(sv);
 121             sv = (SV*) gv;
 122         } else if (SvTYPE(sv) == SVt_PVCV) {
 123             sv = (SV*) CvGV(sv);
 124         } else if (SvTYPE(sv) != SVt_PVGV)
 125             DIE("Not a GLOB reference");
 126     }
 127     else {
 128         if (SvTYPE(sv) != SVt_PVGV) {
 129             char *sym;
 130
 131             if (SvGMAGICAL(sv)) {
 132                 mg_get(sv);
 133                 if (SvROK(sv))
 134                     goto wasref;
 135             }
 136             if (!SvOK(sv)) {
 137                 if (op->op_flags & OPf_REF ||
 138                     op->op_private & HINT_STRICT_REFS)
 139                     DIE(no_usym, "a symbol");
 140                 RETSETUNDEF;
 141             }
 142             sym = SvPV(sv, na);
 143             if (op->op_private & HINT_STRICT_REFS)
 144                 DIE(no_symref, sym, "a symbol");
 145             sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
 146         }
 147     }
 148     if (op->op_private & OPpLVAL_INTRO)
 149         save_gp((GV*)sv, !(op->op_flags & OPf_SPECIAL));
 150     SETs(sv);
 151     RETURN;
 152 }
 153
 154 PP(pp_rv2sv)
 155 {
 156     dSP; dTOPss;
 157
 158     if (SvROK(sv)) {
 159       wasref:
 160         sv = SvRV(sv);
 161         switch (SvTYPE(sv)) {
 162         case SVt_PVAV:
 163         case SVt_PVHV:
 164         case SVt_PVCV:
 165             DIE("Not a SCALAR reference");
 166         }
 167     }
 168     else {
 169         GV *gv = (GV*)sv;
 170         char *sym;
 171
 172         if (SvTYPE(gv) != SVt_PVGV) {
 173             if (SvGMAGICAL(sv)) {
 174                 mg_get(sv);
 175                 if (SvROK(sv))
 176                     goto wasref;
 177             }
 178             if (!SvOK(sv)) {
 179                 if (op->op_flags & OPf_REF ||
 180                     op->op_private & HINT_STRICT_REFS)
 181                     DIE(no_usym, "a SCALAR");
 182                 RETSETUNDEF;
 183             }
 184             sym = SvPV(sv, na);
 185             if (op->op_private & HINT_STRICT_REFS)
 186                 DIE(no_symref, sym, "a SCALAR");
 187             gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
 188         }
 189         sv = GvSV(gv);
 190     }
 191     if (op->op_flags & OPf_MOD) {
 192         if (op->op_private & OPpLVAL_INTRO)
 193             sv = save_scalar((GV*)TOPs);
 194         else if (op->op_private & OPpDEREF)
 195             provide_ref(op, sv);
 196     }
 197     SETs(sv);
 198     RETURN;
 199 }
 200
 201 PP(pp_av2arylen)
 202 {
 203     dSP;
 204     AV *av = (AV*)TOPs;
 205     SV *sv = AvARYLEN(av);
 206     if (!sv) {
 207         AvARYLEN(av) = sv = NEWSV(0,0);
 208         sv_upgrade(sv, SVt_IV);
 209         sv_magic(sv, (SV*)av, '#', Nullch, 0);
 210     }
 211     SETs(sv);
 212     RETURN;
 213 }
 214
 215 PP(pp_pos)
 216 {
 217     dSP; dTARGET; dPOPss;
 218
 219     if (op->op_flags & OPf_MOD) {
 220         if (SvTYPE(TARG) < SVt_PVLV) {
 221             sv_upgrade(TARG, SVt_PVLV);
 222             sv_magic(TARG, Nullsv, '.', Nullch, 0);
 223         }
 224
 225         LvTYPE(TARG) = '.';
 226         LvTARG(TARG) = sv;
 227         PUSHs(TARG);    /* no SvSETMAGIC */
 228         RETURN;
 229     }
 230     else {
 231         MAGIC* mg;
 232
 233         if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
 234             mg = mg_find(sv, 'g');
 235             if (mg && mg->mg_len >= 0) {
 236                 PUSHi(mg->mg_len + curcop->cop_arybase);
 237                 RETURN;
 238             }
 239         }
 240         RETPUSHUNDEF;
 241     }
 242 }
 243
 244 PP(pp_rv2cv)
 245 {
 246     dSP;
 247     GV *gv;
 248     HV *stash;
 249
 250     /* We usually try to add a non-existent subroutine in case of AUTOLOAD. */
 251     /* (But not in defined().) */
 252     CV *cv = sv_2cv(TOPs, &stash, &gv, !(op->op_flags & OPf_SPECIAL));
 253     if (cv) {
 254         if (CvCLONE(cv))
 255             cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
 256     }
 257     else
 258         cv = (CV*)&sv_undef;
 259     SETs((SV*)cv);
 260     RETURN;
 261 }
 262
 263 PP(pp_prototype)
 264 {
 265     dSP;
 266     CV *cv;
 267     HV *stash;
 268     GV *gv;
 269     SV *ret;
 270
 271     ret = &sv_undef;
 272     cv = sv_2cv(TOPs, &stash, &gv, FALSE);
 273     if (cv && SvPOK(cv))
 274         ret = sv_2mortal(newSVpv(SvPVX(cv), SvCUR(cv)));
 275     SETs(ret);
 276     RETURN;
 277 }
 278
 279 PP(pp_anoncode)
 280 {
 281     dSP;
 282     CV* cv = (CV*)curpad[op->op_targ];
 283     if (CvCLONE(cv))
 284         cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
 285     EXTEND(SP,1);
 286     PUSHs((SV*)cv);
 287     RETURN;
 288 }
 289
 290 PP(pp_srefgen)
 291 {
 292     dSP;
 293     *SP = refto(*SP);
 294     RETURN;
 295 }
 296
 297 PP(pp_refgen)
 298 {
 299     dSP; dMARK;
 300     if (GIMME != G_ARRAY) {
 301         MARK[1] = *SP;
 302         SP = MARK + 1;
 303     }
 304     EXTEND_MORTAL(SP - MARK);
 305     while (++MARK <= SP)
 306         *MARK = refto(*MARK);
 307     RETURN;
 308 }
 309
 310 static SV*
 311 refto(sv)
 312 SV* sv;
 313 {
 314     SV* rv;
 315
 316     if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') {
 317         if (LvTARGLEN(sv))
 318             vivify_itervar(sv);
 319         if (LvTARG(sv))
 320             sv = LvTARG(sv);
 321     }
 322     else if (SvPADTMP(sv))
 323         sv = newSVsv(sv);
 324     else {
 325         SvTEMP_off(sv);
 326         (void)SvREFCNT_inc(sv);
 327     }
 328     rv = sv_newmortal();
 329     sv_upgrade(rv, SVt_RV);
 330     SvRV(rv) = sv;
 331     SvROK_on(rv);
 332     return rv;
 333 }
 334
 335 PP(pp_ref)
 336 {
 337     dSP; dTARGET;
 338     SV *sv;
 339     char *pv;
 340
 341     sv = POPs;
 342
 343     if (sv && SvGMAGICAL(sv))
 344         mg_get(sv);
 345
 346     if (!sv || !SvROK(sv))
 347         RETPUSHNO;
 348
 349     sv = SvRV(sv);
 350     pv = sv_reftype(sv,TRUE);
 351     PUSHp(pv, strlen(pv));
 352     RETURN;
 353 }
 354
 355 PP(pp_bless)
 356 {
 357     dSP;
 358     HV *stash;
 359
 360     if (MAXARG == 1)
 361         stash = curcop->cop_stash;
 362     else
 363         stash = gv_stashsv(POPs, TRUE);
 364
 365     (void)sv_bless(TOPs, stash);
 366     RETURN;
 367 }
 368
 369 /* Pattern matching */
 370
 371 PP(pp_study)
 372 {
 373     dSP; dPOPss;
 374     register unsigned char *s;
 375     register I32 pos;
 376     register I32 ch;
 377     register I32 *sfirst;
 378     register I32 *snext;
 379     I32 retval;
 380     STRLEN len;
 381
 382     s = (unsigned char*)(SvPV(sv, len));
 383     pos = len;
 384     if (sv == lastscream)
 385         SvSCREAM_off(sv);
 386     else {
 387         if (lastscream) {
 388             SvSCREAM_off(lastscream);
 389             SvREFCNT_dec(lastscream);
 390         }
 391         lastscream = SvREFCNT_inc(sv);
 392     }
 393     if (pos <= 0) {
 394         retval = 0;
 395         goto ret;
 396     }
 397     if (pos > maxscream) {
 398         if (maxscream < 0) {
 399             maxscream = pos + 80;
 400             New(301, screamfirst, 256, I32);
 401             New(302, screamnext, maxscream, I32);
 402         }
 403         else {
 404             maxscream = pos + pos / 4;
 405             Renew(screamnext, maxscream, I32);
 406         }
 407     }
 408
 409     sfirst = screamfirst;
 410     snext = screamnext;
 411
 412     if (!sfirst || !snext)
 413         DIE("do_study: out of memory");
 414
 415     for (ch = 256; ch; --ch)
 416         *sfirst++ = -1;
 417     sfirst -= 256;
 418
 419     while (--pos >= 0) {
 420         ch = s[pos];
 421         if (sfirst[ch] >= 0)
 422             snext[pos] = sfirst[ch] - pos;
 423         else
 424             snext[pos] = -pos;
 425         sfirst[ch] = pos;
 426     }
 427
 428     SvSCREAM_on(sv);
 429     sv_magic(sv, Nullsv, 'g', Nullch, 0);       /* piggyback on m//g magic */
 430     retval = 1;
 431   ret:
 432     XPUSHs(sv_2mortal(newSViv((I32)retval)));
 433     RETURN;
 434 }
 435
 436 PP(pp_trans)
 437 {
 438     dSP; dTARG;
 439     SV *sv;
 440
 441     if (op->op_flags & OPf_STACKED)
 442         sv = POPs;
 443     else {
 444         sv = GvSV(defgv);
 445         EXTEND(SP,1);
 446     }
 447     TARG = sv_newmortal();
 448     PUSHi(do_trans(sv, op));
 449     RETURN;
 450 }
 451
 452 /* Lvalue operators. */
 453
 454 PP(pp_schop)
 455 {
 456     dSP; dTARGET;
 457     do_chop(TARG, TOPs);
 458     SETTARG;
 459     RETURN;
 460 }
 461
 462 PP(pp_chop)
 463 {
 464     dSP; dMARK; dTARGET;
 465     while (SP > MARK)
 466         do_chop(TARG, POPs);
 467     PUSHTARG;
 468     RETURN;
 469 }
 470
 471 PP(pp_schomp)
 472 {
 473     dSP; dTARGET;
 474     SETi(do_chomp(TOPs));
 475     RETURN;
 476 }
 477
 478 PP(pp_chomp)
 479 {
 480     dSP; dMARK; dTARGET;
 481     register I32 count = 0;
 482
 483     while (SP > MARK)
 484         count += do_chomp(POPs);
 485     PUSHi(count);
 486     RETURN;
 487 }
 488
 489 PP(pp_defined)
 490 {
 491     dSP;
 492     register SV* sv;
 493
 494     sv = POPs;
 495     if (!sv || !SvANY(sv))
 496         RETPUSHNO;
 497     switch (SvTYPE(sv)) {
 498     case SVt_PVAV:
 499         if (AvMAX(sv) >= 0 || SvRMAGICAL(sv))
 500             RETPUSHYES;
 501         break;
 502     case SVt_PVHV:
 503         if (HvARRAY(sv) || SvRMAGICAL(sv))
 504             RETPUSHYES;
 505         break;
 506     case SVt_PVCV:
 507         if (CvROOT(sv) || CvXSUB(sv))
 508             RETPUSHYES;
 509         break;
 510     default:
 511         if (SvGMAGICAL(sv))
 512             mg_get(sv);
 513         if (SvOK(sv))
 514             RETPUSHYES;
 515     }
 516     RETPUSHNO;
 517 }
 518
 519 PP(pp_undef)
 520 {
 521     dSP;
 522     SV *sv;
 523
 524     if (!op->op_private)
 525         RETPUSHUNDEF;
 526
 527     sv = POPs;
 528     if (!sv)
 529         RETPUSHUNDEF;
 530
 531     if (SvTHINKFIRST(sv)) {
 532         if (SvREADONLY(sv))
 533             RETPUSHUNDEF;
 534         if (SvROK(sv))
 535             sv_unref(sv);
 536     }
 537
 538     switch (SvTYPE(sv)) {
 539     case SVt_NULL:
 540         break;
 541     case SVt_PVAV:
 542         av_undef((AV*)sv);
 543         break;
 544     case SVt_PVHV:
 545         hv_undef((HV*)sv);
 546         break;
 547     case SVt_PVCV:
 548         cv_undef((CV*)sv);
 549         sub_generation++;
 550         break;
 551     case SVt_PVGV:
 552         if (SvFAKE(sv)) {
 553             sv_setsv(sv, &sv_undef);
 554             break;
 555         }
 556     default:
 557         if (SvPOK(sv) && SvLEN(sv)) {
 558             (void)SvOOK_off(sv);
 559             Safefree(SvPVX(sv));
 560             SvPV_set(sv, Nullch);
 561             SvLEN_set(sv, 0);
 562         }
 563         (void)SvOK_off(sv);
 564         SvSETMAGIC(sv);
 565     }
 566
 567     RETPUSHUNDEF;
 568 }
 569
 570 PP(pp_predec)
 571 {
 572     dSP;
 573     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
 574         SvIVX(TOPs) != IV_MIN)
 575     {
 576         --SvIVX(TOPs);
 577         SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
 578     }
 579     else
 580         sv_dec(TOPs);
 581     SvSETMAGIC(TOPs);
 582     return NORMAL;
 583 }
 584
 585 PP(pp_postinc)
 586 {
 587     dSP; dTARGET;
 588     sv_setsv(TARG, TOPs);
 589     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
 590         SvIVX(TOPs) != IV_MAX)
 591     {
 592         ++SvIVX(TOPs);
 593         SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
 594     }
 595     else
 596         sv_inc(TOPs);
 597     SvSETMAGIC(TOPs);
 598     if (!SvOK(TARG))
 599         sv_setiv(TARG, 0);
 600     SETs(TARG);
 601     return NORMAL;
 602 }
 603
 604 PP(pp_postdec)
 605 {
 606     dSP; dTARGET;
 607     sv_setsv(TARG, TOPs);
 608     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
 609         SvIVX(TOPs) != IV_MIN)
 610     {
 611         --SvIVX(TOPs);
 612         SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
 613     }
 614     else
 615         sv_dec(TOPs);
 616     SvSETMAGIC(TOPs);
 617     SETs(TARG);
 618     return NORMAL;
 619 }
 620
 621 /* Ordinary operators. */
 622
 623 PP(pp_pow)
 624 {
 625     dSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
 626     {
 627       dPOPTOPnnrl;
 628       SETn( pow( left, right) );
 629       RETURN;
 630     }
 631 }
 632
 633 PP(pp_multiply)
 634 {
 635     dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
 636     {
 637       dPOPTOPnnrl;
 638       SETn( left * right );
 639       RETURN;
 640     }
 641 }
 642
 643 PP(pp_divide)
 644 {
 645     dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
 646     {
 647       dPOPPOPnnrl;
 648       double value;
 649       if (right == 0.0)
 650         DIE("Illegal division by zero");
 651 #ifdef SLOPPYDIVIDE
 652       /* insure that 20./5. == 4. */
 653       {
 654         IV k;
 655         if ((double)I_V(left)  == left &&
 656             (double)I_V(right) == right &&
 657             (k = I_V(left)/I_V(right))*I_V(right) == I_V(left)) {
 658             value = k;
 659         } else {
 660             value = left / right;
 661         }
 662       }
 663 #else
 664       value = left / right;
 665 #endif
 666       PUSHn( value );
 667       RETURN;
 668     }
 669 }
 670
 671 PP(pp_modulo)
 672 {
 673     dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
 674     {
 675       register UV right;
 676
 677       right = POPu;
 678       if (!right)
 679         DIE("Illegal modulus zero");
 680
 681       if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
 682         register IV left = SvIVX(TOPs);
 683         if (left < 0)
 684           SETu( (right - ((UV)(-left) - 1) % right) - 1 );
 685         else
 686           SETi( left % right );
 687       }
 688       else {
 689         register double left = TOPn;
 690         if (left < 0.0)
 691           SETu( (right - (U_V(-left) - 1) % right) - 1 );
 692         else
 693           SETu( U_V(left) % right );
 694       }
 695       RETURN;
 696     }
 697 }
 698
 699 PP(pp_repeat)
 700 {
 701   dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
 702   {
 703     register I32 count = POPi;
 704     if (GIMME == G_ARRAY && op->op_private & OPpREPEAT_DOLIST) {
 705         dMARK;
 706         I32 items = SP - MARK;
 707         I32 max;
 708
 709         max = items * count;
 710         MEXTEND(MARK, max);
 711         if (count > 1) {
 712             while (SP > MARK) {
 713                 if (*SP)
 714                     SvTEMP_off((*SP));
 715                 SP--;
 716             }
 717             MARK++;
 718             repeatcpy((char*)(MARK + items), (char*)MARK,
 719                 items * sizeof(SV*), count - 1);
 720             SP += max;
 721         }
 722         else if (count <= 0)
 723             SP -= items;
 724     }
 725     else {      /* Note: mark already snarfed by pp_list */
 726         SV *tmpstr;
 727         STRLEN len;
 728
 729         tmpstr = POPs;
 730         if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) {
 731             if (SvREADONLY(tmpstr) && curcop != &compiling)
 732                 DIE("Can't x= to readonly value");
 733             if (SvROK(tmpstr))
 734                 sv_unref(tmpstr);
 735         }
 736         SvSetSV(TARG, tmpstr);
 737         SvPV_force(TARG, len);
 738         if (count != 1) {
 739             if (count < 1)
 740                 SvCUR_set(TARG, 0);
 741             else {
 742                 SvGROW(TARG, (count * len) + 1);
 743                 repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
 744                 SvCUR(TARG) *= count;
 745             }
 746             *SvEND(TARG) = '\0';
 747         }
 748         (void)SvPOK_only(TARG);
 749         PUSHTARG;
 750     }
 751     RETURN;
 752   }
 753 }
 754
 755 PP(pp_subtract)
 756 {
 757     dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
 758     {
 759       dPOPTOPnnrl_ul;
 760       SETn( left - right );
 761       RETURN;
 762     }
 763 }
 764
 765 PP(pp_left_shift)
 766 {
 767     dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
 768     {
 769       IBW shift = POPi;
 770       if (op->op_private & HINT_INTEGER) {
 771         IBW i = TOPi;
 772         SETi( i << shift );
 773       }
 774       else {
 775         UBW u = TOPu;
 776         SETu( u << shift );
 777       }
 778       RETURN;
 779     }
 780 }
 781
 782 PP(pp_right_shift)
 783 {
 784     dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
 785     {
 786       IBW shift = POPi;
 787       if (op->op_private & HINT_INTEGER) {
 788         IBW i = TOPi;
 789         SETi( i >> shift );
 790       }
 791       else {
 792         UBW u = TOPu;
 793         SETu( u >> shift );
 794       }
 795       RETURN;
 796     }
 797 }
 798
 799 PP(pp_lt)
 800 {
 801     dSP; tryAMAGICbinSET(lt,0);
 802     {
 803       dPOPnv;
 804       SETs((TOPn < value) ? &sv_yes : &sv_no);
 805       RETURN;
 806     }
 807 }
 808
 809 PP(pp_gt)
 810 {
 811     dSP; tryAMAGICbinSET(gt,0);
 812     {
 813       dPOPnv;
 814       SETs((TOPn > value) ? &sv_yes : &sv_no);
 815       RETURN;
 816     }
 817 }
 818
 819 PP(pp_le)
 820 {
 821     dSP; tryAMAGICbinSET(le,0);
 822     {
 823       dPOPnv;
 824       SETs((TOPn <= value) ? &sv_yes : &sv_no);
 825       RETURN;
 826     }
 827 }
 828
 829 PP(pp_ge)
 830 {
 831     dSP; tryAMAGICbinSET(ge,0);
 832     {
 833       dPOPnv;
 834       SETs((TOPn >= value) ? &sv_yes : &sv_no);
 835       RETURN;
 836     }
 837 }
 838
 839 PP(pp_ne)
 840 {
 841     dSP; tryAMAGICbinSET(ne,0);
 842     {
 843       dPOPnv;
 844       SETs((TOPn != value) ? &sv_yes : &sv_no);
 845       RETURN;
 846     }
 847 }
 848
 849 PP(pp_ncmp)
 850 {
 851     dSP; dTARGET; tryAMAGICbin(ncmp,0);
 852     {
 853       dPOPTOPnnrl;
 854       I32 value;
 855
 856       if (left > right)
 857         value = 1;
 858       else if (left < right)
 859         value = -1;
 860       else
 861         value = 0;
 862       SETi(value);
 863       RETURN;
 864     }
 865 }
 866
 867 PP(pp_slt)
 868 {
 869     dSP; tryAMAGICbinSET(slt,0);
 870     {
 871       dPOPTOPssrl;
 872       int cmp = ((op->op_private & OPpLOCALE)
 873                  ? sv_cmp_locale(left, right)
 874                  : sv_cmp(left, right));
 875       SETs( cmp < 0 ? &sv_yes : &sv_no );
 876       RETURN;
 877     }
 878 }
 879
 880 PP(pp_sgt)
 881 {
 882     dSP; tryAMAGICbinSET(sgt,0);
 883     {
 884       dPOPTOPssrl;
 885       int cmp = ((op->op_private & OPpLOCALE)
 886                  ? sv_cmp_locale(left, right)
 887                  : sv_cmp(left, right));
 888       SETs( cmp > 0 ? &sv_yes : &sv_no );
 889       RETURN;
 890     }
 891 }
 892
 893 PP(pp_sle)
 894 {
 895     dSP; tryAMAGICbinSET(sle,0);
 896     {
 897       dPOPTOPssrl;
 898       int cmp = ((op->op_private & OPpLOCALE)
 899                  ? sv_cmp_locale(left, right)
 900                  : sv_cmp(left, right));
 901       SETs( cmp <= 0 ? &sv_yes : &sv_no );
 902       RETURN;
 903     }
 904 }
 905
 906 PP(pp_sge)
 907 {
 908     dSP; tryAMAGICbinSET(sge,0);
 909     {
 910       dPOPTOPssrl;
 911       int cmp = ((op->op_private & OPpLOCALE)
 912                  ? sv_cmp_locale(left, right)
 913                  : sv_cmp(left, right));
 914       SETs( cmp >= 0 ? &sv_yes : &sv_no );
 915       RETURN;
 916     }
 917 }
 918
 919 PP(pp_seq)
 920 {
 921     dSP; tryAMAGICbinSET(seq,0);
 922     {
 923       dPOPTOPssrl;
 924       SETs( sv_eq(left, right) ? &sv_yes : &sv_no );
 925       RETURN;
 926     }
 927 }
 928
 929 PP(pp_sne)
 930 {
 931     dSP; tryAMAGICbinSET(sne,0);
 932     {
 933       dPOPTOPssrl;
 934       SETs( !sv_eq(left, right) ? &sv_yes : &sv_no );
 935       RETURN;
 936     }
 937 }
 938
 939 PP(pp_scmp)
 940 {
 941     dSP; dTARGET;  tryAMAGICbin(scmp,0);
 942     {
 943       dPOPTOPssrl;
 944       int cmp = ((op->op_private & OPpLOCALE)
 945                  ? sv_cmp_locale(left, right)
 946                  : sv_cmp(left, right));
 947       SETi( cmp );
 948       RETURN;
 949     }
 950 }
 951
 952 PP(pp_bit_and)
 953 {
 954     dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
 955     {
 956       dPOPTOPssrl;
 957       if (SvNIOKp(left) || SvNIOKp(right)) {
 958         if (op->op_private & HINT_INTEGER) {
 959           IBW value = SvIV(left) & SvIV(right);
 960           SETi( value );
 961         }
 962         else {
 963           UBW value = SvUV(left) & SvUV(right);
 964           SETu( value );
 965         }
 966       }
 967       else {
 968         do_vop(op->op_type, TARG, left, right);
 969         SETTARG;
 970       }
 971       RETURN;
 972     }
 973 }
 974
 975 PP(pp_bit_xor)
 976 {
 977     dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
 978     {
 979       dPOPTOPssrl;
 980       if (SvNIOKp(left) || SvNIOKp(right)) {
 981         if (op->op_private & HINT_INTEGER) {
 982           IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
 983           SETi( value );
 984         }
 985         else {
 986           UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
 987           SETu( value );
 988         }
 989       }
 990       else {
 991         do_vop(op->op_type, TARG, left, right);
 992         SETTARG;
 993       }
 994       RETURN;
 995     }
 996 }
 997
 998 PP(pp_bit_or)
 999 {
1000     dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
1001     {
1002       dPOPTOPssrl;
1003       if (SvNIOKp(left) || SvNIOKp(right)) {
1004         if (op->op_private & HINT_INTEGER) {
1005           IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
1006           SETi( value );
1007         }
1008         else {
1009           UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
1010           SETu( value );
1011         }
1012       }
1013       else {
1014         do_vop(op->op_type, TARG, left, right);
1015         SETTARG;
1016       }
1017       RETURN;
1018     }
1019 }
1020
1021 PP(pp_negate)
1022 {
1023     dSP; dTARGET; tryAMAGICun(neg);
1024     {
1025         dTOPss;
1026         if (SvGMAGICAL(sv))
1027             mg_get(sv);
1028         if (SvIOKp(sv) && !SvNOKp(sv) && !SvPOKp(sv) && SvIVX(sv) != IV_MIN)
1029             SETi(-SvIVX(sv));
1030         else if (SvNIOKp(sv))
1031             SETn(-SvNV(sv));
1032         else if (SvPOKp(sv)) {
1033             STRLEN len;
1034             char *s = SvPV(sv, len);
1035             if (isIDFIRST(*s)) {
1036                 sv_setpvn(TARG, "-", 1);
1037                 sv_catsv(TARG, sv);
1038             }
1039             else if (*s == '+' || *s == '-') {
1040                 sv_setsv(TARG, sv);
1041                 *SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
1042             }
1043             else
1044                 sv_setnv(TARG, -SvNV(sv));
1045             SETTARG;
1046         }
1047         else
1048             SETn(-SvNV(sv));
1049     }
1050     RETURN;
1051 }
1052
1053 PP(pp_not)
1054 {
1055 #ifdef OVERLOAD
1056     dSP; tryAMAGICunSET(not);
1057 #endif /* OVERLOAD */
1058     *stack_sp = SvTRUE(*stack_sp) ? &sv_no : &sv_yes;
1059     return NORMAL;
1060 }
1061
1062 PP(pp_complement)
1063 {
1064     dSP; dTARGET; tryAMAGICun(compl);
1065     {
1066       dTOPss;
1067       if (SvNIOKp(sv)) {
1068         if (op->op_private & HINT_INTEGER) {
1069           IBW value = ~SvIV(sv);
1070           SETi( value );
1071         }
1072         else {
1073           UBW value = ~SvUV(sv);
1074           SETu( value );
1075         }
1076       }
1077       else {
1078         register char *tmps;
1079         register long *tmpl;
1080         register I32 anum;
1081         STRLEN len;
1082
1083         SvSetSV(TARG, sv);
1084         tmps = SvPV_force(TARG, len);
1085         anum = len;
1086 #ifdef LIBERAL
1087         for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
1088             *tmps = ~*tmps;
1089         tmpl = (long*)tmps;
1090         for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
1091             *tmpl = ~*tmpl;
1092         tmps = (char*)tmpl;
1093 #endif
1094         for ( ; anum > 0; anum--, tmps++)
1095             *tmps = ~*tmps;
1096
1097         SETs(TARG);
1098       }
1099       RETURN;
1100     }
1101 }
1102
1103 /* integer versions of some of the above */
1104
1105 PP(pp_i_multiply)
1106 {
1107     dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
1108     {
1109       dPOPTOPiirl;
1110       SETi( left * right );
1111       RETURN;
1112     }
1113 }
1114
1115 PP(pp_i_divide)
1116 {
1117     dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
1118     {
1119       dPOPiv;
1120       if (value == 0)
1121         DIE("Illegal division by zero");
1122       value = POPi / value;
1123       PUSHi( value );
1124       RETURN;
1125     }
1126 }
1127
1128 PP(pp_i_modulo)
1129 {
1130     dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
1131     {
1132       dPOPTOPiirl;
1133       SETi( left % right );
1134       RETURN;
1135     }
1136 }
1137
1138 PP(pp_i_add)
1139 {
1140     dSP; dATARGET; tryAMAGICbin(add,opASSIGN);
1141     {
1142       dPOPTOPiirl;
1143       SETi( left + right );
1144       RETURN;
1145     }
1146 }
1147
1148 PP(pp_i_subtract)
1149 {
1150     dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
1151     {
1152       dPOPTOPiirl;
1153       SETi( left - right );
1154       RETURN;
1155     }
1156 }
1157
1158 PP(pp_i_lt)
1159 {
1160     dSP; tryAMAGICbinSET(lt,0);
1161     {
1162       dPOPTOPiirl;
1163       SETs((left < right) ? &sv_yes : &sv_no);
1164       RETURN;
1165     }
1166 }
1167
1168 PP(pp_i_gt)
1169 {
1170     dSP; tryAMAGICbinSET(gt,0);
1171     {
1172       dPOPTOPiirl;
1173       SETs((left > right) ? &sv_yes : &sv_no);
1174       RETURN;
1175     }
1176 }
1177
1178 PP(pp_i_le)
1179 {
1180     dSP; tryAMAGICbinSET(le,0);
1181     {
1182       dPOPTOPiirl;
1183       SETs((left <= right) ? &sv_yes : &sv_no);
1184       RETURN;
1185     }
1186 }
1187
1188 PP(pp_i_ge)
1189 {
1190     dSP; tryAMAGICbinSET(ge,0);
1191     {
1192       dPOPTOPiirl;
1193       SETs((left >= right) ? &sv_yes : &sv_no);
1194       RETURN;
1195     }
1196 }
1197
1198 PP(pp_i_eq)
1199 {
1200     dSP; tryAMAGICbinSET(eq,0);
1201     {
1202       dPOPTOPiirl;
1203       SETs((left == right) ? &sv_yes : &sv_no);
1204       RETURN;
1205     }
1206 }
1207
1208 PP(pp_i_ne)
1209 {
1210     dSP; tryAMAGICbinSET(ne,0);
1211     {
1212       dPOPTOPiirl;
1213       SETs((left != right) ? &sv_yes : &sv_no);
1214       RETURN;
1215     }
1216 }
1217
1218 PP(pp_i_ncmp)
1219 {
1220     dSP; dTARGET; tryAMAGICbin(ncmp,0);
1221     {
1222       dPOPTOPiirl;
1223       I32 value;
1224
1225       if (left > right)
1226         value = 1;
1227       else if (left < right)
1228         value = -1;
1229       else
1230         value = 0;
1231       SETi(value);
1232       RETURN;
1233     }
1234 }
1235
1236 PP(pp_i_negate)
1237 {
1238     dSP; dTARGET; tryAMAGICun(neg);
1239     SETi(-TOPi);
1240     RETURN;
1241 }
1242
1243 /* High falutin' math. */
1244
1245 PP(pp_atan2)
1246 {
1247     dSP; dTARGET; tryAMAGICbin(atan2,0);
1248     {
1249       dPOPTOPnnrl;
1250       SETn(atan2(left, right));
1251       RETURN;
1252     }
1253 }
1254
1255 PP(pp_sin)
1256 {
1257     dSP; dTARGET; tryAMAGICun(sin);
1258     {
1259       double value;
1260       value = POPn;
1261       value = sin(value);
1262       XPUSHn(value);
1263       RETURN;
1264     }
1265 }
1266
1267 PP(pp_cos)
1268 {
1269     dSP; dTARGET; tryAMAGICun(cos);
1270     {
1271       double value;
1272       value = POPn;
1273       value = cos(value);
1274       XPUSHn(value);
1275       RETURN;
1276     }
1277 }
1278
1279 PP(pp_rand)
1280 {
1281     dSP; dTARGET;
1282     double value;
1283     if (MAXARG < 1)
1284         value = 1.0;
1285     else
1286         value = POPn;
1287     if (value == 0.0)
1288         value = 1.0;
1289 #if RANDBITS == 31
1290     value = rand() * value / 2147483648.0;
1291 #else
1292 #if RANDBITS == 16
1293     value = rand() * value / 65536.0;
1294 #else
1295 #if RANDBITS == 15
1296     value = rand() * value / 32768.0;
1297 #else
1298     value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
1299 #endif
1300 #endif
1301 #endif
1302     XPUSHn(value);
1303     RETURN;
1304 }
1305
1306 PP(pp_srand)
1307 {
1308     dSP;
1309     I32 anum;
1310
1311     if (MAXARG < 1) {
1312 #ifdef VMS
1313 #  include <starlet.h>
1314         unsigned int when[2];
1315         _ckvmssts(sys$gettim(when));
1316         anum = when[0] ^ when[1];
1317 #else
1318 #  ifdef HAS_GETTIMEOFDAY
1319         struct timeval when;
1320         gettimeofday(&when,(struct timezone *) 0);
1321         anum = when.tv_sec ^ when.tv_usec;
1322 #  else
1323         Time_t when;
1324         (void)time(&when);
1325         anum = when;
1326 #  endif
1327 #endif
1328 #if !defined(PLAN9) /* XXX Plan9 assembler chokes on this; fix coming soon  */
1329                     /*     17-Jul-1996  bailey@genetics.upenn.edu           */
1330         /* What is a good hashing algorithm here? */
1331         anum ^= (  (  269 * (U32)getpid())
1332                  ^ (26107 * (U32)&when)
1333                  ^ (73819 * (U32)stack_sp));
1334 #endif
1335     }
1336     else
1337         anum = POPi;
1338     (void)srand(anum);
1339     EXTEND(SP, 1);
1340     RETPUSHYES;
1341 }
1342
1343 PP(pp_exp)
1344 {
1345     dSP; dTARGET; tryAMAGICun(exp);
1346     {
1347       double value;
1348       value = POPn;
1349       value = exp(value);
1350       XPUSHn(value);
1351       RETURN;
1352     }
1353 }
1354
1355 PP(pp_log)
1356 {
1357     dSP; dTARGET; tryAMAGICun(log);
1358     {
1359       double value;
1360       value = POPn;
1361       if (value <= 0.0) {
1362         SET_NUMERIC_STANDARD();
1363         DIE("Can't take log of %g", value);
1364       }
1365       value = log(value);
1366       XPUSHn(value);
1367       RETURN;
1368     }
1369 }
1370
1371 PP(pp_sqrt)
1372 {
1373     dSP; dTARGET; tryAMAGICun(sqrt);
1374     {
1375       double value;
1376       value = POPn;
1377       if (value < 0.0) {
1378         SET_NUMERIC_STANDARD();
1379         DIE("Can't take sqrt of %g", value);
1380       }
1381       value = sqrt(value);
1382       XPUSHn(value);
1383       RETURN;
1384     }
1385 }
1386
1387 PP(pp_int)
1388 {
1389     dSP; dTARGET;
1390     double value;
1391     value = POPn;
1392     if (value >= 0.0)
1393         (void)modf(value, &value);
1394     else {
1395         (void)modf(-value, &value);
1396         value = -value;
1397     }
1398     XPUSHn(value);
1399     RETURN;
1400 }
1401
1402 PP(pp_abs)
1403 {
1404     dSP; dTARGET; tryAMAGICun(abs);
1405     {
1406       double value;
1407       value = POPn;
1408
1409       if (value < 0.0)
1410         value = -value;
1411
1412       XPUSHn(value);
1413       RETURN;
1414     }
1415 }
1416
1417 PP(pp_hex)
1418 {
1419     dSP; dTARGET;
1420     char *tmps;
1421     I32 argtype;
1422
1423     tmps = POPp;
1424     XPUSHu(scan_hex(tmps, 99, &argtype));
1425     RETURN;
1426 }
1427
1428 PP(pp_oct)
1429 {
1430     dSP; dTARGET;
1431     UV value;
1432     I32 argtype;
1433     char *tmps;
1434
1435     tmps = POPp;
1436     while (*tmps && isSPACE(*tmps))
1437         tmps++;
1438     if (*tmps == '0')
1439         tmps++;
1440     if (*tmps == 'x')
1441         value = scan_hex(++tmps, 99, &argtype);
1442     else
1443         value = scan_oct(tmps, 99, &argtype);
1444     XPUSHu(value);
1445     RETURN;
1446 }
1447
1448 /* String stuff. */
1449
1450 PP(pp_length)
1451 {
1452     dSP; dTARGET;
1453     SETi( sv_len(TOPs) );
1454     RETURN;
1455 }
1456
1457 PP(pp_substr)
1458 {
1459     dSP; dTARGET;
1460     SV *sv;
1461     I32 len;
1462     STRLEN curlen;
1463     I32 pos;
1464     I32 rem;
1465     I32 lvalue = op->op_flags & OPf_MOD;
1466     char *tmps;
1467     I32 arybase = curcop->cop_arybase;
1468
1469     if (MAXARG > 2)
1470         len = POPi;
1471     pos = POPi - arybase;
1472     sv = POPs;
1473     tmps = SvPV(sv, curlen);
1474     if (pos < 0)
1475         pos += curlen + arybase;
1476     if (pos < 0 || pos > curlen) {
1477         if (dowarn || lvalue)
1478             warn("substr outside of string");
1479         RETPUSHUNDEF;
1480     }
1481     else {
1482         if (MAXARG < 3)
1483             len = curlen;
1484         else if (len < 0) {
1485             len += curlen - pos;
1486             if (len < 0)
1487                 len = 0;
1488         }
1489         tmps += pos;
1490         rem = curlen - pos;     /* rem=how many bytes left*/
1491         if (rem > len)
1492             rem = len;
1493         sv_setpvn(TARG, tmps, rem);
1494         if (lvalue) {                   /* it's an lvalue! */
1495             if (!SvGMAGICAL(sv)) {
1496                 if (SvROK(sv)) {
1497                     SvPV_force(sv,na);
1498                     if (dowarn)
1499                         warn("Attempt to use reference as lvalue in substr");
1500                 }
1501                 if (SvOK(sv))           /* is it defined ? */
1502                     (void)SvPOK_only(sv);
1503                 else
1504                     sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
1505             }
1506
1507             if (SvTYPE(TARG) < SVt_PVLV) {
1508                 sv_upgrade(TARG, SVt_PVLV);
1509                 sv_magic(TARG, Nullsv, 'x', Nullch, 0);
1510             }
1511
1512             LvTYPE(TARG) = 'x';
1513             LvTARG(TARG) = sv;
1514             LvTARGOFF(TARG) = pos;
1515             LvTARGLEN(TARG) = rem;
1516         }
1517     }
1518     PUSHs(TARG);                /* avoid SvSETMAGIC here */
1519     RETURN;
1520 }
1521
1522 PP(pp_vec)
1523 {
1524     dSP; dTARGET;
1525     register I32 size = POPi;
1526     register I32 offset = POPi;
1527     register SV *src = POPs;
1528     I32 lvalue = op->op_flags & OPf_MOD;
1529     STRLEN srclen;
1530     unsigned char *s = (unsigned char*)SvPV(src, srclen);
1531     unsigned long retnum;
1532     I32 len;
1533
1534     offset *= size;             /* turn into bit offset */
1535     len = (offset + size + 7) / 8;
1536     if (offset < 0 || size < 1)
1537         retnum = 0;
1538     else {
1539         if (lvalue) {                      /* it's an lvalue! */
1540             if (SvTYPE(TARG) < SVt_PVLV) {
1541                 sv_upgrade(TARG, SVt_PVLV);
1542                 sv_magic(TARG, Nullsv, 'v', Nullch, 0);
1543             }
1544
1545             LvTYPE(TARG) = 'v';
1546             LvTARG(TARG) = src;
1547             LvTARGOFF(TARG) = offset;
1548             LvTARGLEN(TARG) = size;
1549         }
1550         if (len > srclen) {
1551             if (size <= 8)
1552                 retnum = 0;
1553             else {
1554                 offset >>= 3;
1555                 if (size == 16) {
1556                     if (offset >= srclen)
1557                         retnum = 0;
1558                     else
1559                         retnum = (unsigned long) s[offset] << 8;
1560                 }
1561                 else if (size == 32) {
1562                     if (offset >= srclen)
1563                         retnum = 0;
1564                     else if (offset + 1 >= srclen)
1565                         retnum = (unsigned long) s[offset] << 24;
1566                     else if (offset + 2 >= srclen)
1567                         retnum = ((unsigned long) s[offset] << 24) +
1568                             ((unsigned long) s[offset + 1] << 16);
1569                     else
1570                         retnum = ((unsigned long) s[offset] << 24) +
1571                             ((unsigned long) s[offset + 1] << 16) +
1572                             (s[offset + 2] << 8);
1573                 }
1574             }
1575         }
1576         else if (size < 8)
1577             retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
1578         else {
1579             offset >>= 3;
1580             if (size == 8)
1581                 retnum = s[offset];
1582             else if (size == 16)
1583                 retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
1584             else if (size == 32)
1585                 retnum = ((unsigned long) s[offset] << 24) +
1586                         ((unsigned long) s[offset + 1] << 16) +
1587                         (s[offset + 2] << 8) + s[offset+3];
1588         }
1589     }
1590
1591     sv_setiv(TARG, (I32)retnum);
1592     PUSHs(TARG);
1593     RETURN;
1594 }
1595
1596 PP(pp_index)
1597 {
1598     dSP; dTARGET;
1599     SV *big;
1600     SV *little;
1601     I32 offset;
1602     I32 retval;
1603     char *tmps;
1604     char *tmps2;
1605     STRLEN biglen;
1606     I32 arybase = curcop->cop_arybase;
1607
1608     if (MAXARG < 3)
1609         offset = 0;
1610     else
1611         offset = POPi - arybase;
1612     little = POPs;
1613     big = POPs;
1614     tmps = SvPV(big, biglen);
1615     if (offset < 0)
1616         offset = 0;
1617     else if (offset > biglen)
1618         offset = biglen;
1619     if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
1620       (unsigned char*)tmps + biglen, little)))
1621         retval = -1 + arybase;
1622     else
1623         retval = tmps2 - tmps + arybase;
1624     PUSHi(retval);
1625     RETURN;
1626 }
1627
1628 PP(pp_rindex)
1629 {
1630     dSP; dTARGET;
1631     SV *big;
1632     SV *little;
1633     STRLEN blen;
1634     STRLEN llen;
1635     SV *offstr;
1636     I32 offset;
1637     I32 retval;
1638     char *tmps;
1639     char *tmps2;
1640     I32 arybase = curcop->cop_arybase;
1641
1642     if (MAXARG >= 3)
1643         offstr = POPs;
1644     little = POPs;
1645     big = POPs;
1646     tmps2 = SvPV(little, llen);
1647     tmps = SvPV(big, blen);
1648     if (MAXARG < 3)
1649         offset = blen;
1650     else
1651         offset = SvIV(offstr) - arybase + llen;
1652     if (offset < 0)
1653         offset = 0;
1654     else if (offset > blen)
1655         offset = blen;
1656     if (!(tmps2 = rninstr(tmps,  tmps  + offset,
1657                           tmps2, tmps2 + llen)))
1658         retval = -1 + arybase;
1659     else
1660         retval = tmps2 - tmps + arybase;
1661     PUSHi(retval);
1662     RETURN;
1663 }
1664
1665 PP(pp_sprintf)
1666 {
1667     dSP; dMARK; dORIGMARK; dTARGET;
1668 #ifdef USE_LOCALE_NUMERIC
1669     if (op->op_private & OPpLOCALE)
1670         SET_NUMERIC_LOCAL();
1671     else
1672         SET_NUMERIC_STANDARD();
1673 #endif
1674     do_sprintf(TARG, SP-MARK, MARK+1);
1675     TAINT_IF(SvTAINTED(TARG));
1676     SP = ORIGMARK;
1677     PUSHTARG;
1678     RETURN;
1679 }
1680
1681 PP(pp_ord)
1682 {
1683     dSP; dTARGET;
1684     I32 value;
1685     char *tmps;
1686
1687 #ifndef I286
1688     tmps = POPp;
1689     value = (I32) (*tmps & 255);
1690 #else
1691     I32 anum;
1692     tmps = POPp;
1693     anum = (I32) *tmps;
1694     value = (I32) (anum & 255);
1695 #endif
1696     XPUSHi(value);
1697     RETURN;
1698 }
1699
1700 PP(pp_chr)
1701 {
1702     dSP; dTARGET;
1703     char *tmps;
1704
1705     (void)SvUPGRADE(TARG,SVt_PV);
1706     SvGROW(TARG,2);
1707     SvCUR_set(TARG, 1);
1708     tmps = SvPVX(TARG);
1709     *tmps++ = POPi;
1710     *tmps = '\0';
1711     (void)SvPOK_only(TARG);
1712     XPUSHs(TARG);
1713     RETURN;
1714 }
1715
1716 PP(pp_crypt)
1717 {
1718     dSP; dTARGET; dPOPTOPssrl;
1719 #ifdef HAS_CRYPT
1720     char *tmps = SvPV(left, na);
1721 #ifdef FCRYPT
1722     sv_setpv(TARG, fcrypt(tmps, SvPV(right, na)));
1723 #else
1724     sv_setpv(TARG, crypt(tmps, SvPV(right, na)));
1725 #endif
1726 #else
1727     DIE(
1728       "The crypt() function is unimplemented due to excessive paranoia.");
1729 #endif
1730     SETs(TARG);
1731     RETURN;
1732 }
1733
1734 PP(pp_ucfirst)
1735 {
1736     dSP;
1737     SV *sv = TOPs;
1738     register char *s;
1739
1740     if (!SvPADTMP(sv)) {
1741         dTARGET;
1742         sv_setsv(TARG, sv);
1743         sv = TARG;
1744         SETs(sv);
1745     }
1746     s = SvPV_force(sv, na);
1747     if (*s) {
1748         if (op->op_private & OPpLOCALE) {
1749             TAINT;
1750             SvTAINTED_on(sv);
1751             *s = toUPPER_LC(*s);
1752         }
1753         else
1754             *s = toUPPER(*s);
1755     }
1756
1757     RETURN;
1758 }
1759
1760 PP(pp_lcfirst)
1761 {
1762     dSP;
1763     SV *sv = TOPs;
1764     register char *s;
1765
1766     if (!SvPADTMP(sv)) {
1767         dTARGET;
1768         sv_setsv(TARG, sv);
1769         sv = TARG;
1770         SETs(sv);
1771     }
1772     s = SvPV_force(sv, na);
1773     if (*s) {
1774         if (op->op_private & OPpLOCALE) {
1775             TAINT;
1776             SvTAINTED_on(sv);
1777             *s = toLOWER_LC(*s);
1778         }
1779         else
1780             *s = toLOWER(*s);
1781     }
1782
1783     SETs(sv);
1784     RETURN;
1785 }
1786
1787 PP(pp_uc)
1788 {
1789     dSP;
1790     SV *sv = TOPs;
1791     register char *s;
1792     STRLEN len;
1793
1794     if (!SvPADTMP(sv)) {
1795         dTARGET;
1796         sv_setsv(TARG, sv);
1797         sv = TARG;
1798         SETs(sv);
1799     }
1800
1801     s = SvPV_force(sv, len);
1802     if (len) {
1803         register char *send = s + len;
1804
1805         if (op->op_private & OPpLOCALE) {
1806             TAINT;
1807             SvTAINTED_on(sv);
1808             for (; s < send; s++)
1809                 *s = toUPPER_LC(*s);
1810         }
1811         else {
1812             for (; s < send; s++)
1813                 *s = toUPPER(*s);
1814         }
1815     }
1816     RETURN;
1817 }
1818
1819 PP(pp_lc)
1820 {
1821     dSP;
1822     SV *sv = TOPs;
1823     register char *s;
1824     STRLEN len;
1825
1826     if (!SvPADTMP(sv)) {
1827         dTARGET;
1828         sv_setsv(TARG, sv);
1829         sv = TARG;
1830         SETs(sv);
1831     }
1832
1833     s = SvPV_force(sv, len);
1834     if (len) {
1835         register char *send = s + len;
1836
1837         if (op->op_private & OPpLOCALE) {
1838             TAINT;
1839             SvTAINTED_on(sv);
1840             for (; s < send; s++)
1841                 *s = toLOWER_LC(*s);
1842         }
1843         else {
1844             for (; s < send; s++)
1845                 *s = toLOWER(*s);
1846         }
1847     }
1848     RETURN;
1849 }
1850
1851 PP(pp_quotemeta)
1852 {
1853     dSP; dTARGET;
1854     SV *sv = TOPs;
1855     STRLEN len;
1856     register char *s = SvPV(sv,len);
1857     register char *d;
1858
1859     if (len) {
1860         (void)SvUPGRADE(TARG, SVt_PV);
1861         SvGROW(TARG, (len * 2) + 1);
1862         d = SvPVX(TARG);
1863         while (len--) {
1864             if (!isALNUM(*s))
1865                 *d++ = '\\';
1866             *d++ = *s++;
1867         }
1868         *d = '\0';
1869         SvCUR_set(TARG, d - SvPVX(TARG));
1870         (void)SvPOK_only(TARG);
1871     }
1872     else
1873         sv_setpvn(TARG, s, len);
1874     SETs(TARG);
1875     RETURN;
1876 }
1877
1878 /* Arrays. */
1879
1880 PP(pp_aslice)
1881 {
1882     dSP; dMARK; dORIGMARK;
1883     register SV** svp;
1884     register AV* av = (AV*)POPs;
1885     register I32 lval = op->op_flags & OPf_MOD;
1886     I32 arybase = curcop->cop_arybase;
1887     I32 elem;
1888
1889     if (SvTYPE(av) == SVt_PVAV) {
1890         if (lval && op->op_private & OPpLVAL_INTRO) {
1891             I32 max = -1;
1892             for (svp = mark + 1; svp <= sp; svp++) {
1893                 elem = SvIVx(*svp);
1894                 if (elem > max)
1895                     max = elem;
1896             }
1897             if (max > AvMAX(av))
1898                 av_extend(av, max);
1899         }
1900         while (++MARK <= SP) {
1901             elem = SvIVx(*MARK);
1902
1903             if (elem > 0)
1904                 elem -= arybase;
1905             svp = av_fetch(av, elem, lval);
1906             if (lval) {
1907                 if (!svp || *svp == &sv_undef)
1908                     DIE(no_aelem, elem);
1909                 if (op->op_private & OPpLVAL_INTRO)
1910                     save_svref(svp);
1911             }
1912             *MARK = svp ? *svp : &sv_undef;
1913         }
1914     }
1915     if (GIMME != G_ARRAY) {
1916         MARK = ORIGMARK;
1917         *++MARK = *SP;
1918         SP = MARK;
1919     }
1920     RETURN;
1921 }
1922
1923 /* Associative arrays. */
1924
1925 PP(pp_each)
1926 {
1927     dSP; dTARGET;
1928     HV *hash = (HV*)POPs;
1929     HE *entry;
1930
1931     PUTBACK;
1932     entry = hv_iternext(hash);                        /* might clobber stack_sp */
1933     SPAGAIN;
1934
1935     EXTEND(SP, 2);
1936     if (entry) {
1937         PUSHs(hv_iterkeysv(entry));                   /* won't clobber stack_sp */
1938         if (GIMME == G_ARRAY) {
1939             PUTBACK;
1940             sv_setsv(TARG, hv_iterval(hash, entry));  /* might clobber stack_sp */
1941             SPAGAIN;
1942             PUSHs(TARG);
1943         }
1944     }
1945     else if (GIMME == G_SCALAR)
1946         RETPUSHUNDEF;
1947
1948     RETURN;
1949 }
1950
1951 PP(pp_values)
1952 {
1953     return do_kv(ARGS);
1954 }
1955
1956 PP(pp_keys)
1957 {
1958     return do_kv(ARGS);
1959 }
1960
1961 PP(pp_delete)
1962 {
1963     dSP;
1964     SV *sv;
1965     HV *hv;
1966
1967     if (op->op_private & OPpSLICE) {
1968         dMARK; dORIGMARK;
1969         hv = (HV*)POPs;
1970         if (SvTYPE(hv) != SVt_PVHV)
1971             DIE("Not a HASH reference");
1972         while (++MARK <= SP) {
1973             sv = hv_delete_ent(hv, *MARK,
1974                         (op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0), 0);
1975             *MARK = sv ? sv : &sv_undef;
1976         }
1977         if (GIMME != G_ARRAY) {
1978             MARK = ORIGMARK;
1979             *++MARK = *SP;
1980             SP = MARK;
1981         }
1982     }
1983     else {
1984         SV *keysv = POPs;
1985         hv = (HV*)POPs;
1986         if (SvTYPE(hv) != SVt_PVHV)
1987             DIE("Not a HASH reference");
1988         sv = hv_delete_ent(hv, keysv,
1989                         (op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0), 0);
1990         if (!sv)
1991             sv = &sv_undef;
1992         PUSHs(sv);
1993     }
1994     RETURN;
1995 }
1996
1997 PP(pp_exists)
1998 {
1999     dSP;
2000     SV *tmpsv = POPs;
2001     HV *hv = (HV*)POPs;
2002     STRLEN len;
2003     if (SvTYPE(hv) != SVt_PVHV) {
2004         DIE("Not a HASH reference");
2005     }
2006     if (hv_exists_ent(hv, tmpsv, 0))
2007         RETPUSHYES;
2008     RETPUSHNO;
2009 }
2010
2011 PP(pp_hslice)
2012 {
2013     dSP; dMARK; dORIGMARK;
2014     register HE *he;
2015     register HV *hv = (HV*)POPs;
2016     register I32 lval = op->op_flags & OPf_MOD;
2017
2018     if (SvTYPE(hv) == SVt_PVHV) {
2019         while (++MARK <= SP) {
2020             SV *keysv = *MARK;
2021
2022             he = hv_fetch_ent(hv, keysv, lval, 0);
2023             if (lval) {
2024                 if (!he || HeVAL(he) == &sv_undef)
2025                     DIE(no_helem, SvPV(keysv, na));
2026                 if (op->op_private & OPpLVAL_INTRO)
2027                     save_svref(&HeVAL(he));
2028             }
2029             *MARK = he ? HeVAL(he) : &sv_undef;
2030         }
2031     }
2032     if (GIMME != G_ARRAY) {
2033         MARK = ORIGMARK;
2034         *++MARK = *SP;
2035         SP = MARK;
2036     }
2037     RETURN;
2038 }
2039
2040 /* List operators. */
2041
2042 PP(pp_list)
2043 {
2044     dSP; dMARK;
2045     if (GIMME != G_ARRAY) {
2046         if (++MARK <= SP)
2047             *MARK = *SP;                /* unwanted list, return last item */
2048         else
2049             *MARK = &sv_undef;
2050         SP = MARK;
2051     }
2052     RETURN;
2053 }
2054
2055 PP(pp_lslice)
2056 {
2057     dSP;
2058     SV **lastrelem = stack_sp;
2059     SV **lastlelem = stack_base + POPMARK;
2060     SV **firstlelem = stack_base + POPMARK + 1;
2061     register SV **firstrelem = lastlelem + 1;
2062     I32 arybase = curcop->cop_arybase;
2063     I32 lval = op->op_flags & OPf_MOD;
2064     I32 is_something_there = lval;
2065
2066     register I32 max = lastrelem - lastlelem;
2067     register SV **lelem;
2068     register I32 ix;
2069
2070     if (GIMME != G_ARRAY) {
2071         ix = SvIVx(*lastlelem);
2072         if (ix < 0)
2073             ix += max;
2074         else
2075             ix -= arybase;
2076         if (ix < 0 || ix >= max)
2077             *firstlelem = &sv_undef;
2078         else
2079             *firstlelem = firstrelem[ix];
2080         SP = firstlelem;
2081         RETURN;
2082     }
2083
2084     if (max == 0) {
2085         SP = firstlelem - 1;
2086         RETURN;
2087     }
2088
2089     for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
2090         ix = SvIVx(*lelem);
2091         if (ix < 0) {
2092             ix += max;
2093             if (ix < 0)
2094                 *lelem = &sv_undef;
2095             else if (!(*lelem = firstrelem[ix]))
2096                 *lelem = &sv_undef;
2097         }
2098         else {
2099             ix -= arybase;
2100             if (ix >= max || !(*lelem = firstrelem[ix]))
2101                 *lelem = &sv_undef;
2102         }
2103         if (!is_something_there && (SvOKp(*lelem) || SvGMAGICAL(*lelem)))
2104             is_something_there = TRUE;
2105     }
2106     if (is_something_there)
2107         SP = lastlelem;
2108     else
2109         SP = firstlelem - 1;
2110     RETURN;
2111 }
2112
2113 PP(pp_anonlist)
2114 {
2115     dSP; dMARK; dORIGMARK;
2116     I32 items = SP - MARK;
2117     SV *av = sv_2mortal((SV*)av_make(items, MARK+1));
2118     SP = ORIGMARK;              /* av_make() might realloc stack_sp */
2119     XPUSHs(av);
2120     RETURN;
2121 }
2122
2123 PP(pp_anonhash)
2124 {
2125     dSP; dMARK; dORIGMARK;
2126     HV* hv = (HV*)sv_2mortal((SV*)newHV());
2127
2128     while (MARK < SP) {
2129         SV* key = *++MARK;
2130         SV *val = NEWSV(46, 0);
2131         if (MARK < SP)
2132             sv_setsv(val, *++MARK);
2133         else
2134             warn("Odd number of elements in hash list");
2135         (void)hv_store_ent(hv,key,val,0);
2136     }
2137     SP = ORIGMARK;
2138     XPUSHs((SV*)hv);
2139     RETURN;
2140 }
2141
2142 PP(pp_splice)
2143 {
2144     dSP; dMARK; dORIGMARK;
2145     register AV *ary = (AV*)*++MARK;
2146     register SV **src;
2147     register SV **dst;
2148     register I32 i;
2149     register I32 offset;
2150     register I32 length;
2151     I32 newlen;
2152     I32 after;
2153     I32 diff;
2154     SV **tmparyval = 0;
2155
2156     SP++;
2157
2158     if (++MARK < SP) {
2159         offset = SvIVx(*MARK);
2160         if (offset < 0)
2161             offset += AvFILL(ary) + 1;
2162         else
2163             offset -= curcop->cop_arybase;
2164         if (++MARK < SP) {
2165             length = SvIVx(*MARK++);
2166             if (length < 0)
2167                 length = 0;
2168         }
2169         else
2170             length = AvMAX(ary) + 1;            /* close enough to infinity */
2171     }
2172     else {
2173         offset = 0;
2174         length = AvMAX(ary) + 1;
2175     }
2176     if (offset < 0) {
2177         length += offset;
2178         offset = 0;
2179         if (length < 0)
2180             length = 0;
2181     }
2182     if (offset > AvFILL(ary) + 1)
2183         offset = AvFILL(ary) + 1;
2184     after = AvFILL(ary) + 1 - (offset + length);
2185     if (after < 0) {                            /* not that much array */
2186         length += after;                        /* offset+length now in array */
2187         after = 0;
2188         if (!AvALLOC(ary))
2189             av_extend(ary, 0);
2190     }
2191
2192     /* At this point, MARK .. SP-1 is our new LIST */
2193
2194     newlen = SP - MARK;
2195     diff = newlen - length;
2196
2197     if (diff < 0) {                             /* shrinking the area */
2198         if (newlen) {
2199             New(451, tmparyval, newlen, SV*);   /* so remember insertion */
2200             Copy(MARK, tmparyval, newlen, SV*);
2201         }
2202
2203         MARK = ORIGMARK + 1;
2204         if (GIMME == G_ARRAY) {                 /* copy return vals to stack */
2205             MEXTEND(MARK, length);
2206             Copy(AvARRAY(ary)+offset, MARK, length, SV*);
2207             if (AvREAL(ary)) {
2208                 EXTEND_MORTAL(length);
2209                 for (i = length, dst = MARK; i; i--) {
2210                     if (!SvIMMORTAL(*dst))
2211                         sv_2mortal(*dst);       /* free them eventualy */
2212                     dst++;
2213                 }
2214             }
2215             MARK += length - 1;
2216         }
2217         else {
2218             *MARK = AvARRAY(ary)[offset+length-1];
2219             if (AvREAL(ary)) {
2220                 if (!SvIMMORTAL(*MARK))
2221                     sv_2mortal(*MARK);
2222                 for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
2223                     SvREFCNT_dec(*dst++);       /* free them now */
2224             }
2225         }
2226         AvFILL(ary) += diff;
2227
2228         /* pull up or down? */
2229
2230         if (offset < after) {                   /* easier to pull up */
2231             if (offset) {                       /* esp. if nothing to pull */
2232                 src = &AvARRAY(ary)[offset-1];
2233                 dst = src - diff;               /* diff is negative */
2234                 for (i = offset; i > 0; i--)    /* can't trust Copy */
2235                     *dst-- = *src--;
2236             }
2237             dst = AvARRAY(ary);
2238             SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
2239             AvMAX(ary) += diff;
2240         }
2241         else {
2242             if (after) {                        /* anything to pull down? */
2243                 src = AvARRAY(ary) + offset + length;
2244                 dst = src + diff;               /* diff is negative */
2245                 Move(src, dst, after, SV*);
2246             }
2247             dst = &AvARRAY(ary)[AvFILL(ary)+1];
2248                                                 /* avoid later double free */
2249         }
2250         i = -diff;
2251         while (i)
2252             dst[--i] = &sv_undef;
2253
2254         if (newlen) {
2255             for (src = tmparyval, dst = AvARRAY(ary) + offset;
2256               newlen; newlen--) {
2257                 *dst = NEWSV(46, 0);
2258                 sv_setsv(*dst++, *src++);
2259             }
2260             Safefree(tmparyval);
2261         }
2262     }
2263     else {                                      /* no, expanding (or same) */
2264         if (length) {
2265             New(452, tmparyval, length, SV*);   /* so remember deletion */
2266             Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
2267         }
2268
2269         if (diff > 0) {                         /* expanding */
2270
2271             /* push up or down? */
2272
2273             if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
2274                 if (offset) {
2275                     src = AvARRAY(ary);
2276                     dst = src - diff;
2277                     Move(src, dst, offset, SV*);
2278                 }
2279                 SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
2280                 AvMAX(ary) += diff;
2281                 AvFILL(ary) += diff;
2282             }
2283             else {
2284                 if (AvFILL(ary) + diff >= AvMAX(ary))   /* oh, well */
2285                     av_extend(ary, AvFILL(ary) + diff);
2286                 AvFILL(ary) += diff;
2287
2288                 if (after) {
2289                     dst = AvARRAY(ary) + AvFILL(ary);
2290                     src = dst - diff;
2291                     for (i = after; i; i--) {
2292                         *dst-- = *src--;
2293                     }
2294                 }
2295             }
2296         }
2297
2298         for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
2299             *dst = NEWSV(46, 0);
2300             sv_setsv(*dst++, *src++);
2301         }
2302         MARK = ORIGMARK + 1;
2303         if (GIMME == G_ARRAY) {                 /* copy return vals to stack */
2304             if (length) {
2305                 Copy(tmparyval, MARK, length, SV*);
2306                 if (AvREAL(ary)) {
2307                     EXTEND_MORTAL(length);
2308                     for (i = length, dst = MARK; i; i--) {
2309                         if (!SvIMMORTAL(*dst))
2310                             sv_2mortal(*dst);   /* free them eventualy */
2311                         dst++;
2312                     }
2313                 }
2314                 Safefree(tmparyval);
2315             }
2316             MARK += length - 1;
2317         }
2318         else if (length--) {
2319             *MARK = tmparyval[length];
2320             if (AvREAL(ary)) {
2321                 if (!SvIMMORTAL(*MARK))
2322                     sv_2mortal(*MARK);
2323                 while (length-- > 0)
2324                     SvREFCNT_dec(tmparyval[length]);
2325             }
2326             Safefree(tmparyval);
2327         }
2328         else
2329             *MARK = &sv_undef;
2330     }
2331     SP = MARK;
2332     RETURN;
2333 }
2334
2335 PP(pp_push)
2336 {
2337     dSP; dMARK; dORIGMARK; dTARGET;
2338     register AV *ary = (AV*)*++MARK;
2339     register SV *sv = &sv_undef;
2340
2341     for (++MARK; MARK <= SP; MARK++) {
2342         sv = NEWSV(51, 0);
2343         if (*MARK)
2344             sv_setsv(sv, *MARK);
2345         av_push(ary, sv);
2346     }
2347     SP = ORIGMARK;
2348     PUSHi( AvFILL(ary) + 1 );
2349     RETURN;
2350 }
2351
2352 PP(pp_pop)
2353 {
2354     dSP;
2355     AV *av = (AV*)POPs;
2356     SV *sv = av_pop(av);
2357     if (!SvIMMORTAL(sv) && AvREAL(av))
2358         (void)sv_2mortal(sv);
2359     PUSHs(sv);
2360     RETURN;
2361 }
2362
2363 PP(pp_shift)
2364 {
2365     dSP;
2366     AV *av = (AV*)POPs;
2367     SV *sv = av_shift(av);
2368     EXTEND(SP, 1);
2369     if (!sv)
2370         RETPUSHUNDEF;
2371     if (!SvIMMORTAL(sv) && AvREAL(av))
2372         (void)sv_2mortal(sv);
2373     PUSHs(sv);
2374     RETURN;
2375 }
2376
2377 PP(pp_unshift)
2378 {
2379     dSP; dMARK; dORIGMARK; dTARGET;
2380     register AV *ary = (AV*)*++MARK;
2381     register SV *sv;
2382     register I32 i = 0;
2383
2384     av_unshift(ary, SP - MARK);
2385     while (MARK < SP) {
2386         sv = NEWSV(27, 0);
2387         sv_setsv(sv, *++MARK);
2388         (void)av_store(ary, i++, sv);
2389     }
2390
2391     SP = ORIGMARK;
2392     PUSHi( AvFILL(ary) + 1 );
2393     RETURN;
2394 }
2395
2396 PP(pp_reverse)
2397 {
2398     dSP; dMARK;
2399     register SV *tmp;
2400     SV **oldsp = SP;
2401
2402     if (GIMME == G_ARRAY) {
2403         MARK++;
2404         while (MARK < SP) {
2405             tmp = *MARK;
2406             *MARK++ = *SP;
2407             *SP-- = tmp;
2408         }
2409         SP = oldsp;
2410     }
2411     else {
2412         register char *up;
2413         register char *down;
2414         register I32 tmp;
2415         dTARGET;
2416         STRLEN len;
2417
2418         if (SP - MARK > 1)
2419             do_join(TARG, &sv_no, MARK, SP);
2420         else
2421             sv_setsv(TARG, *SP);
2422         up = SvPV_force(TARG, len);
2423         if (len > 1) {
2424             down = SvPVX(TARG) + len - 1;
2425             while (down > up) {
2426                 tmp = *up;
2427                 *up++ = *down;
2428                 *down-- = tmp;
2429             }
2430             (void)SvPOK_only(TARG);
2431         }
2432         SP = MARK + 1;
2433         SETTARG;
2434     }
2435     RETURN;
2436 }
2437
2438 static SV      *
2439 mul128(sv, m)
2440      SV             *sv;
2441      U8              m;
2442 {
2443   STRLEN          len;
2444   char           *s = SvPV(sv, len);
2445   char           *t;
2446   U32             i = 0;
2447
2448   if (!strnEQ(s, "0000", 4)) {  /* need to grow sv */
2449     SV             *new = newSVpv("0000000000", 10);
2450
2451     sv_catsv(new, sv);
2452     SvREFCNT_dec(sv);           /* free old sv */
2453     sv = new;
2454     s = SvPV(sv, len);
2455   }
2456   t = s + len - 1;
2457   while (!*t)                   /* trailing '\0'? */
2458     t--;
2459   while (t > s) {
2460     i = ((*t - '0') << 7) + m;
2461     *(t--) = '0' + (i % 10);
2462     m = i / 10;
2463   }
2464   return (sv);
2465 }
2466
2467 /* Explosives and implosives. */
2468
2469 PP(pp_unpack)
2470 {
2471     dSP;
2472     dPOPPOPssrl;
2473     SV **oldsp = sp;
2474     SV *sv;
2475     STRLEN llen;
2476     STRLEN rlen;
2477     register char *pat = SvPV(left, llen);
2478     register char *s = SvPV(right, rlen);
2479     char *strend = s + rlen;
2480     char *strbeg = s;
2481     register char *patend = pat + llen;
2482     I32 datumtype;
2483     register I32 len;
2484     register I32 bits;
2485
2486     /* These must not be in registers: */
2487     I16 ashort;
2488     int aint;
2489     I32 along;
2490 #ifdef HAS_QUAD
2491     Quad_t aquad;
2492 #endif
2493     U16 aushort;
2494     unsigned int auint;
2495     U32 aulong;
2496 #ifdef HAS_QUAD
2497     unsigned Quad_t auquad;
2498 #endif
2499     char *aptr;
2500     float afloat;
2501     double adouble;
2502     I32 checksum = 0;
2503     register U32 culong;
2504     double cdouble;
2505     static char* bitcount = 0;
2506
2507     if (GIMME != G_ARRAY) {             /* arrange to do first one only */
2508         /*SUPPRESS 530*/
2509         for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
2510         if (strchr("aAbBhHP", *patend) || *pat == '%') {
2511             patend++;
2512             while (isDIGIT(*patend) || *patend == '*')
2513                 patend++;
2514         }
2515         else
2516             patend++;
2517     }
2518     while (pat < patend) {
2519       reparse:
2520         datumtype = *pat++;
2521         if (pat >= patend)
2522             len = 1;
2523         else if (*pat == '*') {
2524             len = strend - strbeg;      /* long enough */
2525             pat++;
2526         }
2527         else if (isDIGIT(*pat)) {
2528             len = *pat++ - '0';
2529             while (isDIGIT(*pat))
2530                 len = (len * 10) + (*pat++ - '0');
2531         }
2532         else
2533             len = (datumtype != '@');
2534         switch(datumtype) {
2535         default:
2536             break;
2537         case '%':
2538             if (len == 1 && pat[-1] != '1')
2539                 len = 16;
2540             checksum = len;
2541             culong = 0;
2542             cdouble = 0;
2543             if (pat < patend)
2544                 goto reparse;
2545             break;
2546         case '@':
2547             if (len > strend - strbeg)
2548                 DIE("@ outside of string");
2549             s = strbeg + len;
2550             break;
2551         case 'X':
2552             if (len > s - strbeg)
2553                 DIE("X outside of string");
2554             s -= len;
2555             break;
2556         case 'x':
2557             if (len > strend - s)
2558                 DIE("x outside of string");
2559             s += len;
2560             break;
2561         case 'A':
2562         case 'a':
2563             if (len > strend - s)
2564                 len = strend - s;
2565             if (checksum)
2566                 goto uchar_checksum;
2567             sv = NEWSV(35, len);
2568             sv_setpvn(sv, s, len);
2569             s += len;
2570             if (datumtype == 'A') {
2571                 aptr = s;       /* borrow register */
2572                 s = SvPVX(sv) + len - 1;
2573                 while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
2574                     s--;
2575                 *++s = '\0';
2576                 SvCUR_set(sv, s - SvPVX(sv));
2577                 s = aptr;       /* unborrow register */
2578             }
2579             XPUSHs(sv_2mortal(sv));
2580             break;
2581         case 'B':
2582         case 'b':
2583             if (pat[-1] == '*' || len > (strend - s) * 8)
2584                 len = (strend - s) * 8;
2585             if (checksum) {
2586                 if (!bitcount) {
2587                     Newz(601, bitcount, 256, char);
2588                     for (bits = 1; bits < 256; bits++) {
2589                         if (bits & 1)   bitcount[bits]++;
2590                         if (bits & 2)   bitcount[bits]++;
2591                         if (bits & 4)   bitcount[bits]++;
2592                         if (bits & 8)   bitcount[bits]++;
2593                         if (bits & 16)  bitcount[bits]++;
2594                         if (bits & 32)  bitcount[bits]++;
2595                         if (bits & 64)  bitcount[bits]++;
2596                         if (bits & 128) bitcount[bits]++;
2597                     }
2598                 }
2599                 while (len >= 8) {
2600                     culong += bitcount[*(unsigned char*)s++];
2601                     len -= 8;
2602                 }
2603                 if (len) {
2604                     bits = *s;
2605                     if (datumtype == 'b') {
2606                         while (len-- > 0) {
2607                             if (bits & 1) culong++;
2608                             bits >>= 1;
2609                         }
2610                     }
2611                     else {
2612                         while (len-- > 0) {
2613                             if (bits & 128) culong++;
2614                             bits <<= 1;
2615                         }
2616                     }
2617                 }
2618                 break;
2619             }
2620             sv = NEWSV(35, len + 1);
2621             SvCUR_set(sv, len);
2622             SvPOK_on(sv);
2623             aptr = pat;                 /* borrow register */
2624             pat = SvPVX(sv);
2625             if (datumtype == 'b') {
2626                 aint = len;
2627                 for (len = 0; len < aint; len++) {
2628                     if (len & 7)                /*SUPPRESS 595*/
2629                         bits >>= 1;
2630                     else
2631                         bits = *s++;
2632                     *pat++ = '0' + (bits & 1);
2633                 }
2634             }
2635             else {
2636                 aint = len;
2637                 for (len = 0; len < aint; len++) {
2638                     if (len & 7)
2639                         bits <<= 1;
2640                     else
2641                         bits = *s++;
2642                     *pat++ = '0' + ((bits & 128) != 0);
2643                 }
2644             }
2645             *pat = '\0';
2646             pat = aptr;                 /* unborrow register */
2647             XPUSHs(sv_2mortal(sv));
2648             break;
2649         case 'H':
2650         case 'h':
2651             if (pat[-1] == '*' || len > (strend - s) * 2)
2652                 len = (strend - s) * 2;
2653             sv = NEWSV(35, len + 1);
2654             SvCUR_set(sv, len);
2655             SvPOK_on(sv);
2656             aptr = pat;                 /* borrow register */
2657             pat = SvPVX(sv);
2658             if (datumtype == 'h') {
2659                 aint = len;
2660                 for (len = 0; len < aint; len++) {
2661                     if (len & 1)
2662                         bits >>= 4;
2663                     else
2664                         bits = *s++;
2665                     *pat++ = hexdigit[bits & 15];
2666                 }
2667             }
2668             else {
2669                 aint = len;
2670                 for (len = 0; len < aint; len++) {
2671                     if (len & 1)
2672                         bits <<= 4;
2673                     else
2674                         bits = *s++;
2675                     *pat++ = hexdigit[(bits >> 4) & 15];
2676                 }
2677             }
2678             *pat = '\0';
2679             pat = aptr;                 /* unborrow register */
2680             XPUSHs(sv_2mortal(sv));
2681             break;
2682         case 'c':
2683             if (len > strend - s)
2684                 len = strend - s;
2685             if (checksum) {
2686                 while (len-- > 0) {
2687                     aint = *s++;
2688                     if (aint >= 128)    /* fake up signed chars */
2689                         aint -= 256;
2690                     culong += aint;
2691                 }
2692             }
2693             else {
2694                 EXTEND(SP, len);
2695                 EXTEND_MORTAL(len);
2696                 while (len-- > 0) {
2697                     aint = *s++;
2698                     if (aint >= 128)    /* fake up signed chars */
2699                         aint -= 256;
2700                     sv = NEWSV(36, 0);
2701                     sv_setiv(sv, (I32)aint);
2702                     PUSHs(sv_2mortal(sv));
2703                 }
2704             }
2705             break;
2706         case 'C':
2707             if (len > strend - s)
2708                 len = strend - s;
2709             if (checksum) {
2710               uchar_checksum:
2711                 while (len-- > 0) {
2712                     auint = *s++ & 255;
2713                     culong += auint;
2714                 }
2715             }
2716             else {
2717                 EXTEND(SP, len);
2718                 EXTEND_MORTAL(len);
2719                 while (len-- > 0) {
2720                     auint = *s++ & 255;
2721                     sv = NEWSV(37, 0);
2722                     sv_setiv(sv, (I32)auint);
2723                     PUSHs(sv_2mortal(sv));
2724                 }
2725             }
2726             break;
2727         case 's':
2728             along = (strend - s) / sizeof(I16);
2729             if (len > along)
2730                 len = along;
2731             if (checksum) {
2732                 while (len-- > 0) {
2733                     Copy(s, &ashort, 1, I16);
2734                     s += sizeof(I16);
2735                     culong += ashort;
2736                 }
2737             }
2738             else {
2739                 EXTEND(SP, len);
2740                 EXTEND_MORTAL(len);
2741                 while (len-- > 0) {
2742                     Copy(s, &ashort, 1, I16);
2743                     s += sizeof(I16);
2744                     sv = NEWSV(38, 0);
2745                     sv_setiv(sv, (I32)ashort);
2746                     PUSHs(sv_2mortal(sv));
2747                 }
2748             }
2749             break;
2750         case 'v':
2751         case 'n':
2752         case 'S':
2753             along = (strend - s) / sizeof(U16);
2754             if (len > along)
2755                 len = along;
2756             if (checksum) {
2757                 while (len-- > 0) {
2758                     Copy(s, &aushort, 1, U16);
2759                     s += sizeof(U16);
2760 #ifdef HAS_NTOHS
2761                     if (datumtype == 'n')
2762                         aushort = ntohs(aushort);
2763 #endif
2764 #ifdef HAS_VTOHS
2765                     if (datumtype == 'v')
2766                         aushort = vtohs(aushort);
2767 #endif
2768                     culong += aushort;
2769                 }
2770             }
2771             else {
2772                 EXTEND(SP, len);
2773                 EXTEND_MORTAL(len);
2774                 while (len-- > 0) {
2775                     Copy(s, &aushort, 1, U16);
2776                     s += sizeof(U16);
2777                     sv = NEWSV(39, 0);
2778 #ifdef HAS_NTOHS
2779                     if (datumtype == 'n')
2780                         aushort = ntohs(aushort);
2781 #endif
2782 #ifdef HAS_VTOHS
2783                     if (datumtype == 'v')
2784                         aushort = vtohs(aushort);
2785 #endif
2786                     sv_setiv(sv, (I32)aushort);
2787                     PUSHs(sv_2mortal(sv));
2788                 }
2789             }
2790             break;
2791         case 'i':
2792             along = (strend - s) / sizeof(int);
2793             if (len > along)
2794                 len = along;
2795             if (checksum) {
2796                 while (len-- > 0) {
2797                     Copy(s, &aint, 1, int);
2798                     s += sizeof(int);
2799                     if (checksum > 32)
2800                         cdouble += (double)aint;
2801                     else
2802                         culong += aint;
2803                 }
2804             }
2805             else {
2806                 EXTEND(SP, len);
2807                 EXTEND_MORTAL(len);
2808                 while (len-- > 0) {
2809                     Copy(s, &aint, 1, int);
2810                     s += sizeof(int);
2811                     sv = NEWSV(40, 0);
2812                     sv_setiv(sv, (I32)aint);
2813                     PUSHs(sv_2mortal(sv));
2814                 }
2815             }
2816             break;
2817         case 'I':
2818             along = (strend - s) / sizeof(unsigned int);
2819             if (len > along)
2820                 len = along;
2821             if (checksum) {
2822                 while (len-- > 0) {
2823                     Copy(s, &auint, 1, unsigned int);
2824                     s += sizeof(unsigned int);
2825                     if (checksum > 32)
2826                         cdouble += (double)auint;
2827                     else
2828                         culong += auint;
2829                 }
2830             }
2831             else {
2832                 EXTEND(SP, len);
2833                 EXTEND_MORTAL(len);
2834                 while (len-- > 0) {
2835                     Copy(s, &auint, 1, unsigned int);
2836                     s += sizeof(unsigned int);
2837                     sv = NEWSV(41, 0);
2838                     if (auint <= I32_MAX)
2839                         sv_setiv(sv, (I32)auint);
2840                     else
2841                         sv_setnv(sv, (double)auint);
2842                     PUSHs(sv_2mortal(sv));
2843                 }
2844             }
2845             break;
2846         case 'l':
2847             along = (strend - s) / sizeof(I32);
2848             if (len > along)
2849                 len = along;
2850             if (checksum) {
2851                 while (len-- > 0) {
2852                     Copy(s, &along, 1, I32);
2853                     s += sizeof(I32);
2854                     if (checksum > 32)
2855                         cdouble += (double)along;
2856                     else
2857                         culong += along;
2858                 }
2859             }
2860             else {
2861                 EXTEND(SP, len);
2862                 EXTEND_MORTAL(len);
2863                 while (len-- > 0) {
2864                     Copy(s, &along, 1, I32);
2865                     s += sizeof(I32);
2866                     sv = NEWSV(42, 0);
2867                     sv_setiv(sv, (I32)along);
2868                     PUSHs(sv_2mortal(sv));
2869                 }
2870             }
2871             break;
2872         case 'V':
2873         case 'N':
2874         case 'L':
2875             along = (strend - s) / sizeof(U32);
2876             if (len > along)
2877                 len = along;
2878             if (checksum) {
2879                 while (len-- > 0) {
2880                     Copy(s, &aulong, 1, U32);
2881                     s += sizeof(U32);
2882 #ifdef HAS_NTOHL
2883                     if (datumtype == 'N')
2884                         aulong = ntohl(aulong);
2885 #endif
2886 #ifdef HAS_VTOHL
2887                     if (datumtype == 'V')
2888                         aulong = vtohl(aulong);
2889 #endif
2890                     if (checksum > 32)
2891                         cdouble += (double)aulong;
2892                     else
2893                         culong += aulong;
2894                 }
2895             }
2896             else {
2897                 EXTEND(SP, len);
2898                 EXTEND_MORTAL(len);
2899                 while (len-- > 0) {
2900                     Copy(s, &aulong, 1, U32);
2901                     s += sizeof(U32);
2902                     sv = NEWSV(43, 0);
2903 #ifdef HAS_NTOHL
2904                     if (datumtype == 'N')
2905                         aulong = ntohl(aulong);
2906 #endif
2907 #ifdef HAS_VTOHL
2908                     if (datumtype == 'V')
2909                         aulong = vtohl(aulong);
2910 #endif
2911                     sv_setnv(sv, (double)aulong);
2912                     PUSHs(sv_2mortal(sv));
2913                 }
2914             }
2915             break;
2916         case 'p':
2917             along = (strend - s) / sizeof(char*);
2918             if (len > along)
2919                 len = along;
2920             EXTEND(SP, len);
2921             EXTEND_MORTAL(len);
2922             while (len-- > 0) {
2923                 if (sizeof(char*) > strend - s)
2924                     break;
2925                 else {
2926                     Copy(s, &aptr, 1, char*);
2927                     s += sizeof(char*);
2928                 }
2929                 sv = NEWSV(44, 0);
2930                 if (aptr)
2931                     sv_setpv(sv, aptr);
2932                 PUSHs(sv_2mortal(sv));
2933             }
2934             break;
2935         case 'w':
2936             EXTEND(SP, len);
2937             EXTEND_MORTAL(len);
2938             {
2939                 UV auv = 0;
2940                 U32 bytes = 0;
2941
2942                 while ((len > 0) && (s < strend)) {
2943                     auv = (auv << 7) | (*s & 0x7f);
2944                     if (!(*s++ & 0x80)) {
2945                         bytes = 0;
2946                         sv = NEWSV(40, 0);
2947                         sv_setuv(sv, auv);
2948                         PUSHs(sv_2mortal(sv));
2949                         len--;
2950                         auv = 0;
2951                     }
2952                     else if (++bytes >= sizeof(UV)) {   /* promote to string */
2953                         char decn[sizeof(UV) * 3 + 1];
2954                         char *t;
2955
2956                         (void) sprintf(decn, "%0*ld", sizeof(decn) - 1, auv);
2957                         sv = newSVpv(decn, 0);
2958                         while (s < strend) {
2959                             sv = mul128(sv, *s & 0x7f);
2960                             if (!(*s++ & 0x80)) {
2961                                 bytes = 0;
2962                                 break;
2963                             }
2964                         }
2965                         t = SvPV(sv, na);
2966                         while (*t == '0')
2967                             t++;
2968                         sv_chop(sv, t);
2969                         PUSHs(sv_2mortal(sv));
2970                         len--;
2971                         auv = 0;
2972                     }
2973                 }
2974                 if ((s >= strend) && bytes)
2975                     croak("Unterminated compressed integer");
2976             }
2977             break;
2978         case 'P':
2979             EXTEND(SP, 1);
2980             if (sizeof(char*) > strend - s)
2981                 break;
2982             else {
2983                 Copy(s, &aptr, 1, char*);
2984                 s += sizeof(char*);
2985             }
2986             sv = NEWSV(44, 0);
2987             if (aptr)
2988                 sv_setpvn(sv, aptr, len);
2989             PUSHs(sv_2mortal(sv));
2990             break;
2991 #ifdef HAS_QUAD
2992         case 'q':
2993             EXTEND(SP, len);
2994             EXTEND_MORTAL(len);
2995             while (len-- > 0) {
2996                 if (s + sizeof(Quad_t) > strend)
2997                     aquad = 0;
2998                 else {
2999                     Copy(s, &aquad, 1, Quad_t);
3000                     s += sizeof(Quad_t);
3001                 }
3002                 sv = NEWSV(42, 0);
3003                 sv_setiv(sv, (IV)aquad);
3004                 PUSHs(sv_2mortal(sv));
3005             }
3006             break;
3007         case 'Q':
3008             EXTEND(SP, len);
3009             EXTEND_MORTAL(len);
3010             while (len-- > 0) {
3011                 if (s + sizeof(unsigned Quad_t) > strend)
3012                     auquad = 0;
3013                 else {
3014                     Copy(s, &auquad, 1, unsigned Quad_t);
3015                     s += sizeof(unsigned Quad_t);
3016                 }
3017                 sv = NEWSV(43, 0);
3018                 sv_setiv(sv, (IV)auquad);
3019                 PUSHs(sv_2mortal(sv));
3020             }
3021             break;
3022 #endif
3023         /* float and double added gnb@melba.bby.oz.au 22/11/89 */
3024         case 'f':
3025         case 'F':
3026             along = (strend - s) / sizeof(float);
3027             if (len > along)
3028                 len = along;
3029             if (checksum) {
3030                 while (len-- > 0) {
3031                     Copy(s, &afloat, 1, float);
3032                     s += sizeof(float);
3033                     cdouble += afloat;
3034                 }
3035             }
3036             else {
3037                 EXTEND(SP, len);
3038                 EXTEND_MORTAL(len);
3039                 while (len-- > 0) {
3040                     Copy(s, &afloat, 1, float);
3041                     s += sizeof(float);
3042                     sv = NEWSV(47, 0);
3043                     sv_setnv(sv, (double)afloat);
3044                     PUSHs(sv_2mortal(sv));
3045                 }
3046             }
3047             break;
3048         case 'd':
3049         case 'D':
3050             along = (strend - s) / sizeof(double);
3051             if (len > along)
3052                 len = along;
3053             if (checksum) {
3054                 while (len-- > 0) {
3055                     Copy(s, &adouble, 1, double);
3056                     s += sizeof(double);
3057                     cdouble += adouble;
3058                 }
3059             }
3060             else {
3061                 EXTEND(SP, len);
3062                 EXTEND_MORTAL(len);
3063                 while (len-- > 0) {
3064                     Copy(s, &adouble, 1, double);
3065                     s += sizeof(double);
3066                     sv = NEWSV(48, 0);
3067                     sv_setnv(sv, (double)adouble);
3068                     PUSHs(sv_2mortal(sv));
3069                 }
3070             }
3071             break;
3072         case 'u':
3073             along = (strend - s) * 3 / 4;
3074             sv = NEWSV(42, along);
3075             if (along)
3076                 SvPOK_on(sv);
3077             while (s < strend && *s > ' ' && *s < 'a') {
3078                 I32 a, b, c, d;
3079                 char hunk[4];
3080
3081                 hunk[3] = '\0';
3082                 len = (*s++ - ' ') & 077;
3083                 while (len > 0) {
3084                     if (s < strend && *s >= ' ')
3085                         a = (*s++ - ' ') & 077;
3086                     else
3087                         a = 0;
3088                     if (s < strend && *s >= ' ')
3089                         b = (*s++ - ' ') & 077;
3090                     else
3091                         b = 0;
3092                     if (s < strend && *s >= ' ')
3093                         c = (*s++ - ' ') & 077;
3094                     else
3095                         c = 0;
3096                     if (s < strend && *s >= ' ')
3097                         d = (*s++ - ' ') & 077;
3098                     else
3099                         d = 0;
3100                     hunk[0] = a << 2 | b >> 4;
3101                     hunk[1] = b << 4 | c >> 2;
3102                     hunk[2] = c << 6 | d;
3103                     sv_catpvn(sv, hunk, len > 3 ? 3 : len);
3104                     len -= 3;
3105                 }
3106                 if (*s == '\n')
3107                     s++;
3108                 else if (s[1] == '\n')          /* possible checksum byte */
3109                     s += 2;
3110             }
3111             XPUSHs(sv_2mortal(sv));
3112             break;
3113         }
3114         if (checksum) {
3115             sv = NEWSV(42, 0);
3116             if (strchr("fFdD", datumtype) ||
3117               (checksum > 32 && strchr("iIlLN", datumtype)) ) {
3118                 double trouble;
3119
3120                 adouble = 1.0;
3121                 while (checksum >= 16) {
3122                     checksum -= 16;
3123                     adouble *= 65536.0;
3124                 }
3125                 while (checksum >= 4) {
3126                     checksum -= 4;
3127                     adouble *= 16.0;
3128                 }
3129                 while (checksum--)
3130                     adouble *= 2.0;
3131                 along = (1 << checksum) - 1;
3132                 while (cdouble < 0.0)
3133                     cdouble += adouble;
3134                 cdouble = modf(cdouble / adouble, &trouble) * adouble;
3135                 sv_setnv(sv, cdouble);
3136             }
3137             else {
3138                 if (checksum < 32) {
3139                     along = (1 << checksum) - 1;
3140                     culong &= (U32)along;
3141                 }
3142                 sv_setnv(sv, (double)culong);
3143             }
3144             XPUSHs(sv_2mortal(sv));
3145             checksum = 0;
3146         }
3147     }
3148     if (sp == oldsp && GIMME != G_ARRAY)
3149         PUSHs(&sv_undef);
3150     RETURN;
3151 }
3152
3153 static void
3154 doencodes(sv, s, len)
3155 register SV *sv;
3156 register char *s;
3157 register I32 len;
3158 {
3159     char hunk[5];
3160
3161     *hunk = len + ' ';
3162     sv_catpvn(sv, hunk, 1);
3163     hunk[4] = '\0';
3164     while (len > 0) {
3165         hunk[0] = ' ' + (077 & (*s >> 2));
3166         hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
3167         hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
3168         hunk[3] = ' ' + (077 & (s[2] & 077));
3169         sv_catpvn(sv, hunk, 4);
3170         s += 3;
3171         len -= 3;
3172     }
3173     for (s = SvPVX(sv); *s; s++) {
3174         if (*s == ' ')
3175             *s = '`';
3176     }
3177     sv_catpvn(sv, "\n", 1);
3178 }
3179
3180 static SV      *
3181 is_an_int(s, l)
3182      char           *s;
3183      STRLEN          l;
3184 {
3185   SV             *result = newSVpv("", l);
3186   char           *result_c = SvPV(result, na);  /* convenience */
3187   char           *out = result_c;
3188   bool            skip = 1;
3189   bool            ignore = 0;
3190
3191   while (*s) {
3192     switch (*s) {
3193     case ' ':
3194       break;
3195     case '+':
3196       if (!skip) {
3197         SvREFCNT_dec(result);
3198         return (NULL);
3199       }
3200       break;
3201     case '0':
3202     case '1':
3203     case '2':
3204     case '3':
3205     case '4':
3206     case '5':
3207     case '6':
3208     case '7':
3209     case '8':
3210     case '9':
3211       skip = 0;
3212       if (!ignore) {
3213         *(out++) = *s;
3214       }
3215       break;
3216     case '.':
3217       ignore = 1;
3218       break;
3219     default:
3220       SvREFCNT_dec(result);
3221       return (NULL);
3222     }
3223     s++;
3224   }
3225   *(out++) = '\0';
3226   SvCUR_set(result, out - result_c);
3227   return (result);
3228 }
3229
3230 static int
3231 div128(pnum, done)
3232      SV             *pnum;                  /* must be '\0' terminated */
3233      bool           *done;
3234 {
3235   STRLEN          len;
3236   char           *s = SvPV(pnum, len);
3237   int             m = 0;
3238   int             r = 0;
3239   char           *t = s;
3240
3241   *done = 1;
3242   while (*t) {
3243     int             i;
3244
3245     i = m * 10 + (*t - '0');
3246     m = i & 0x7F;
3247     r = (i >> 7);               /* r < 10 */
3248     if (r) {
3249       *done = 0;
3250     }
3251     *(t++) = '0' + r;
3252   }
3253   *(t++) = '\0';
3254   SvCUR_set(pnum, (STRLEN) (t - s));
3255   return (m);
3256 }
3257
3258
3259 PP(pp_pack)
3260 {
3261     dSP; dMARK; dORIGMARK; dTARGET;
3262     register SV *cat = TARG;
3263     register I32 items;
3264     STRLEN fromlen;
3265     register char *pat = SvPVx(*++MARK, fromlen);
3266     register char *patend = pat + fromlen;
3267     register I32 len;
3268     I32 datumtype;
3269     SV *fromstr;
3270     /*SUPPRESS 442*/
3271     static char null10[] = {0,0,0,0,0,0,0,0,0,0};
3272     static char *space10 = "          ";
3273
3274     /* These must not be in registers: */
3275     char achar;
3276     I16 ashort;
3277     int aint;
3278     unsigned int auint;
3279     I32 along;
3280     U32 aulong;
3281 #ifdef HAS_QUAD
3282     Quad_t aquad;
3283     unsigned Quad_t auquad;
3284 #endif
3285     char *aptr;
3286     float afloat;
3287     double adouble;
3288
3289     items = SP - MARK;
3290     MARK++;
3291     sv_setpvn(cat, "", 0);
3292     while (pat < patend) {
3293 #define NEXTFROM (items-- > 0 ? *MARK++ : &sv_no)
3294         datumtype = *pat++;
3295         if (*pat == '*') {
3296             len = strchr("@Xxu", datumtype) ? 0 : items;
3297             pat++;
3298         }
3299         else if (isDIGIT(*pat)) {
3300             len = *pat++ - '0';
3301             while (isDIGIT(*pat))
3302                 len = (len * 10) + (*pat++ - '0');
3303         }
3304         else
3305             len = 1;
3306         switch(datumtype) {
3307         default:
3308             break;
3309         case '%':
3310             DIE("%% may only be used in unpack");
3311         case '@':
3312             len -= SvCUR(cat);
3313             if (len > 0)
3314                 goto grow;
3315             len = -len;
3316             if (len > 0)
3317                 goto shrink;
3318             break;
3319         case 'X':
3320           shrink:
3321             if (SvCUR(cat) < len)
3322                 DIE("X outside of string");
3323             SvCUR(cat) -= len;
3324             *SvEND(cat) = '\0';
3325             break;
3326         case 'x':
3327           grow:
3328             while (len >= 10) {
3329                 sv_catpvn(cat, null10, 10);
3330                 len -= 10;
3331             }
3332             sv_catpvn(cat, null10, len);
3333             break;
3334         case 'A':
3335         case 'a':
3336             fromstr = NEXTFROM;
3337             aptr = SvPV(fromstr, fromlen);
3338             if (pat[-1] == '*')
3339                 len = fromlen;
3340             if (fromlen > len)
3341                 sv_catpvn(cat, aptr, len);
3342             else {
3343                 sv_catpvn(cat, aptr, fromlen);
3344                 len -= fromlen;
3345                 if (datumtype == 'A') {
3346                     while (len >= 10) {
3347                         sv_catpvn(cat, space10, 10);
3348                         len -= 10;
3349                     }
3350                     sv_catpvn(cat, space10, len);
3351                 }
3352                 else {
3353                     while (len >= 10) {
3354                         sv_catpvn(cat, null10, 10);
3355                         len -= 10;
3356                     }
3357                     sv_catpvn(cat, null10, len);
3358                 }
3359             }
3360             break;
3361         case 'B':
3362         case 'b':
3363             {
3364                 char *savepat = pat;
3365                 I32 saveitems;
3366
3367                 fromstr = NEXTFROM;
3368                 saveitems = items;
3369                 aptr = SvPV(fromstr, fromlen);
3370                 if (pat[-1] == '*')
3371                     len = fromlen;
3372                 pat = aptr;
3373                 aint = SvCUR(cat);
3374                 SvCUR(cat) += (len+7)/8;
3375                 SvGROW(cat, SvCUR(cat) + 1);
3376                 aptr = SvPVX(cat) + aint;
3377                 if (len > fromlen)
3378                     len = fromlen;
3379                 aint = len;
3380                 items = 0;
3381                 if (datumtype == 'B') {
3382                     for (len = 0; len++ < aint;) {
3383                         items |= *pat++ & 1;
3384                         if (len & 7)
3385                             items <<= 1;
3386                         else {
3387                             *aptr++ = items & 0xff;
3388                             items = 0;
3389                         }
3390                     }
3391                 }
3392                 else {
3393                     for (len = 0; len++ < aint;) {
3394                         if (*pat++ & 1)
3395                             items |= 128;
3396                         if (len & 7)
3397                             items >>= 1;
3398                         else {
3399                             *aptr++ = items & 0xff;
3400                             items = 0;
3401                         }
3402                     }
3403                 }
3404                 if (aint & 7) {
3405                     if (datumtype == 'B')
3406                         items <<= 7 - (aint & 7);
3407                     else
3408                         items >>= 7 - (aint & 7);
3409                     *aptr++ = items & 0xff;
3410                 }
3411                 pat = SvPVX(cat) + SvCUR(cat);
3412                 while (aptr <= pat)
3413                     *aptr++ = '\0';
3414
3415                 pat = savepat;
3416                 items = saveitems;
3417             }
3418             break;
3419         case 'H':
3420         case 'h':
3421             {
3422                 char *savepat = pat;
3423                 I32 saveitems;
3424
3425                 fromstr = NEXTFROM;
3426                 saveitems = items;
3427                 aptr = SvPV(fromstr, fromlen);
3428                 if (pat[-1] == '*')
3429                     len = fromlen;
3430                 pat = aptr;
3431                 aint = SvCUR(cat);
3432                 SvCUR(cat) += (len+1)/2;
3433                 SvGROW(cat, SvCUR(cat) + 1);
3434                 aptr = SvPVX(cat) + aint;
3435                 if (len > fromlen)
3436                     len = fromlen;
3437                 aint = len;
3438                 items = 0;
3439                 if (datumtype == 'H') {
3440                     for (len = 0; len++ < aint;) {
3441                         if (isALPHA(*pat))
3442                             items |= ((*pat++ & 15) + 9) & 15;
3443                         else
3444                             items |= *pat++ & 15;
3445                         if (len & 1)
3446                             items <<= 4;
3447                         else {
3448                             *aptr++ = items & 0xff;
3449                             items = 0;
3450                         }
3451                     }
3452                 }
3453                 else {
3454                     for (len = 0; len++ < aint;) {
3455                         if (isALPHA(*pat))
3456                             items |= (((*pat++ & 15) + 9) & 15) << 4;
3457                         else
3458                             items |= (*pat++ & 15) << 4;
3459                         if (len & 1)
3460                             items >>= 4;
3461                         else {
3462                             *aptr++ = items & 0xff;
3463                             items = 0;
3464                         }
3465                     }
3466                 }
3467                 if (aint & 1)
3468                     *aptr++ = items & 0xff;
3469                 pat = SvPVX(cat) + SvCUR(cat);
3470                 while (aptr <= pat)
3471                     *aptr++ = '\0';
3472
3473                 pat = savepat;
3474                 items = saveitems;
3475             }
3476             break;
3477         case 'C':
3478         case 'c':
3479             while (len-- > 0) {
3480                 fromstr = NEXTFROM;
3481                 aint = SvIV(fromstr);
3482                 achar = aint;
3483                 sv_catpvn(cat, &achar, sizeof(char));
3484             }
3485             break;
3486         /* Float and double added by gnb@melba.bby.oz.au  22/11/89 */
3487         case 'f':
3488         case 'F':
3489             while (len-- > 0) {
3490                 fromstr = NEXTFROM;
3491                 afloat = (float)SvNV(fromstr);
3492                 sv_catpvn(cat, (char *)&afloat, sizeof (float));
3493             }
3494             break;
3495         case 'd':
3496         case 'D':
3497             while (len-- > 0) {
3498                 fromstr = NEXTFROM;
3499                 adouble = (double)SvNV(fromstr);
3500                 sv_catpvn(cat, (char *)&adouble, sizeof (double));
3501             }
3502             break;
3503         case 'n':
3504             while (len-- > 0) {
3505                 fromstr = NEXTFROM;
3506                 ashort = (I16)SvIV(fromstr);
3507 #ifdef HAS_HTONS
3508                 ashort = htons(ashort);
3509 #endif
3510                 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
3511             }
3512             break;
3513         case 'v':
3514             while (len-- > 0) {
3515                 fromstr = NEXTFROM;
3516                 ashort = (I16)SvIV(fromstr);
3517 #ifdef HAS_HTOVS
3518                 ashort = htovs(ashort);
3519 #endif
3520                 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
3521             }
3522             break;
3523         case 'S':
3524         case 's':
3525             while (len-- > 0) {
3526                 fromstr = NEXTFROM;
3527                 ashort = (I16)SvIV(fromstr);
3528                 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
3529             }
3530             break;
3531         case 'I':
3532             while (len-- > 0) {
3533                 fromstr = NEXTFROM;
3534                 auint = U_I(SvNV(fromstr));
3535                 sv_catpvn(cat, (char*)&auint, sizeof(unsigned int));
3536             }
3537             break;
3538         case 'w':
3539             while (len-- > 0) {
3540                 fromstr = NEXTFROM;
3541                 adouble = floor(SvNV(fromstr));
3542
3543                 if (adouble < 0)
3544                     croak("Cannot compress negative numbers");
3545
3546                 if (adouble <= UV_MAX) {
3547                     char   buf[1 + sizeof(UV)];
3548                     char  *in = buf + sizeof(buf);
3549                     UV     auv = U_V(adouble);;
3550
3551                     do {
3552                         *--in = (auv & 0x7f) | 0x80;
3553                         auv >>= 7;
3554                     } while (auv);
3555                     buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
3556                     sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
3557                 }
3558                 else if (SvPOKp(fromstr)) {  /* decimal string arithmetics */
3559                     char           *from, *result, *in;
3560                     SV             *norm;
3561                     STRLEN          len;
3562                     bool            done;
3563
3564                     /* Copy string and check for compliance */
3565                     from = SvPV(fromstr, len);
3566                     if ((norm = is_an_int(from, len)) == NULL)
3567                         croak("can compress only unsigned integer");
3568
3569                     New('w', result, len, char);
3570                     in = result + len;
3571                     done = FALSE;
3572                     while (!done)
3573                         *--in = div128(norm, &done) | 0x80;
3574                     result[len - 1] &= 0x7F; /* clear continue bit */
3575                     sv_catpvn(cat, in, (result + len) - in);
3576                     Safefree(result);
3577                     SvREFCNT_dec(norm); /* free norm */
3578                 }
3579                 else if (SvNOKp(fromstr)) {
3580                     char   buf[sizeof(double) * 2];     /* 8/7 <= 2 */
3581                     char  *in = buf + sizeof(buf);
3582
3583                     do {
3584                         double next = floor(adouble / 128);
3585                         *--in = (unsigned char)(adouble - (next * 128)) | 0x80;
3586                         if (--in < buf)  /* this cannot happen ;-) */
3587                             croak ("Cannot compress integer");
3588                         adouble = next;
3589                     } while (adouble > 0);
3590                     buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
3591                     sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
3592                 }
3593                 else
3594                     croak("Cannot compress non integer");
3595             }
3596             break;
3597         case 'i':
3598             while (len-- > 0) {
3599                 fromstr = NEXTFROM;
3600                 aint = SvIV(fromstr);
3601                 sv_catpvn(cat, (char*)&aint, sizeof(int));
3602             }
3603             break;
3604         case 'N':
3605             while (len-- > 0) {
3606                 fromstr = NEXTFROM;
3607                 aulong = U_L(SvNV(fromstr));
3608 #ifdef HAS_HTONL
3609                 aulong = htonl(aulong);
3610 #endif
3611                 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
3612             }
3613             break;
3614         case 'V':
3615             while (len-- > 0) {
3616                 fromstr = NEXTFROM;
3617                 aulong = U_L(SvNV(fromstr));
3618 #ifdef HAS_HTOVL
3619                 aulong = htovl(aulong);
3620 #endif
3621                 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
3622             }
3623             break;
3624         case 'L':
3625             while (len-- > 0) {
3626                 fromstr = NEXTFROM;
3627                 aulong = U_L(SvNV(fromstr));
3628                 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
3629             }
3630             break;
3631         case 'l':
3632             while (len-- > 0) {
3633                 fromstr = NEXTFROM;
3634                 along = SvIV(fromstr);
3635                 sv_catpvn(cat, (char*)&along, sizeof(I32));
3636             }
3637             break;
3638 #ifdef HAS_QUAD
3639         case 'Q':
3640             while (len-- > 0) {
3641                 fromstr = NEXTFROM;
3642                 auquad = (unsigned Quad_t)SvIV(fromstr);
3643                 sv_catpvn(cat, (char*)&auquad, sizeof(unsigned Quad_t));
3644             }
3645             break;
3646         case 'q':
3647             while (len-- > 0) {
3648                 fromstr = NEXTFROM;
3649                 aquad = (Quad_t)SvIV(fromstr);
3650                 sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t));
3651             }
3652             break;
3653 #endif /* HAS_QUAD */
3654         case 'P':
3655             len = 1;            /* assume SV is correct length */
3656             /* FALL THROUGH */
3657         case 'p':
3658             while (len-- > 0) {
3659                 fromstr = NEXTFROM;
3660                 aptr = SvPV_force(fromstr, na); /* XXX Error if TEMP? */
3661                 sv_catpvn(cat, (char*)&aptr, sizeof(char*));
3662             }
3663             break;
3664         case 'u':
3665             fromstr = NEXTFROM;
3666             aptr = SvPV(fromstr, fromlen);
3667             SvGROW(cat, fromlen * 4 / 3);
3668             if (len <= 1)
3669                 len = 45;
3670             else
3671                 len = len / 3 * 3;
3672             while (fromlen > 0) {
3673                 I32 todo;
3674
3675                 if (fromlen > len)
3676                     todo = len;
3677                 else
3678                     todo = fromlen;
3679                 doencodes(cat, aptr, todo);
3680                 fromlen -= todo;
3681                 aptr += todo;
3682             }
3683             break;
3684         }
3685     }
3686     SvSETMAGIC(cat);
3687     SP = ORIGMARK;
3688     PUSHs(cat);
3689     RETURN;
3690 }
3691 #undef NEXTFROM
3692
3693 PP(pp_split)
3694 {
3695     dSP; dTARG;
3696     AV *ary;
3697     register I32 limit = POPi;                  /* note, negative is forever */
3698     SV *sv = POPs;
3699     STRLEN len;
3700     register char *s = SvPV(sv, len);
3701     char *strend = s + len;
3702     register PMOP *pm = (PMOP*)POPs;
3703     register SV *dstr;
3704     register char *m;
3705     I32 iters = 0;
3706     I32 maxiters = (strend - s) + 10;
3707     I32 i;
3708     char *orig;
3709     I32 origlimit = limit;
3710     I32 realarray = 0;
3711     I32 base;
3712     AV *oldstack = curstack;
3713     register REGEXP *rx = pm->op_pmregexp;
3714     I32 gimme = GIMME;
3715     I32 oldsave = savestack_ix;
3716
3717     if (!pm || !s)
3718         DIE("panic: do_split");
3719
3720     TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
3721              (pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE)));
3722
3723     if (pm->op_pmreplroot)
3724         ary = GvAVn((GV*)pm->op_pmreplroot);
3725     else if (gimme != G_ARRAY)
3726         ary = GvAVn(defgv);
3727     else
3728         ary = Nullav;
3729     if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
3730         realarray = 1;
3731         if (!AvREAL(ary)) {
3732             AvREAL_on(ary);
3733             for (i = AvFILL(ary); i >= 0; i--)
3734                 AvARRAY(ary)[i] = &sv_undef;    /* don't free mere refs */
3735         }
3736         av_extend(ary,0);
3737         av_clear(ary);
3738         /* temporarily switch stacks */
3739         SWITCHSTACK(curstack, ary);
3740     }
3741     base = SP - stack_base;
3742     orig = s;
3743     if (pm->op_pmflags & PMf_SKIPWHITE) {
3744         if (pm->op_pmflags & PMf_LOCALE) {
3745             while (isSPACE_LC(*s))
3746                 s++;
3747         }
3748         else {
3749             while (isSPACE(*s))
3750                 s++;
3751         }
3752     }
3753     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
3754         SAVEINT(multiline);
3755         multiline = pm->op_pmflags & PMf_MULTILINE;
3756     }
3757
3758     if (!limit)
3759         limit = maxiters + 2;
3760     if (pm->op_pmflags & PMf_WHITE) {
3761         while (--limit) {
3762             m = s;
3763             while (m < strend &&
3764                    !((pm->op_pmflags & PMf_LOCALE)
3765                      ? isSPACE_LC(*m) : isSPACE(*m)))
3766                 ++m;
3767             if (m >= strend)
3768                 break;
3769
3770             dstr = NEWSV(30, m-s);
3771             sv_setpvn(dstr, s, m-s);
3772             if (!realarray)
3773                 sv_2mortal(dstr);
3774             XPUSHs(dstr);
3775
3776             s = m + 1;
3777             while (s < strend &&
3778                    ((pm->op_pmflags & PMf_LOCALE)
3779                     ? isSPACE_LC(*s) : isSPACE(*s)))
3780                 ++s;
3781         }
3782     }
3783     else if (strEQ("^", rx->precomp)) {
3784         while (--limit) {
3785             /*SUPPRESS 530*/
3786             for (m = s; m < strend && *m != '\n'; m++) ;
3787             m++;
3788             if (m >= strend)
3789                 break;
3790             dstr = NEWSV(30, m-s);
3791             sv_setpvn(dstr, s, m-s);
3792             if (!realarray)
3793                 sv_2mortal(dstr);
3794             XPUSHs(dstr);
3795             s = m;
3796         }
3797     }
3798     else if (pm->op_pmshort) {
3799         i = SvCUR(pm->op_pmshort);
3800         if (i == 1) {
3801             i = *SvPVX(pm->op_pmshort);
3802             while (--limit) {
3803                 /*SUPPRESS 530*/
3804                 for (m = s; m < strend && *m != i; m++) ;
3805                 if (m >= strend)
3806                     break;
3807                 dstr = NEWSV(30, m-s);
3808                 sv_setpvn(dstr, s, m-s);
3809                 if (!realarray)
3810                     sv_2mortal(dstr);
3811                 XPUSHs(dstr);
3812                 s = m + 1;
3813             }
3814         }
3815         else {
3816 #ifndef lint
3817             while (s < strend && --limit &&
3818               (m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
3819                     pm->op_pmshort)) )
3820 #endif
3821             {
3822                 dstr = NEWSV(31, m-s);
3823                 sv_setpvn(dstr, s, m-s);
3824                 if (!realarray)
3825                     sv_2mortal(dstr);
3826                 XPUSHs(dstr);
3827                 s = m + i;
3828             }
3829         }
3830     }
3831     else {
3832         maxiters += (strend - s) * rx->nparens;
3833         while (s < strend && --limit &&
3834                pregexec(rx, s, strend, orig, 1, Nullsv, TRUE))
3835         {
3836             TAINT_IF(rx->exec_tainted);
3837             if (rx->subbase
3838               && rx->subbase != orig) {
3839                 m = s;
3840                 s = orig;
3841                 orig = rx->subbase;
3842                 s = orig + (m - s);
3843                 strend = s + (strend - m);
3844             }
3845             m = rx->startp[0];
3846             dstr = NEWSV(32, m-s);
3847             sv_setpvn(dstr, s, m-s);
3848             if (!realarray)
3849                 sv_2mortal(dstr);
3850             XPUSHs(dstr);
3851             if (rx->nparens) {
3852                 for (i = 1; i <= rx->nparens; i++) {
3853                     s = rx->startp[i];
3854                     m = rx->endp[i];
3855                     if (m && s) {
3856                         dstr = NEWSV(33, m-s);
3857                         sv_setpvn(dstr, s, m-s);
3858                     }
3859                     else
3860                         dstr = NEWSV(33, 0);
3861                     if (!realarray)
3862                         sv_2mortal(dstr);
3863                     XPUSHs(dstr);
3864                 }
3865             }
3866             s = rx->endp[0];
3867         }
3868     }
3869     LEAVE_SCOPE(oldsave);
3870     iters = (SP - stack_base) - base;
3871     if (iters > maxiters)
3872         DIE("Split loop");
3873
3874     /* keep field after final delim? */
3875     if (s < strend || (iters && origlimit)) {
3876         dstr = NEWSV(34, strend-s);
3877         sv_setpvn(dstr, s, strend-s);
3878         if (!realarray)
3879             sv_2mortal(dstr);
3880         XPUSHs(dstr);
3881         iters++;
3882     }
3883     else if (!origlimit) {
3884         while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0))
3885             iters--, SP--;
3886     }
3887     if (realarray) {
3888         SWITCHSTACK(ary, oldstack);
3889         if (gimme == G_ARRAY) {
3890             EXTEND(SP, iters);
3891             Copy(AvARRAY(ary), SP + 1, iters, SV*);
3892             SP += iters;
3893             RETURN;
3894         }
3895     }
3896     else {
3897         if (gimme == G_ARRAY)
3898             RETURN;
3899     }
3900     if (iters || !pm->op_pmreplroot) {
3901         GETTARGET;
3902         PUSHi(iters);
3903         RETURN;
3904     }
3905     RETPUSHUNDEF;
3906 }
3907