pp.c

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