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