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