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