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 && MAXARG < 3) pos = 0;
1527     }
1528     if (pos < 0 || pos > curlen) {
1529         if (dowarn || lvalue)
1530             warn("substr outside of string");
1531         RETPUSHUNDEF;
1532     }
1533     else {
1534         if (MAXARG < 3)
1535             len = curlen;
1536         else if (len < 0) {
1537             len += curlen - pos;
1538             if (len < 0)
1539                 len = 0;
1540         }
1541         tmps += pos;
1542         rem = curlen - pos;     /* rem=how many bytes left*/
1543         if (rem > len)
1544             rem = len;
1545         sv_setpvn(TARG, tmps, rem);
1546         if (lvalue) {                   /* it's an lvalue! */
1547             if (!SvGMAGICAL(sv)) {
1548                 if (SvROK(sv)) {
1549                     SvPV_force(sv,na);
1550                     if (dowarn)
1551                         warn("Attempt to use reference as lvalue in substr");
1552                 }
1553                 if (SvOK(sv))           /* is it defined ? */
1554                     (void)SvPOK_only(sv);
1555                 else
1556                     sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
1557             }
1558
1559             if (SvTYPE(TARG) < SVt_PVLV) {
1560                 sv_upgrade(TARG, SVt_PVLV);
1561                 sv_magic(TARG, Nullsv, 'x', Nullch, 0);
1562             }
1563
1564             LvTYPE(TARG) = 'x';
1565             LvTARG(TARG) = sv;
1566             LvTARGOFF(TARG) = pos;
1567             LvTARGLEN(TARG) = rem;
1568         }
1569     }
1570     PUSHs(TARG);                /* avoid SvSETMAGIC here */
1571     RETURN;
1572 }
1573
1574 PP(pp_vec)
1575 {
1576     dSP; dTARGET;
1577     register I32 size = POPi;
1578     register I32 offset = POPi;
1579     register SV *src = POPs;
1580     I32 lvalue = op->op_flags & OPf_MOD;
1581     STRLEN srclen;
1582     unsigned char *s = (unsigned char*)SvPV(src, srclen);
1583     unsigned long retnum;
1584     I32 len;
1585
1586     offset *= size;             /* turn into bit offset */
1587     len = (offset + size + 7) / 8;
1588     if (offset < 0 || size < 1)
1589         retnum = 0;
1590     else {
1591         if (lvalue) {                      /* it's an lvalue! */
1592             if (SvTYPE(TARG) < SVt_PVLV) {
1593                 sv_upgrade(TARG, SVt_PVLV);
1594                 sv_magic(TARG, Nullsv, 'v', Nullch, 0);
1595             }
1596
1597             LvTYPE(TARG) = 'v';
1598             LvTARG(TARG) = src;
1599             LvTARGOFF(TARG) = offset;
1600             LvTARGLEN(TARG) = size;
1601         }
1602         if (len > srclen) {
1603             if (size <= 8)
1604                 retnum = 0;
1605             else {
1606                 offset >>= 3;
1607                 if (size == 16) {
1608                     if (offset >= srclen)
1609                         retnum = 0;
1610                     else
1611                         retnum = (unsigned long) s[offset] << 8;
1612                 }
1613                 else if (size == 32) {
1614                     if (offset >= srclen)
1615                         retnum = 0;
1616                     else if (offset + 1 >= srclen)
1617                         retnum = (unsigned long) s[offset] << 24;
1618                     else if (offset + 2 >= srclen)
1619                         retnum = ((unsigned long) s[offset] << 24) +
1620                             ((unsigned long) s[offset + 1] << 16);
1621                     else
1622                         retnum = ((unsigned long) s[offset] << 24) +
1623                             ((unsigned long) s[offset + 1] << 16) +
1624                             (s[offset + 2] << 8);
1625                 }
1626             }
1627         }
1628         else if (size < 8)
1629             retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
1630         else {
1631             offset >>= 3;
1632             if (size == 8)
1633                 retnum = s[offset];
1634             else if (size == 16)
1635                 retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
1636             else if (size == 32)
1637                 retnum = ((unsigned long) s[offset] << 24) +
1638                         ((unsigned long) s[offset + 1] << 16) +
1639                         (s[offset + 2] << 8) + s[offset+3];
1640         }
1641     }
1642
1643     sv_setiv(TARG, (IV)retnum);
1644     PUSHs(TARG);
1645     RETURN;
1646 }
1647
1648 PP(pp_index)
1649 {
1650     dSP; dTARGET;
1651     SV *big;
1652     SV *little;
1653     I32 offset;
1654     I32 retval;
1655     char *tmps;
1656     char *tmps2;
1657     STRLEN biglen;
1658     I32 arybase = curcop->cop_arybase;
1659
1660     if (MAXARG < 3)
1661         offset = 0;
1662     else
1663         offset = POPi - arybase;
1664     little = POPs;
1665     big = POPs;
1666     tmps = SvPV(big, biglen);
1667     if (offset < 0)
1668         offset = 0;
1669     else if (offset > biglen)
1670         offset = biglen;
1671     if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
1672       (unsigned char*)tmps + biglen, little)))
1673         retval = -1 + arybase;
1674     else
1675         retval = tmps2 - tmps + arybase;
1676     PUSHi(retval);
1677     RETURN;
1678 }
1679
1680 PP(pp_rindex)
1681 {
1682     dSP; dTARGET;
1683     SV *big;
1684     SV *little;
1685     STRLEN blen;
1686     STRLEN llen;
1687     SV *offstr;
1688     I32 offset;
1689     I32 retval;
1690     char *tmps;
1691     char *tmps2;
1692     I32 arybase = curcop->cop_arybase;
1693
1694     if (MAXARG >= 3)
1695         offstr = POPs;
1696     little = POPs;
1697     big = POPs;
1698     tmps2 = SvPV(little, llen);
1699     tmps = SvPV(big, blen);
1700     if (MAXARG < 3)
1701         offset = blen;
1702     else
1703         offset = SvIV(offstr) - arybase + llen;
1704     if (offset < 0)
1705         offset = 0;
1706     else if (offset > blen)
1707         offset = blen;
1708     if (!(tmps2 = rninstr(tmps,  tmps  + offset,
1709                           tmps2, tmps2 + llen)))
1710         retval = -1 + arybase;
1711     else
1712         retval = tmps2 - tmps + arybase;
1713     PUSHi(retval);
1714     RETURN;
1715 }
1716
1717 PP(pp_sprintf)
1718 {
1719     dSP; dMARK; dORIGMARK; dTARGET;
1720 #ifdef USE_LOCALE_NUMERIC
1721     if (op->op_private & OPpLOCALE)
1722         SET_NUMERIC_LOCAL();
1723     else
1724         SET_NUMERIC_STANDARD();
1725 #endif
1726     do_sprintf(TARG, SP-MARK, MARK+1);
1727     TAINT_IF(SvTAINTED(TARG));
1728     SP = ORIGMARK;
1729     PUSHTARG;
1730     RETURN;
1731 }
1732
1733 PP(pp_ord)
1734 {
1735     dSP; dTARGET;
1736     I32 value;
1737     char *tmps;
1738
1739 #ifndef I286
1740     tmps = POPp;
1741     value = (I32) (*tmps & 255);
1742 #else
1743     I32 anum;
1744     tmps = POPp;
1745     anum = (I32) *tmps;
1746     value = (I32) (anum & 255);
1747 #endif
1748     XPUSHi(value);
1749     RETURN;
1750 }
1751
1752 PP(pp_chr)
1753 {
1754     dSP; dTARGET;
1755     char *tmps;
1756
1757     (void)SvUPGRADE(TARG,SVt_PV);
1758     SvGROW(TARG,2);
1759     SvCUR_set(TARG, 1);
1760     tmps = SvPVX(TARG);
1761     *tmps++ = POPi;
1762     *tmps = '\0';
1763     (void)SvPOK_only(TARG);
1764     XPUSHs(TARG);
1765     RETURN;
1766 }
1767
1768 PP(pp_crypt)
1769 {
1770     dSP; dTARGET; dPOPTOPssrl;
1771 #ifdef HAS_CRYPT
1772     char *tmps = SvPV(left, na);
1773 #ifdef FCRYPT
1774     sv_setpv(TARG, fcrypt(tmps, SvPV(right, na)));
1775 #else
1776     sv_setpv(TARG, crypt(tmps, SvPV(right, na)));
1777 #endif
1778 #else
1779     DIE(
1780       "The crypt() function is unimplemented due to excessive paranoia.");
1781 #endif
1782     SETs(TARG);
1783     RETURN;
1784 }
1785
1786 PP(pp_ucfirst)
1787 {
1788     dSP;
1789     SV *sv = TOPs;
1790     register char *s;
1791
1792     if (!SvPADTMP(sv)) {
1793         dTARGET;
1794         sv_setsv(TARG, sv);
1795         sv = TARG;
1796         SETs(sv);
1797     }
1798     s = SvPV_force(sv, na);
1799     if (*s) {
1800         if (op->op_private & OPpLOCALE) {
1801             TAINT;
1802             SvTAINTED_on(sv);
1803             *s = toUPPER_LC(*s);
1804         }
1805         else
1806             *s = toUPPER(*s);
1807     }
1808
1809     RETURN;
1810 }
1811
1812 PP(pp_lcfirst)
1813 {
1814     dSP;
1815     SV *sv = TOPs;
1816     register char *s;
1817
1818     if (!SvPADTMP(sv)) {
1819         dTARGET;
1820         sv_setsv(TARG, sv);
1821         sv = TARG;
1822         SETs(sv);
1823     }
1824     s = SvPV_force(sv, na);
1825     if (*s) {
1826         if (op->op_private & OPpLOCALE) {
1827             TAINT;
1828             SvTAINTED_on(sv);
1829             *s = toLOWER_LC(*s);
1830         }
1831         else
1832             *s = toLOWER(*s);
1833     }
1834
1835     SETs(sv);
1836     RETURN;
1837 }
1838
1839 PP(pp_uc)
1840 {
1841     dSP;
1842     SV *sv = TOPs;
1843     register char *s;
1844     STRLEN len;
1845
1846     if (!SvPADTMP(sv)) {
1847         dTARGET;
1848         sv_setsv(TARG, sv);
1849         sv = TARG;
1850         SETs(sv);
1851     }
1852
1853     s = SvPV_force(sv, len);
1854     if (len) {
1855         register char *send = s + len;
1856
1857         if (op->op_private & OPpLOCALE) {
1858             TAINT;
1859             SvTAINTED_on(sv);
1860             for (; s < send; s++)
1861                 *s = toUPPER_LC(*s);
1862         }
1863         else {
1864             for (; s < send; s++)
1865                 *s = toUPPER(*s);
1866         }
1867     }
1868     RETURN;
1869 }
1870
1871 PP(pp_lc)
1872 {
1873     dSP;
1874     SV *sv = TOPs;
1875     register char *s;
1876     STRLEN len;
1877
1878     if (!SvPADTMP(sv)) {
1879         dTARGET;
1880         sv_setsv(TARG, sv);
1881         sv = TARG;
1882         SETs(sv);
1883     }
1884
1885     s = SvPV_force(sv, len);
1886     if (len) {
1887         register char *send = s + len;
1888
1889         if (op->op_private & OPpLOCALE) {
1890             TAINT;
1891             SvTAINTED_on(sv);
1892             for (; s < send; s++)
1893                 *s = toLOWER_LC(*s);
1894         }
1895         else {
1896             for (; s < send; s++)
1897                 *s = toLOWER(*s);
1898         }
1899     }
1900     RETURN;
1901 }
1902
1903 PP(pp_quotemeta)
1904 {
1905     dSP; dTARGET;
1906     SV *sv = TOPs;
1907     STRLEN len;
1908     register char *s = SvPV(sv,len);
1909     register char *d;
1910
1911     if (len) {
1912         (void)SvUPGRADE(TARG, SVt_PV);
1913         SvGROW(TARG, (len * 2) + 1);
1914         d = SvPVX(TARG);
1915         while (len--) {
1916             if (!isALNUM(*s))
1917                 *d++ = '\\';
1918             *d++ = *s++;
1919         }
1920         *d = '\0';
1921         SvCUR_set(TARG, d - SvPVX(TARG));
1922         (void)SvPOK_only(TARG);
1923     }
1924     else
1925         sv_setpvn(TARG, s, len);
1926     SETs(TARG);
1927     RETURN;
1928 }
1929
1930 /* Arrays. */
1931
1932 PP(pp_aslice)
1933 {
1934     dSP; dMARK; dORIGMARK;
1935     register SV** svp;
1936     register AV* av = (AV*)POPs;
1937     register I32 lval = op->op_flags & OPf_MOD;
1938     I32 arybase = curcop->cop_arybase;
1939     I32 elem;
1940
1941     if (SvTYPE(av) == SVt_PVAV) {
1942         if (lval && op->op_private & OPpLVAL_INTRO) {
1943             I32 max = -1;
1944             for (svp = mark + 1; svp <= sp; svp++) {
1945                 elem = SvIVx(*svp);
1946                 if (elem > max)
1947                     max = elem;
1948             }
1949             if (max > AvMAX(av))
1950                 av_extend(av, max);
1951         }
1952         while (++MARK <= SP) {
1953             elem = SvIVx(*MARK);
1954
1955             if (elem > 0)
1956                 elem -= arybase;
1957             svp = av_fetch(av, elem, lval);
1958             if (lval) {
1959                 if (!svp || *svp == &sv_undef)
1960                     DIE(no_aelem, elem);
1961                 if (op->op_private & OPpLVAL_INTRO)
1962                     save_svref(svp);
1963             }
1964             *MARK = svp ? *svp : &sv_undef;
1965         }
1966     }
1967     if (GIMME != G_ARRAY) {
1968         MARK = ORIGMARK;
1969         *++MARK = *SP;
1970         SP = MARK;
1971     }
1972     RETURN;
1973 }
1974
1975 /* Associative arrays. */
1976
1977 PP(pp_each)
1978 {
1979     dSP; dTARGET;
1980     HV *hash = (HV*)POPs;
1981     HE *entry;
1982
1983     PUTBACK;
1984     entry = hv_iternext(hash);                        /* might clobber stack_sp */
1985     SPAGAIN;
1986
1987     EXTEND(SP, 2);
1988     if (entry) {
1989         PUSHs(hv_iterkeysv(entry));                   /* won't clobber stack_sp */
1990         if (GIMME == G_ARRAY) {
1991             PUTBACK;
1992             sv_setsv(TARG, hv_iterval(hash, entry));  /* might clobber stack_sp */
1993             SPAGAIN;
1994             PUSHs(TARG);
1995         }
1996     }
1997     else if (GIMME == G_SCALAR)
1998         RETPUSHUNDEF;
1999
2000     RETURN;
2001 }
2002
2003 PP(pp_values)
2004 {
2005     return do_kv(ARGS);
2006 }
2007
2008 PP(pp_keys)
2009 {
2010     return do_kv(ARGS);
2011 }
2012
2013 PP(pp_delete)
2014 {
2015     dSP;
2016     SV *sv;
2017     HV *hv;
2018
2019     if (op->op_private & OPpSLICE) {
2020         dMARK; dORIGMARK;
2021         hv = (HV*)POPs;
2022         if (SvTYPE(hv) != SVt_PVHV)
2023             DIE("Not a HASH reference");
2024         while (++MARK <= SP) {
2025             sv = hv_delete_ent(hv, *MARK,
2026                         (op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0), 0);
2027             *MARK = sv ? sv : &sv_undef;
2028         }
2029         if (GIMME != G_ARRAY) {
2030             MARK = ORIGMARK;
2031             *++MARK = *SP;
2032             SP = MARK;
2033         }
2034     }
2035     else {
2036         SV *keysv = POPs;
2037         hv = (HV*)POPs;
2038         if (SvTYPE(hv) != SVt_PVHV)
2039             DIE("Not a HASH reference");
2040         sv = hv_delete_ent(hv, keysv,
2041                         (op->op_private & OPpLEAVE_VOID ? G_DISCARD : 0), 0);
2042         if (!sv)
2043             sv = &sv_undef;
2044         PUSHs(sv);
2045     }
2046     RETURN;
2047 }
2048
2049 PP(pp_exists)
2050 {
2051     dSP;
2052     SV *tmpsv = POPs;
2053     HV *hv = (HV*)POPs;
2054     STRLEN len;
2055     if (SvTYPE(hv) != SVt_PVHV) {
2056         DIE("Not a HASH reference");
2057     }
2058     if (hv_exists_ent(hv, tmpsv, 0))
2059         RETPUSHYES;
2060     RETPUSHNO;
2061 }
2062
2063 PP(pp_hslice)
2064 {
2065     dSP; dMARK; dORIGMARK;
2066     register HE *he;
2067     register HV *hv = (HV*)POPs;
2068     register I32 lval = op->op_flags & OPf_MOD;
2069
2070     if (SvTYPE(hv) == SVt_PVHV) {
2071         while (++MARK <= SP) {
2072             SV *keysv = *MARK;
2073
2074             he = hv_fetch_ent(hv, keysv, lval, 0);
2075             if (lval) {
2076                 if (!he || HeVAL(he) == &sv_undef)
2077                     DIE(no_helem, SvPV(keysv, na));
2078                 if (op->op_private & OPpLVAL_INTRO)
2079                     save_svref(&HeVAL(he));
2080             }
2081             *MARK = he ? HeVAL(he) : &sv_undef;
2082         }
2083     }
2084     if (GIMME != G_ARRAY) {
2085         MARK = ORIGMARK;
2086         *++MARK = *SP;
2087         SP = MARK;
2088     }
2089     RETURN;
2090 }
2091
2092 /* List operators. */
2093
2094 PP(pp_list)
2095 {
2096     dSP; dMARK;
2097     if (GIMME != G_ARRAY) {
2098         if (++MARK <= SP)
2099             *MARK = *SP;                /* unwanted list, return last item */
2100         else
2101             *MARK = &sv_undef;
2102         SP = MARK;
2103     }
2104     RETURN;
2105 }
2106
2107 PP(pp_lslice)
2108 {
2109     dSP;
2110     SV **lastrelem = stack_sp;
2111     SV **lastlelem = stack_base + POPMARK;
2112     SV **firstlelem = stack_base + POPMARK + 1;
2113     register SV **firstrelem = lastlelem + 1;
2114     I32 arybase = curcop->cop_arybase;
2115     I32 lval = op->op_flags & OPf_MOD;
2116     I32 is_something_there = lval;
2117
2118     register I32 max = lastrelem - lastlelem;
2119     register SV **lelem;
2120     register I32 ix;
2121
2122     if (GIMME != G_ARRAY) {
2123         ix = SvIVx(*lastlelem);
2124         if (ix < 0)
2125             ix += max;
2126         else
2127             ix -= arybase;
2128         if (ix < 0 || ix >= max)
2129             *firstlelem = &sv_undef;
2130         else
2131             *firstlelem = firstrelem[ix];
2132         SP = firstlelem;
2133         RETURN;
2134     }
2135
2136     if (max == 0) {
2137         SP = firstlelem - 1;
2138         RETURN;
2139     }
2140
2141     for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
2142         ix = SvIVx(*lelem);
2143         if (ix < 0) {
2144             ix += max;
2145             if (ix < 0)
2146                 *lelem = &sv_undef;
2147             else if (!(*lelem = firstrelem[ix]))
2148                 *lelem = &sv_undef;
2149         }
2150         else {
2151             ix -= arybase;
2152             if (ix >= max || !(*lelem = firstrelem[ix]))
2153                 *lelem = &sv_undef;
2154         }
2155         if (!is_something_there && (SvOK(*lelem) || SvGMAGICAL(*lelem)))
2156             is_something_there = TRUE;
2157     }
2158     if (is_something_there)
2159         SP = lastlelem;
2160     else
2161         SP = firstlelem - 1;
2162     RETURN;
2163 }
2164
2165 PP(pp_anonlist)
2166 {
2167     dSP; dMARK; dORIGMARK;
2168     I32 items = SP - MARK;
2169     SV *av = sv_2mortal((SV*)av_make(items, MARK+1));
2170     SP = ORIGMARK;              /* av_make() might realloc stack_sp */
2171     XPUSHs(av);
2172     RETURN;
2173 }
2174
2175 PP(pp_anonhash)
2176 {
2177     dSP; dMARK; dORIGMARK;
2178     HV* hv = (HV*)sv_2mortal((SV*)newHV());
2179
2180     while (MARK < SP) {
2181         SV* key = *++MARK;
2182         SV *val = NEWSV(46, 0);
2183         if (MARK < SP)
2184             sv_setsv(val, *++MARK);
2185         else
2186             warn("Odd number of elements in hash list");
2187         (void)hv_store_ent(hv,key,val,0);
2188     }
2189     SP = ORIGMARK;
2190     XPUSHs((SV*)hv);
2191     RETURN;
2192 }
2193
2194 PP(pp_splice)
2195 {
2196     dSP; dMARK; dORIGMARK;
2197     register AV *ary = (AV*)*++MARK;
2198     register SV **src;
2199     register SV **dst;
2200     register I32 i;
2201     register I32 offset;
2202     register I32 length;
2203     I32 newlen;
2204     I32 after;
2205     I32 diff;
2206     SV **tmparyval = 0;
2207
2208     SP++;
2209
2210     if (++MARK < SP) {
2211         offset = SvIVx(*MARK);
2212         if (offset < 0)
2213             offset += AvFILL(ary) + 1;
2214         else
2215             offset -= curcop->cop_arybase;
2216         if (++MARK < SP) {
2217             length = SvIVx(*MARK++);
2218             if (length < 0)
2219                 length = 0;
2220         }
2221         else
2222             length = AvMAX(ary) + 1;            /* close enough to infinity */
2223     }
2224     else {
2225         offset = 0;
2226         length = AvMAX(ary) + 1;
2227     }
2228     if (offset < 0) {
2229         length += offset;
2230         offset = 0;
2231         if (length < 0)
2232             length = 0;
2233     }
2234     if (offset > AvFILL(ary) + 1)
2235         offset = AvFILL(ary) + 1;
2236     after = AvFILL(ary) + 1 - (offset + length);
2237     if (after < 0) {                            /* not that much array */
2238         length += after;                        /* offset+length now in array */
2239         after = 0;
2240         if (!AvALLOC(ary))
2241             av_extend(ary, 0);
2242     }
2243
2244     /* At this point, MARK .. SP-1 is our new LIST */
2245
2246     newlen = SP - MARK;
2247     diff = newlen - length;
2248
2249     if (diff < 0) {                             /* shrinking the area */
2250         if (newlen) {
2251             New(451, tmparyval, newlen, SV*);   /* so remember insertion */
2252             Copy(MARK, tmparyval, newlen, SV*);
2253         }
2254
2255         MARK = ORIGMARK + 1;
2256         if (GIMME == G_ARRAY) {                 /* copy return vals to stack */
2257             MEXTEND(MARK, length);
2258             Copy(AvARRAY(ary)+offset, MARK, length, SV*);
2259             if (AvREAL(ary)) {
2260                 EXTEND_MORTAL(length);
2261                 for (i = length, dst = MARK; i; i--) {
2262                     if (!SvIMMORTAL(*dst))
2263                         sv_2mortal(*dst);       /* free them eventualy */
2264                     dst++;
2265                 }
2266             }
2267             MARK += length - 1;
2268         }
2269         else {
2270             *MARK = AvARRAY(ary)[offset+length-1];
2271             if (AvREAL(ary)) {
2272                 if (!SvIMMORTAL(*MARK))
2273                     sv_2mortal(*MARK);
2274                 for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
2275                     SvREFCNT_dec(*dst++);       /* free them now */
2276             }
2277         }
2278         AvFILL(ary) += diff;
2279
2280         /* pull up or down? */
2281
2282         if (offset < after) {                   /* easier to pull up */
2283             if (offset) {                       /* esp. if nothing to pull */
2284                 src = &AvARRAY(ary)[offset-1];
2285                 dst = src - diff;               /* diff is negative */
2286                 for (i = offset; i > 0; i--)    /* can't trust Copy */
2287                     *dst-- = *src--;
2288             }
2289             dst = AvARRAY(ary);
2290             SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
2291             AvMAX(ary) += diff;
2292         }
2293         else {
2294             if (after) {                        /* anything to pull down? */
2295                 src = AvARRAY(ary) + offset + length;
2296                 dst = src + diff;               /* diff is negative */
2297                 Move(src, dst, after, SV*);
2298             }
2299             dst = &AvARRAY(ary)[AvFILL(ary)+1];
2300                                                 /* avoid later double free */
2301         }
2302         i = -diff;
2303         while (i)
2304             dst[--i] = &sv_undef;
2305
2306         if (newlen) {
2307             for (src = tmparyval, dst = AvARRAY(ary) + offset;
2308               newlen; newlen--) {
2309                 *dst = NEWSV(46, 0);
2310                 sv_setsv(*dst++, *src++);
2311             }
2312             Safefree(tmparyval);
2313         }
2314     }
2315     else {                                      /* no, expanding (or same) */
2316         if (length) {
2317             New(452, tmparyval, length, SV*);   /* so remember deletion */
2318             Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
2319         }
2320
2321         if (diff > 0) {                         /* expanding */
2322
2323             /* push up or down? */
2324
2325             if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
2326                 if (offset) {
2327                     src = AvARRAY(ary);
2328                     dst = src - diff;
2329                     Move(src, dst, offset, SV*);
2330                 }
2331                 SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
2332                 AvMAX(ary) += diff;
2333                 AvFILL(ary) += diff;
2334             }
2335             else {
2336                 if (AvFILL(ary) + diff >= AvMAX(ary))   /* oh, well */
2337                     av_extend(ary, AvFILL(ary) + diff);
2338                 AvFILL(ary) += diff;
2339
2340                 if (after) {
2341                     dst = AvARRAY(ary) + AvFILL(ary);
2342                     src = dst - diff;
2343                     for (i = after; i; i--) {
2344                         *dst-- = *src--;
2345                     }
2346                 }
2347             }
2348         }
2349
2350         for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
2351             *dst = NEWSV(46, 0);
2352             sv_setsv(*dst++, *src++);
2353         }
2354         MARK = ORIGMARK + 1;
2355         if (GIMME == G_ARRAY) {                 /* copy return vals to stack */
2356             if (length) {
2357                 Copy(tmparyval, MARK, length, SV*);
2358                 if (AvREAL(ary)) {
2359                     EXTEND_MORTAL(length);
2360                     for (i = length, dst = MARK; i; i--) {
2361                         if (!SvIMMORTAL(*dst))
2362                             sv_2mortal(*dst);   /* free them eventualy */
2363                         dst++;
2364                     }
2365                 }
2366                 Safefree(tmparyval);
2367             }
2368             MARK += length - 1;
2369         }
2370         else if (length--) {
2371             *MARK = tmparyval[length];
2372             if (AvREAL(ary)) {
2373                 if (!SvIMMORTAL(*MARK))
2374                     sv_2mortal(*MARK);
2375                 while (length-- > 0)
2376                     SvREFCNT_dec(tmparyval[length]);
2377             }
2378             Safefree(tmparyval);
2379         }
2380         else
2381             *MARK = &sv_undef;
2382     }
2383     SP = MARK;
2384     RETURN;
2385 }
2386
2387 PP(pp_push)
2388 {
2389     dSP; dMARK; dORIGMARK; dTARGET;
2390     register AV *ary = (AV*)*++MARK;
2391     register SV *sv = &sv_undef;
2392
2393     for (++MARK; MARK <= SP; MARK++) {
2394         sv = NEWSV(51, 0);
2395         if (*MARK)
2396             sv_setsv(sv, *MARK);
2397         av_push(ary, sv);
2398     }
2399     SP = ORIGMARK;
2400     PUSHi( AvFILL(ary) + 1 );
2401     RETURN;
2402 }
2403
2404 PP(pp_pop)
2405 {
2406     dSP;
2407     AV *av = (AV*)POPs;
2408     SV *sv = av_pop(av);
2409     if (!SvIMMORTAL(sv) && AvREAL(av))
2410         (void)sv_2mortal(sv);
2411     PUSHs(sv);
2412     RETURN;
2413 }
2414
2415 PP(pp_shift)
2416 {
2417     dSP;
2418     AV *av = (AV*)POPs;
2419     SV *sv = av_shift(av);
2420     EXTEND(SP, 1);
2421     if (!sv)
2422         RETPUSHUNDEF;
2423     if (!SvIMMORTAL(sv) && AvREAL(av))
2424         (void)sv_2mortal(sv);
2425     PUSHs(sv);
2426     RETURN;
2427 }
2428
2429 PP(pp_unshift)
2430 {
2431     dSP; dMARK; dORIGMARK; dTARGET;
2432     register AV *ary = (AV*)*++MARK;
2433     register SV *sv;
2434     register I32 i = 0;
2435
2436     av_unshift(ary, SP - MARK);
2437     while (MARK < SP) {
2438         sv = NEWSV(27, 0);
2439         sv_setsv(sv, *++MARK);
2440         (void)av_store(ary, i++, sv);
2441     }
2442
2443     SP = ORIGMARK;
2444     PUSHi( AvFILL(ary) + 1 );
2445     RETURN;
2446 }
2447
2448 PP(pp_reverse)
2449 {
2450     dSP; dMARK;
2451     register SV *tmp;
2452     SV **oldsp = SP;
2453
2454     if (GIMME == G_ARRAY) {
2455         MARK++;
2456         while (MARK < SP) {
2457             tmp = *MARK;
2458             *MARK++ = *SP;
2459             *SP-- = tmp;
2460         }
2461         SP = oldsp;
2462     }
2463     else {
2464         register char *up;
2465         register char *down;
2466         register I32 tmp;
2467         dTARGET;
2468         STRLEN len;
2469
2470         if (SP - MARK > 1)
2471             do_join(TARG, &sv_no, MARK, SP);
2472         else
2473             sv_setsv(TARG, *SP);
2474         up = SvPV_force(TARG, len);
2475         if (len > 1) {
2476             down = SvPVX(TARG) + len - 1;
2477             while (down > up) {
2478                 tmp = *up;
2479                 *up++ = *down;
2480                 *down-- = tmp;
2481             }
2482             (void)SvPOK_only(TARG);
2483         }
2484         SP = MARK + 1;
2485         SETTARG;
2486     }
2487     RETURN;
2488 }
2489
2490 static SV      *
2491 mul128(sv, m)
2492      SV             *sv;
2493      U8              m;
2494 {
2495   STRLEN          len;
2496   char           *s = SvPV(sv, len);
2497   char           *t;
2498   U32             i = 0;
2499
2500   if (!strnEQ(s, "0000", 4)) {  /* need to grow sv */
2501     SV             *new = newSVpv("0000000000", 10);
2502
2503     sv_catsv(new, sv);
2504     SvREFCNT_dec(sv);           /* free old sv */
2505     sv = new;
2506     s = SvPV(sv, len);
2507   }
2508   t = s + len - 1;
2509   while (!*t)                   /* trailing '\0'? */
2510     t--;
2511   while (t > s) {
2512     i = ((*t - '0') << 7) + m;
2513     *(t--) = '0' + (i % 10);
2514     m = i / 10;
2515   }
2516   return (sv);
2517 }
2518
2519 /* Explosives and implosives. */
2520
2521 PP(pp_unpack)
2522 {
2523     dSP;
2524     dPOPPOPssrl;
2525     SV **oldsp = sp;
2526     SV *sv;
2527     STRLEN llen;
2528     STRLEN rlen;
2529     register char *pat = SvPV(left, llen);
2530     register char *s = SvPV(right, rlen);
2531     char *strend = s + rlen;
2532     char *strbeg = s;
2533     register char *patend = pat + llen;
2534     I32 datumtype;
2535     register I32 len;
2536     register I32 bits;
2537
2538     /* These must not be in registers: */
2539     I16 ashort;
2540     int aint;
2541     I32 along;
2542 #ifdef HAS_QUAD
2543     Quad_t aquad;
2544 #endif
2545     U16 aushort;
2546     unsigned int auint;
2547     U32 aulong;
2548 #ifdef HAS_QUAD
2549     unsigned Quad_t auquad;
2550 #endif
2551     char *aptr;
2552     float afloat;
2553     double adouble;
2554     I32 checksum = 0;
2555     register U32 culong;
2556     double cdouble;
2557     static char* bitcount = 0;
2558
2559     if (GIMME != G_ARRAY) {             /* arrange to do first one only */
2560         /*SUPPRESS 530*/
2561         for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
2562         if (strchr("aAbBhHP", *patend) || *pat == '%') {
2563             patend++;
2564             while (isDIGIT(*patend) || *patend == '*')
2565                 patend++;
2566         }
2567         else
2568             patend++;
2569     }
2570     while (pat < patend) {
2571       reparse:
2572         datumtype = *pat++;
2573         if (pat >= patend)
2574             len = 1;
2575         else if (*pat == '*') {
2576             len = strend - strbeg;      /* long enough */
2577             pat++;
2578         }
2579         else if (isDIGIT(*pat)) {
2580             len = *pat++ - '0';
2581             while (isDIGIT(*pat))
2582                 len = (len * 10) + (*pat++ - '0');
2583         }
2584         else
2585             len = (datumtype != '@');
2586         switch(datumtype) {
2587         default:
2588             break;
2589         case '%':
2590             if (len == 1 && pat[-1] != '1')
2591                 len = 16;
2592             checksum = len;
2593             culong = 0;
2594             cdouble = 0;
2595             if (pat < patend)
2596                 goto reparse;
2597             break;
2598         case '@':
2599             if (len > strend - strbeg)
2600                 DIE("@ outside of string");
2601             s = strbeg + len;
2602             break;
2603         case 'X':
2604             if (len > s - strbeg)
2605                 DIE("X outside of string");
2606             s -= len;
2607             break;
2608         case 'x':
2609             if (len > strend - s)
2610                 DIE("x outside of string");
2611             s += len;
2612             break;
2613         case 'A':
2614         case 'a':
2615             if (len > strend - s)
2616                 len = strend - s;
2617             if (checksum)
2618                 goto uchar_checksum;
2619             sv = NEWSV(35, len);
2620             sv_setpvn(sv, s, len);
2621             s += len;
2622             if (datumtype == 'A') {
2623                 aptr = s;       /* borrow register */
2624                 s = SvPVX(sv) + len - 1;
2625                 while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
2626                     s--;
2627                 *++s = '\0';
2628                 SvCUR_set(sv, s - SvPVX(sv));
2629                 s = aptr;       /* unborrow register */
2630             }
2631             XPUSHs(sv_2mortal(sv));
2632             break;
2633         case 'B':
2634         case 'b':
2635             if (pat[-1] == '*' || len > (strend - s) * 8)
2636                 len = (strend - s) * 8;
2637             if (checksum) {
2638                 if (!bitcount) {
2639                     Newz(601, bitcount, 256, char);
2640                     for (bits = 1; bits < 256; bits++) {
2641                         if (bits & 1)   bitcount[bits]++;
2642                         if (bits & 2)   bitcount[bits]++;
2643                         if (bits & 4)   bitcount[bits]++;
2644                         if (bits & 8)   bitcount[bits]++;
2645                         if (bits & 16)  bitcount[bits]++;
2646                         if (bits & 32)  bitcount[bits]++;
2647                         if (bits & 64)  bitcount[bits]++;
2648                         if (bits & 128) bitcount[bits]++;
2649                     }
2650                 }
2651                 while (len >= 8) {
2652                     culong += bitcount[*(unsigned char*)s++];
2653                     len -= 8;
2654                 }
2655                 if (len) {
2656                     bits = *s;
2657                     if (datumtype == 'b') {
2658                         while (len-- > 0) {
2659                             if (bits & 1) culong++;
2660                             bits >>= 1;
2661                         }
2662                     }
2663                     else {
2664                         while (len-- > 0) {
2665                             if (bits & 128) culong++;
2666                             bits <<= 1;
2667                         }
2668                     }
2669                 }
2670                 break;
2671             }
2672             sv = NEWSV(35, len + 1);
2673             SvCUR_set(sv, len);
2674             SvPOK_on(sv);
2675             aptr = pat;                 /* borrow register */
2676             pat = SvPVX(sv);
2677             if (datumtype == 'b') {
2678                 aint = len;
2679                 for (len = 0; len < aint; len++) {
2680                     if (len & 7)                /*SUPPRESS 595*/
2681                         bits >>= 1;
2682                     else
2683                         bits = *s++;
2684                     *pat++ = '0' + (bits & 1);
2685                 }
2686             }
2687             else {
2688                 aint = len;
2689                 for (len = 0; len < aint; len++) {
2690                     if (len & 7)
2691                         bits <<= 1;
2692                     else
2693                         bits = *s++;
2694                     *pat++ = '0' + ((bits & 128) != 0);
2695                 }
2696             }
2697             *pat = '\0';
2698             pat = aptr;                 /* unborrow register */
2699             XPUSHs(sv_2mortal(sv));
2700             break;
2701         case 'H':
2702         case 'h':
2703             if (pat[-1] == '*' || len > (strend - s) * 2)
2704                 len = (strend - s) * 2;
2705             sv = NEWSV(35, len + 1);
2706             SvCUR_set(sv, len);
2707             SvPOK_on(sv);
2708             aptr = pat;                 /* borrow register */
2709             pat = SvPVX(sv);
2710             if (datumtype == 'h') {
2711                 aint = len;
2712                 for (len = 0; len < aint; len++) {
2713                     if (len & 1)
2714                         bits >>= 4;
2715                     else
2716                         bits = *s++;
2717                     *pat++ = hexdigit[bits & 15];
2718                 }
2719             }
2720             else {
2721                 aint = len;
2722                 for (len = 0; len < aint; len++) {
2723                     if (len & 1)
2724                         bits <<= 4;
2725                     else
2726                         bits = *s++;
2727                     *pat++ = hexdigit[(bits >> 4) & 15];
2728                 }
2729             }
2730             *pat = '\0';
2731             pat = aptr;                 /* unborrow register */
2732             XPUSHs(sv_2mortal(sv));
2733             break;
2734         case 'c':
2735             if (len > strend - s)
2736                 len = strend - s;
2737             if (checksum) {
2738                 while (len-- > 0) {
2739                     aint = *s++;
2740                     if (aint >= 128)    /* fake up signed chars */
2741                         aint -= 256;
2742                     culong += aint;
2743                 }
2744             }
2745             else {
2746                 EXTEND(SP, len);
2747                 EXTEND_MORTAL(len);
2748                 while (len-- > 0) {
2749                     aint = *s++;
2750                     if (aint >= 128)    /* fake up signed chars */
2751                         aint -= 256;
2752                     sv = NEWSV(36, 0);
2753                     sv_setiv(sv, (IV)aint);
2754                     PUSHs(sv_2mortal(sv));
2755                 }
2756             }
2757             break;
2758         case 'C':
2759             if (len > strend - s)
2760                 len = strend - s;
2761             if (checksum) {
2762               uchar_checksum:
2763                 while (len-- > 0) {
2764                     auint = *s++ & 255;
2765                     culong += auint;
2766                 }
2767             }
2768             else {
2769                 EXTEND(SP, len);
2770                 EXTEND_MORTAL(len);
2771                 while (len-- > 0) {
2772                     auint = *s++ & 255;
2773                     sv = NEWSV(37, 0);
2774                     sv_setiv(sv, (IV)auint);
2775                     PUSHs(sv_2mortal(sv));
2776                 }
2777             }
2778             break;
2779         case 's':
2780             along = (strend - s) / sizeof(I16);
2781             if (len > along)
2782                 len = along;
2783             if (checksum) {
2784                 while (len-- > 0) {
2785                     Copy(s, &ashort, 1, I16);
2786                     s += sizeof(I16);
2787                     culong += ashort;
2788                 }
2789             }
2790             else {
2791                 EXTEND(SP, len);
2792                 EXTEND_MORTAL(len);
2793                 while (len-- > 0) {
2794                     Copy(s, &ashort, 1, I16);
2795                     s += sizeof(I16);
2796                     sv = NEWSV(38, 0);
2797                     sv_setiv(sv, (IV)ashort);
2798                     PUSHs(sv_2mortal(sv));
2799                 }
2800             }
2801             break;
2802         case 'v':
2803         case 'n':
2804         case 'S':
2805             along = (strend - s) / sizeof(U16);
2806             if (len > along)
2807                 len = along;
2808             if (checksum) {
2809                 while (len-- > 0) {
2810                     Copy(s, &aushort, 1, U16);
2811                     s += sizeof(U16);
2812 #ifdef HAS_NTOHS
2813                     if (datumtype == 'n')
2814                         aushort = ntohs(aushort);
2815 #endif
2816 #ifdef HAS_VTOHS
2817                     if (datumtype == 'v')
2818                         aushort = vtohs(aushort);
2819 #endif
2820                     culong += aushort;
2821                 }
2822             }
2823             else {
2824                 EXTEND(SP, len);
2825                 EXTEND_MORTAL(len);
2826                 while (len-- > 0) {
2827                     Copy(s, &aushort, 1, U16);
2828                     s += sizeof(U16);
2829                     sv = NEWSV(39, 0);
2830 #ifdef HAS_NTOHS
2831                     if (datumtype == 'n')
2832                         aushort = ntohs(aushort);
2833 #endif
2834 #ifdef HAS_VTOHS
2835                     if (datumtype == 'v')
2836                         aushort = vtohs(aushort);
2837 #endif
2838                     sv_setiv(sv, (IV)aushort);
2839                     PUSHs(sv_2mortal(sv));
2840                 }
2841             }
2842             break;
2843         case 'i':
2844             along = (strend - s) / sizeof(int);
2845             if (len > along)
2846                 len = along;
2847             if (checksum) {
2848                 while (len-- > 0) {
2849                     Copy(s, &aint, 1, int);
2850                     s += sizeof(int);
2851                     if (checksum > 32)
2852                         cdouble += (double)aint;
2853                     else
2854                         culong += aint;
2855                 }
2856             }
2857             else {
2858                 EXTEND(SP, len);
2859                 EXTEND_MORTAL(len);
2860                 while (len-- > 0) {
2861                     Copy(s, &aint, 1, int);
2862                     s += sizeof(int);
2863                     sv = NEWSV(40, 0);
2864                     sv_setiv(sv, (IV)aint);
2865                     PUSHs(sv_2mortal(sv));
2866                 }
2867             }
2868             break;
2869         case 'I':
2870             along = (strend - s) / sizeof(unsigned int);
2871             if (len > along)
2872                 len = along;
2873             if (checksum) {
2874                 while (len-- > 0) {
2875                     Copy(s, &auint, 1, unsigned int);
2876                     s += sizeof(unsigned int);
2877                     if (checksum > 32)
2878                         cdouble += (double)auint;
2879                     else
2880                         culong += auint;
2881                 }
2882             }
2883             else {
2884                 EXTEND(SP, len);
2885                 EXTEND_MORTAL(len);
2886                 while (len-- > 0) {
2887                     Copy(s, &auint, 1, unsigned int);
2888                     s += sizeof(unsigned int);
2889                     sv = NEWSV(41, 0);
2890                     sv_setuv(sv, (UV)auint);
2891                     PUSHs(sv_2mortal(sv));
2892                 }
2893             }
2894             break;
2895         case 'l':
2896             along = (strend - s) / sizeof(I32);
2897             if (len > along)
2898                 len = along;
2899             if (checksum) {
2900                 while (len-- > 0) {
2901                     Copy(s, &along, 1, I32);
2902                     s += sizeof(I32);
2903                     if (checksum > 32)
2904                         cdouble += (double)along;
2905                     else
2906                         culong += along;
2907                 }
2908             }
2909             else {
2910                 EXTEND(SP, len);
2911                 EXTEND_MORTAL(len);
2912                 while (len-- > 0) {
2913                     Copy(s, &along, 1, I32);
2914                     s += sizeof(I32);
2915                     sv = NEWSV(42, 0);
2916                     sv_setiv(sv, (IV)along);
2917                     PUSHs(sv_2mortal(sv));
2918                 }
2919             }
2920             break;
2921         case 'V':
2922         case 'N':
2923         case 'L':
2924             along = (strend - s) / sizeof(U32);
2925             if (len > along)
2926                 len = along;
2927             if (checksum) {
2928                 while (len-- > 0) {
2929                     Copy(s, &aulong, 1, U32);
2930                     s += sizeof(U32);
2931 #ifdef HAS_NTOHL
2932                     if (datumtype == 'N')
2933                         aulong = ntohl(aulong);
2934 #endif
2935 #ifdef HAS_VTOHL
2936                     if (datumtype == 'V')
2937                         aulong = vtohl(aulong);
2938 #endif
2939                     if (checksum > 32)
2940                         cdouble += (double)aulong;
2941                     else
2942                         culong += aulong;
2943                 }
2944             }
2945             else {
2946                 EXTEND(SP, len);
2947                 EXTEND_MORTAL(len);
2948                 while (len-- > 0) {
2949                     Copy(s, &aulong, 1, U32);
2950                     s += sizeof(U32);
2951 #ifdef HAS_NTOHL
2952                     if (datumtype == 'N')
2953                         aulong = ntohl(aulong);
2954 #endif
2955 #ifdef HAS_VTOHL
2956                     if (datumtype == 'V')
2957                         aulong = vtohl(aulong);
2958 #endif
2959                     sv = NEWSV(43, 0);
2960                     sv_setuv(sv, (UV)aulong);
2961                     PUSHs(sv_2mortal(sv));
2962                 }
2963             }
2964             break;
2965         case 'p':
2966             along = (strend - s) / sizeof(char*);
2967             if (len > along)
2968                 len = along;
2969             EXTEND(SP, len);
2970             EXTEND_MORTAL(len);
2971             while (len-- > 0) {
2972                 if (sizeof(char*) > strend - s)
2973                     break;
2974                 else {
2975                     Copy(s, &aptr, 1, char*);
2976                     s += sizeof(char*);
2977                 }
2978                 sv = NEWSV(44, 0);
2979                 if (aptr)
2980                     sv_setpv(sv, aptr);
2981                 PUSHs(sv_2mortal(sv));
2982             }
2983             break;
2984         case 'w':
2985             EXTEND(SP, len);
2986             EXTEND_MORTAL(len);
2987             {
2988                 UV auv = 0;
2989                 U32 bytes = 0;
2990
2991                 while ((len > 0) && (s < strend)) {
2992                     auv = (auv << 7) | (*s & 0x7f);
2993                     if (!(*s++ & 0x80)) {
2994                         bytes = 0;
2995                         sv = NEWSV(40, 0);
2996                         sv_setuv(sv, auv);
2997                         PUSHs(sv_2mortal(sv));
2998                         len--;
2999                         auv = 0;
3000                     }
3001                     else if (++bytes >= sizeof(UV)) {   /* promote to string */
3002                         char decn[sizeof(UV) * 3 + 1];
3003                         char *t;
3004
3005                         (void) sprintf(decn, "%0*ld",
3006                                        (int)sizeof(decn) - 1, auv);
3007                         sv = newSVpv(decn, 0);
3008                         while (s < strend) {
3009                             sv = mul128(sv, *s & 0x7f);
3010                             if (!(*s++ & 0x80)) {
3011                                 bytes = 0;
3012                                 break;
3013                             }
3014                         }
3015                         t = SvPV(sv, na);
3016                         while (*t == '0')
3017                             t++;
3018                         sv_chop(sv, t);
3019                         PUSHs(sv_2mortal(sv));
3020                         len--;
3021                         auv = 0;
3022                     }
3023                 }
3024                 if ((s >= strend) && bytes)
3025                     croak("Unterminated compressed integer");
3026             }
3027             break;
3028         case 'P':
3029             EXTEND(SP, 1);
3030             if (sizeof(char*) > strend - s)
3031                 break;
3032             else {
3033                 Copy(s, &aptr, 1, char*);
3034                 s += sizeof(char*);
3035             }
3036             sv = NEWSV(44, 0);
3037             if (aptr)
3038                 sv_setpvn(sv, aptr, len);
3039             PUSHs(sv_2mortal(sv));
3040             break;
3041 #ifdef HAS_QUAD
3042         case 'q':
3043             EXTEND(SP, len);
3044             EXTEND_MORTAL(len);
3045             while (len-- > 0) {
3046                 if (s + sizeof(Quad_t) > strend)
3047                     aquad = 0;
3048                 else {
3049                     Copy(s, &aquad, 1, Quad_t);
3050                     s += sizeof(Quad_t);
3051                 }
3052                 sv = NEWSV(42, 0);
3053                 sv_setiv(sv, (IV)aquad);
3054                 PUSHs(sv_2mortal(sv));
3055             }
3056             break;
3057         case 'Q':
3058             EXTEND(SP, len);
3059             EXTEND_MORTAL(len);
3060             while (len-- > 0) {
3061                 if (s + sizeof(unsigned Quad_t) > strend)
3062                     auquad = 0;
3063                 else {
3064                     Copy(s, &auquad, 1, unsigned Quad_t);
3065                     s += sizeof(unsigned Quad_t);
3066                 }
3067                 sv = NEWSV(43, 0);
3068                 sv_setuv(sv, (UV)auquad);
3069                 PUSHs(sv_2mortal(sv));
3070             }
3071             break;
3072 #endif
3073         /* float and double added gnb@melba.bby.oz.au 22/11/89 */
3074         case 'f':
3075         case 'F':
3076             along = (strend - s) / sizeof(float);
3077             if (len > along)
3078                 len = along;
3079             if (checksum) {
3080                 while (len-- > 0) {
3081                     Copy(s, &afloat, 1, float);
3082                     s += sizeof(float);
3083                     cdouble += afloat;
3084                 }
3085             }
3086             else {
3087                 EXTEND(SP, len);
3088                 EXTEND_MORTAL(len);
3089                 while (len-- > 0) {
3090                     Copy(s, &afloat, 1, float);
3091                     s += sizeof(float);
3092                     sv = NEWSV(47, 0);
3093                     sv_setnv(sv, (double)afloat);
3094                     PUSHs(sv_2mortal(sv));
3095                 }
3096             }
3097             break;
3098         case 'd':
3099         case 'D':
3100             along = (strend - s) / sizeof(double);
3101             if (len > along)
3102                 len = along;
3103             if (checksum) {
3104                 while (len-- > 0) {
3105                     Copy(s, &adouble, 1, double);
3106                     s += sizeof(double);
3107                     cdouble += adouble;
3108                 }
3109             }
3110             else {
3111                 EXTEND(SP, len);
3112                 EXTEND_MORTAL(len);
3113                 while (len-- > 0) {
3114                     Copy(s, &adouble, 1, double);
3115                     s += sizeof(double);
3116                     sv = NEWSV(48, 0);
3117                     sv_setnv(sv, (double)adouble);
3118                     PUSHs(sv_2mortal(sv));
3119                 }
3120             }
3121             break;
3122         case 'u':
3123             along = (strend - s) * 3 / 4;
3124             sv = NEWSV(42, along);
3125             if (along)
3126                 SvPOK_on(sv);
3127             while (s < strend && *s > ' ' && *s < 'a') {
3128                 I32 a, b, c, d;
3129                 char hunk[4];
3130
3131                 hunk[3] = '\0';
3132                 len = (*s++ - ' ') & 077;
3133                 while (len > 0) {
3134                     if (s < strend && *s >= ' ')
3135                         a = (*s++ - ' ') & 077;
3136                     else
3137                         a = 0;
3138                     if (s < strend && *s >= ' ')
3139                         b = (*s++ - ' ') & 077;
3140                     else
3141                         b = 0;
3142                     if (s < strend && *s >= ' ')
3143                         c = (*s++ - ' ') & 077;
3144                     else
3145                         c = 0;
3146                     if (s < strend && *s >= ' ')
3147                         d = (*s++ - ' ') & 077;
3148                     else
3149                         d = 0;
3150                     hunk[0] = a << 2 | b >> 4;
3151                     hunk[1] = b << 4 | c >> 2;
3152                     hunk[2] = c << 6 | d;
3153                     sv_catpvn(sv, hunk, len > 3 ? 3 : len);
3154                     len -= 3;
3155                 }
3156                 if (*s == '\n')
3157                     s++;
3158                 else if (s[1] == '\n')          /* possible checksum byte */
3159                     s += 2;
3160             }
3161             XPUSHs(sv_2mortal(sv));
3162             break;
3163         }
3164         if (checksum) {
3165             sv = NEWSV(42, 0);
3166             if (strchr("fFdD", datumtype) ||
3167               (checksum > 32 && strchr("iIlLN", datumtype)) ) {
3168                 double trouble;
3169
3170                 adouble = 1.0;
3171                 while (checksum >= 16) {
3172                     checksum -= 16;
3173                     adouble *= 65536.0;
3174                 }
3175                 while (checksum >= 4) {
3176                     checksum -= 4;
3177                     adouble *= 16.0;
3178                 }
3179                 while (checksum--)
3180                     adouble *= 2.0;
3181                 along = (1 << checksum) - 1;
3182                 while (cdouble < 0.0)
3183                     cdouble += adouble;
3184                 cdouble = modf(cdouble / adouble, &trouble) * adouble;
3185                 sv_setnv(sv, cdouble);
3186             }
3187             else {
3188                 if (checksum < 32) {
3189                     along = (1 << checksum) - 1;
3190                     culong &= (U32)along;
3191                 }
3192                 sv_setnv(sv, (double)culong);
3193             }
3194             XPUSHs(sv_2mortal(sv));
3195             checksum = 0;
3196         }
3197     }
3198     if (sp == oldsp && GIMME != G_ARRAY)
3199         PUSHs(&sv_undef);
3200     RETURN;
3201 }
3202
3203 static void
3204 doencodes(sv, s, len)
3205 register SV *sv;
3206 register char *s;
3207 register I32 len;
3208 {
3209     char hunk[5];
3210
3211     *hunk = len + ' ';
3212     sv_catpvn(sv, hunk, 1);
3213     hunk[4] = '\0';
3214     while (len > 0) {
3215         hunk[0] = ' ' + (077 & (*s >> 2));
3216         hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
3217         hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
3218         hunk[3] = ' ' + (077 & (s[2] & 077));
3219         sv_catpvn(sv, hunk, 4);
3220         s += 3;
3221         len -= 3;
3222     }
3223     for (s = SvPVX(sv); *s; s++) {
3224         if (*s == ' ')
3225             *s = '`';
3226     }
3227     sv_catpvn(sv, "\n", 1);
3228 }
3229
3230 static SV      *
3231 is_an_int(s, l)
3232      char           *s;
3233      STRLEN          l;
3234 {
3235   SV             *result = newSVpv("", l);
3236   char           *result_c = SvPV(result, na);  /* convenience */
3237   char           *out = result_c;
3238   bool            skip = 1;
3239   bool            ignore = 0;
3240
3241   while (*s) {
3242     switch (*s) {
3243     case ' ':
3244       break;
3245     case '+':
3246       if (!skip) {
3247         SvREFCNT_dec(result);
3248         return (NULL);
3249       }
3250       break;
3251     case '0':
3252     case '1':
3253     case '2':
3254     case '3':
3255     case '4':
3256     case '5':
3257     case '6':
3258     case '7':
3259     case '8':
3260     case '9':
3261       skip = 0;
3262       if (!ignore) {
3263         *(out++) = *s;
3264       }
3265       break;
3266     case '.':
3267       ignore = 1;
3268       break;
3269     default:
3270       SvREFCNT_dec(result);
3271       return (NULL);
3272     }
3273     s++;
3274   }
3275   *(out++) = '\0';
3276   SvCUR_set(result, out - result_c);
3277   return (result);
3278 }
3279
3280 static int
3281 div128(pnum, done)
3282      SV             *pnum;                  /* must be '\0' terminated */
3283      bool           *done;
3284 {
3285   STRLEN          len;
3286   char           *s = SvPV(pnum, len);
3287   int             m = 0;
3288   int             r = 0;
3289   char           *t = s;
3290
3291   *done = 1;
3292   while (*t) {
3293     int             i;
3294
3295     i = m * 10 + (*t - '0');
3296     m = i & 0x7F;
3297     r = (i >> 7);               /* r < 10 */
3298     if (r) {
3299       *done = 0;
3300     }
3301     *(t++) = '0' + r;
3302   }
3303   *(t++) = '\0';
3304   SvCUR_set(pnum, (STRLEN) (t - s));
3305   return (m);
3306 }
3307
3308
3309 PP(pp_pack)
3310 {
3311     dSP; dMARK; dORIGMARK; dTARGET;
3312     register SV *cat = TARG;
3313     register I32 items;
3314     STRLEN fromlen;
3315     register char *pat = SvPVx(*++MARK, fromlen);
3316     register char *patend = pat + fromlen;
3317     register I32 len;
3318     I32 datumtype;
3319     SV *fromstr;
3320     /*SUPPRESS 442*/
3321     static char null10[] = {0,0,0,0,0,0,0,0,0,0};
3322     static char *space10 = "          ";
3323
3324     /* These must not be in registers: */
3325     char achar;
3326     I16 ashort;
3327     int aint;
3328     unsigned int auint;
3329     I32 along;
3330     U32 aulong;
3331 #ifdef HAS_QUAD
3332     Quad_t aquad;
3333     unsigned Quad_t auquad;
3334 #endif
3335     char *aptr;
3336     float afloat;
3337     double adouble;
3338
3339     items = SP - MARK;
3340     MARK++;
3341     sv_setpvn(cat, "", 0);
3342     while (pat < patend) {
3343 #define NEXTFROM (items-- > 0 ? *MARK++ : &sv_no)
3344         datumtype = *pat++;
3345         if (*pat == '*') {
3346             len = strchr("@Xxu", datumtype) ? 0 : items;
3347             pat++;
3348         }
3349         else if (isDIGIT(*pat)) {
3350             len = *pat++ - '0';
3351             while (isDIGIT(*pat))
3352                 len = (len * 10) + (*pat++ - '0');
3353         }
3354         else
3355             len = 1;
3356         switch(datumtype) {
3357         default:
3358             break;
3359         case '%':
3360             DIE("%% may only be used in unpack");
3361         case '@':
3362             len -= SvCUR(cat);
3363             if (len > 0)
3364                 goto grow;
3365             len = -len;
3366             if (len > 0)
3367                 goto shrink;
3368             break;
3369         case 'X':
3370           shrink:
3371             if (SvCUR(cat) < len)
3372                 DIE("X outside of string");
3373             SvCUR(cat) -= len;
3374             *SvEND(cat) = '\0';
3375             break;
3376         case 'x':
3377           grow:
3378             while (len >= 10) {
3379                 sv_catpvn(cat, null10, 10);
3380                 len -= 10;
3381             }
3382             sv_catpvn(cat, null10, len);
3383             break;
3384         case 'A':
3385         case 'a':
3386             fromstr = NEXTFROM;
3387             aptr = SvPV(fromstr, fromlen);
3388             if (pat[-1] == '*')
3389                 len = fromlen;
3390             if (fromlen > len)
3391                 sv_catpvn(cat, aptr, len);
3392             else {
3393                 sv_catpvn(cat, aptr, fromlen);
3394                 len -= fromlen;
3395                 if (datumtype == 'A') {
3396                     while (len >= 10) {
3397                         sv_catpvn(cat, space10, 10);
3398                         len -= 10;
3399                     }
3400                     sv_catpvn(cat, space10, len);
3401                 }
3402                 else {
3403                     while (len >= 10) {
3404                         sv_catpvn(cat, null10, 10);
3405                         len -= 10;
3406                     }
3407                     sv_catpvn(cat, null10, len);
3408                 }
3409             }
3410             break;
3411         case 'B':
3412         case 'b':
3413             {
3414                 char *savepat = pat;
3415                 I32 saveitems;
3416
3417                 fromstr = NEXTFROM;
3418                 saveitems = items;
3419                 aptr = SvPV(fromstr, fromlen);
3420                 if (pat[-1] == '*')
3421                     len = fromlen;
3422                 pat = aptr;
3423                 aint = SvCUR(cat);
3424                 SvCUR(cat) += (len+7)/8;
3425                 SvGROW(cat, SvCUR(cat) + 1);
3426                 aptr = SvPVX(cat) + aint;
3427                 if (len > fromlen)
3428                     len = fromlen;
3429                 aint = len;
3430                 items = 0;
3431                 if (datumtype == 'B') {
3432                     for (len = 0; len++ < aint;) {
3433                         items |= *pat++ & 1;
3434                         if (len & 7)
3435                             items <<= 1;
3436                         else {
3437                             *aptr++ = items & 0xff;
3438                             items = 0;
3439                         }
3440                     }
3441                 }
3442                 else {
3443                     for (len = 0; len++ < aint;) {
3444                         if (*pat++ & 1)
3445                             items |= 128;
3446                         if (len & 7)
3447                             items >>= 1;
3448                         else {
3449                             *aptr++ = items & 0xff;
3450                             items = 0;
3451                         }
3452                     }
3453                 }
3454                 if (aint & 7) {
3455                     if (datumtype == 'B')
3456                         items <<= 7 - (aint & 7);
3457                     else
3458                         items >>= 7 - (aint & 7);
3459                     *aptr++ = items & 0xff;
3460                 }
3461                 pat = SvPVX(cat) + SvCUR(cat);
3462                 while (aptr <= pat)
3463                     *aptr++ = '\0';
3464
3465                 pat = savepat;
3466                 items = saveitems;
3467             }
3468             break;
3469         case 'H':
3470         case 'h':
3471             {
3472                 char *savepat = pat;
3473                 I32 saveitems;
3474
3475                 fromstr = NEXTFROM;
3476                 saveitems = items;
3477                 aptr = SvPV(fromstr, fromlen);
3478                 if (pat[-1] == '*')
3479                     len = fromlen;
3480                 pat = aptr;
3481                 aint = SvCUR(cat);
3482                 SvCUR(cat) += (len+1)/2;
3483                 SvGROW(cat, SvCUR(cat) + 1);
3484                 aptr = SvPVX(cat) + aint;
3485                 if (len > fromlen)
3486                     len = fromlen;
3487                 aint = len;
3488                 items = 0;
3489                 if (datumtype == 'H') {
3490                     for (len = 0; len++ < aint;) {
3491                         if (isALPHA(*pat))
3492                             items |= ((*pat++ & 15) + 9) & 15;
3493                         else
3494                             items |= *pat++ & 15;
3495                         if (len & 1)
3496                             items <<= 4;
3497                         else {
3498                             *aptr++ = items & 0xff;
3499                             items = 0;
3500                         }
3501                     }
3502                 }
3503                 else {
3504                     for (len = 0; len++ < aint;) {
3505                         if (isALPHA(*pat))
3506                             items |= (((*pat++ & 15) + 9) & 15) << 4;
3507                         else
3508                             items |= (*pat++ & 15) << 4;
3509                         if (len & 1)
3510                             items >>= 4;
3511                         else {
3512                             *aptr++ = items & 0xff;
3513                             items = 0;
3514                         }
3515                     }
3516                 }
3517                 if (aint & 1)
3518                     *aptr++ = items & 0xff;
3519                 pat = SvPVX(cat) + SvCUR(cat);
3520                 while (aptr <= pat)
3521                     *aptr++ = '\0';
3522
3523                 pat = savepat;
3524                 items = saveitems;
3525             }
3526             break;
3527         case 'C':
3528         case 'c':
3529             while (len-- > 0) {
3530                 fromstr = NEXTFROM;
3531                 aint = SvIV(fromstr);
3532                 achar = aint;
3533                 sv_catpvn(cat, &achar, sizeof(char));
3534             }
3535             break;
3536         /* Float and double added by gnb@melba.bby.oz.au  22/11/89 */
3537         case 'f':
3538         case 'F':
3539             while (len-- > 0) {
3540                 fromstr = NEXTFROM;
3541                 afloat = (float)SvNV(fromstr);
3542                 sv_catpvn(cat, (char *)&afloat, sizeof (float));
3543             }
3544             break;
3545         case 'd':
3546         case 'D':
3547             while (len-- > 0) {
3548                 fromstr = NEXTFROM;
3549                 adouble = (double)SvNV(fromstr);
3550                 sv_catpvn(cat, (char *)&adouble, sizeof (double));
3551             }
3552             break;
3553         case 'n':
3554             while (len-- > 0) {
3555                 fromstr = NEXTFROM;
3556                 ashort = (I16)SvIV(fromstr);
3557 #ifdef HAS_HTONS
3558                 ashort = htons(ashort);
3559 #endif
3560                 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
3561             }
3562             break;
3563         case 'v':
3564             while (len-- > 0) {
3565                 fromstr = NEXTFROM;
3566                 ashort = (I16)SvIV(fromstr);
3567 #ifdef HAS_HTOVS
3568                 ashort = htovs(ashort);
3569 #endif
3570                 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
3571             }
3572             break;
3573         case 'S':
3574         case 's':
3575             while (len-- > 0) {
3576                 fromstr = NEXTFROM;
3577                 ashort = (I16)SvIV(fromstr);
3578                 sv_catpvn(cat, (char*)&ashort, sizeof(I16));
3579             }
3580             break;
3581         case 'I':
3582             while (len-- > 0) {
3583                 fromstr = NEXTFROM;
3584                 auint = U_I(SvNV(fromstr));
3585                 sv_catpvn(cat, (char*)&auint, sizeof(unsigned int));
3586             }
3587             break;
3588         case 'w':
3589             while (len-- > 0) {
3590                 fromstr = NEXTFROM;
3591                 adouble = floor(SvNV(fromstr));
3592
3593                 if (adouble < 0)
3594                     croak("Cannot compress negative numbers");
3595
3596                 if (adouble <= UV_MAX) {
3597                     char   buf[1 + sizeof(UV)];
3598                     char  *in = buf + sizeof(buf);
3599                     UV     auv = U_V(adouble);;
3600
3601                     do {
3602                         *--in = (auv & 0x7f) | 0x80;
3603                         auv >>= 7;
3604                     } while (auv);
3605                     buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
3606                     sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
3607                 }
3608                 else if (SvPOKp(fromstr)) {  /* decimal string arithmetics */
3609                     char           *from, *result, *in;
3610                     SV             *norm;
3611                     STRLEN          len;
3612                     bool            done;
3613
3614                     /* Copy string and check for compliance */
3615                     from = SvPV(fromstr, len);
3616                     if ((norm = is_an_int(from, len)) == NULL)
3617                         croak("can compress only unsigned integer");
3618
3619                     New('w', result, len, char);
3620                     in = result + len;
3621                     done = FALSE;
3622                     while (!done)
3623                         *--in = div128(norm, &done) | 0x80;
3624                     result[len - 1] &= 0x7F; /* clear continue bit */
3625                     sv_catpvn(cat, in, (result + len) - in);
3626                     Safefree(result);
3627                     SvREFCNT_dec(norm); /* free norm */
3628                 }
3629                 else if (SvNOKp(fromstr)) {
3630                     char   buf[sizeof(double) * 2];     /* 8/7 <= 2 */
3631                     char  *in = buf + sizeof(buf);
3632
3633                     do {
3634                         double next = floor(adouble / 128);
3635                         *--in = (unsigned char)(adouble - (next * 128)) | 0x80;
3636                         if (--in < buf)  /* this cannot happen ;-) */
3637                             croak ("Cannot compress integer");
3638                         adouble = next;
3639                     } while (adouble > 0);
3640                     buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
3641                     sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
3642                 }
3643                 else
3644                     croak("Cannot compress non integer");
3645             }
3646             break;
3647         case 'i':
3648             while (len-- > 0) {
3649                 fromstr = NEXTFROM;
3650                 aint = SvIV(fromstr);
3651                 sv_catpvn(cat, (char*)&aint, sizeof(int));
3652             }
3653             break;
3654         case 'N':
3655             while (len-- > 0) {
3656                 fromstr = NEXTFROM;
3657                 aulong = U_L(SvNV(fromstr));
3658 #ifdef HAS_HTONL
3659                 aulong = htonl(aulong);
3660 #endif
3661                 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
3662             }
3663             break;
3664         case 'V':
3665             while (len-- > 0) {
3666                 fromstr = NEXTFROM;
3667                 aulong = U_L(SvNV(fromstr));
3668 #ifdef HAS_HTOVL
3669                 aulong = htovl(aulong);
3670 #endif
3671                 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
3672             }
3673             break;
3674         case 'L':
3675             while (len-- > 0) {
3676                 fromstr = NEXTFROM;
3677                 aulong = U_L(SvNV(fromstr));
3678                 sv_catpvn(cat, (char*)&aulong, sizeof(U32));
3679             }
3680             break;
3681         case 'l':
3682             while (len-- > 0) {
3683                 fromstr = NEXTFROM;
3684                 along = SvIV(fromstr);
3685                 sv_catpvn(cat, (char*)&along, sizeof(I32));
3686             }
3687             break;
3688 #ifdef HAS_QUAD
3689         case 'Q':
3690             while (len-- > 0) {
3691                 fromstr = NEXTFROM;
3692                 auquad = (unsigned Quad_t)SvIV(fromstr);
3693                 sv_catpvn(cat, (char*)&auquad, sizeof(unsigned Quad_t));
3694             }
3695             break;
3696         case 'q':
3697             while (len-- > 0) {
3698                 fromstr = NEXTFROM;
3699                 aquad = (Quad_t)SvIV(fromstr);
3700                 sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t));
3701             }
3702             break;
3703 #endif /* HAS_QUAD */
3704         case 'P':
3705             len = 1;            /* assume SV is correct length */
3706             /* FALL THROUGH */
3707         case 'p':
3708             while (len-- > 0) {
3709                 fromstr = NEXTFROM;
3710                 aptr = SvPV_force(fromstr, na); /* XXX Error if TEMP? */
3711                 sv_catpvn(cat, (char*)&aptr, sizeof(char*));
3712             }
3713             break;
3714         case 'u':
3715             fromstr = NEXTFROM;
3716             aptr = SvPV(fromstr, fromlen);
3717             SvGROW(cat, fromlen * 4 / 3);
3718             if (len <= 1)
3719                 len = 45;
3720             else
3721                 len = len / 3 * 3;
3722             while (fromlen > 0) {
3723                 I32 todo;
3724
3725                 if (fromlen > len)
3726                     todo = len;
3727                 else
3728                     todo = fromlen;
3729                 doencodes(cat, aptr, todo);
3730                 fromlen -= todo;
3731                 aptr += todo;
3732             }
3733             break;
3734         }
3735     }
3736     SvSETMAGIC(cat);
3737     SP = ORIGMARK;
3738     PUSHs(cat);
3739     RETURN;
3740 }
3741 #undef NEXTFROM
3742
3743 PP(pp_split)
3744 {
3745     dSP; dTARG;
3746     AV *ary;
3747     register I32 limit = POPi;                  /* note, negative is forever */
3748     SV *sv = POPs;
3749     STRLEN len;
3750     register char *s = SvPV(sv, len);
3751     char *strend = s + len;
3752     register PMOP *pm;
3753     register REGEXP *rx;
3754     register SV *dstr;
3755     register char *m;
3756     I32 iters = 0;
3757     I32 maxiters = (strend - s) + 10;
3758     I32 i;
3759     char *orig;
3760     I32 origlimit = limit;
3761     I32 realarray = 0;
3762     I32 base;
3763     AV *oldstack = curstack;
3764     I32 gimme = GIMME;
3765     I32 oldsave = savestack_ix;
3766
3767 #ifdef DEBUGGING
3768     Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*);
3769 #else
3770     pm = (PMOP*)POPs;
3771 #endif
3772     if (!pm || !s)
3773         DIE("panic: do_split");
3774     rx = pm->op_pmregexp;
3775
3776     TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
3777              (pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE)));
3778
3779     if (pm->op_pmreplroot)
3780         ary = GvAVn((GV*)pm->op_pmreplroot);
3781     else if (gimme != G_ARRAY)
3782         ary = GvAVn(defgv);
3783     else
3784         ary = Nullav;
3785     if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
3786         realarray = 1;
3787         if (!AvREAL(ary)) {
3788             AvREAL_on(ary);
3789             for (i = AvFILL(ary); i >= 0; i--)
3790                 AvARRAY(ary)[i] = &sv_undef;    /* don't free mere refs */
3791         }
3792         av_extend(ary,0);
3793         av_clear(ary);
3794         /* temporarily switch stacks */
3795         SWITCHSTACK(curstack, ary);
3796     }
3797     base = SP - stack_base;
3798     orig = s;
3799     if (pm->op_pmflags & PMf_SKIPWHITE) {
3800         if (pm->op_pmflags & PMf_LOCALE) {
3801             while (isSPACE_LC(*s))
3802                 s++;
3803         }
3804         else {
3805             while (isSPACE(*s))
3806                 s++;
3807         }
3808     }
3809     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
3810         SAVEINT(multiline);
3811         multiline = pm->op_pmflags & PMf_MULTILINE;
3812     }
3813
3814     if (!limit)
3815         limit = maxiters + 2;
3816     if (pm->op_pmflags & PMf_WHITE) {
3817         while (--limit) {
3818             m = s;
3819             while (m < strend &&
3820                    !((pm->op_pmflags & PMf_LOCALE)
3821                      ? isSPACE_LC(*m) : isSPACE(*m)))
3822                 ++m;
3823             if (m >= strend)
3824                 break;
3825
3826             dstr = NEWSV(30, m-s);
3827             sv_setpvn(dstr, s, m-s);
3828             if (!realarray)
3829                 sv_2mortal(dstr);
3830             XPUSHs(dstr);
3831
3832             s = m + 1;
3833             while (s < strend &&
3834                    ((pm->op_pmflags & PMf_LOCALE)
3835                     ? isSPACE_LC(*s) : isSPACE(*s)))
3836                 ++s;
3837         }
3838     }
3839     else if (strEQ("^", rx->precomp)) {
3840         while (--limit) {
3841             /*SUPPRESS 530*/
3842             for (m = s; m < strend && *m != '\n'; m++) ;
3843             m++;
3844             if (m >= strend)
3845                 break;
3846             dstr = NEWSV(30, m-s);
3847             sv_setpvn(dstr, s, m-s);
3848             if (!realarray)
3849                 sv_2mortal(dstr);
3850             XPUSHs(dstr);
3851             s = m;
3852         }
3853     }
3854     else if (pm->op_pmshort && !rx->nparens) {
3855         i = SvCUR(pm->op_pmshort);
3856         if (i == 1) {
3857             i = *SvPVX(pm->op_pmshort);
3858             while (--limit) {
3859                 /*SUPPRESS 530*/
3860                 for (m = s; m < strend && *m != i; m++) ;
3861                 if (m >= strend)
3862                     break;
3863                 dstr = NEWSV(30, m-s);
3864                 sv_setpvn(dstr, s, m-s);
3865                 if (!realarray)
3866                     sv_2mortal(dstr);
3867                 XPUSHs(dstr);
3868                 s = m + 1;
3869             }
3870         }
3871         else {
3872 #ifndef lint
3873             while (s < strend && --limit &&
3874               (m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
3875                     pm->op_pmshort)) )
3876 #endif
3877             {
3878                 dstr = NEWSV(31, m-s);
3879                 sv_setpvn(dstr, s, m-s);
3880                 if (!realarray)
3881                     sv_2mortal(dstr);
3882                 XPUSHs(dstr);
3883                 s = m + i;
3884             }
3885         }
3886     }
3887     else {
3888         maxiters += (strend - s) * rx->nparens;
3889         while (s < strend && --limit &&
3890                pregexec(rx, s, strend, orig, 1, Nullsv, TRUE))
3891         {
3892             TAINT_IF(rx->exec_tainted);
3893             if (rx->subbase
3894               && rx->subbase != orig) {
3895                 m = s;
3896                 s = orig;
3897                 orig = rx->subbase;
3898                 s = orig + (m - s);
3899                 strend = s + (strend - m);
3900             }
3901             m = rx->startp[0];
3902             dstr = NEWSV(32, m-s);
3903             sv_setpvn(dstr, s, m-s);
3904             if (!realarray)
3905                 sv_2mortal(dstr);
3906             XPUSHs(dstr);
3907             if (rx->nparens) {
3908                 for (i = 1; i <= rx->nparens; i++) {
3909                     s = rx->startp[i];
3910                     m = rx->endp[i];
3911                     if (m && s) {
3912                         dstr = NEWSV(33, m-s);
3913                         sv_setpvn(dstr, s, m-s);
3914                     }
3915                     else
3916                         dstr = NEWSV(33, 0);
3917                     if (!realarray)
3918                         sv_2mortal(dstr);
3919                     XPUSHs(dstr);
3920                 }
3921             }
3922             s = rx->endp[0];
3923         }
3924     }
3925     LEAVE_SCOPE(oldsave);
3926     iters = (SP - stack_base) - base;
3927     if (iters > maxiters)
3928         DIE("Split loop");
3929
3930     /* keep field after final delim? */
3931     if (s < strend || (iters && origlimit)) {
3932         dstr = NEWSV(34, strend-s);
3933         sv_setpvn(dstr, s, strend-s);
3934         if (!realarray)
3935             sv_2mortal(dstr);
3936         XPUSHs(dstr);
3937         iters++;
3938     }
3939     else if (!origlimit) {
3940         while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0))
3941             iters--, SP--;
3942     }
3943     if (realarray) {
3944         SWITCHSTACK(ary, oldstack);
3945         if (gimme == G_ARRAY) {
3946             EXTEND(SP, iters);
3947             Copy(AvARRAY(ary), SP + 1, iters, SV*);
3948             SP += iters;
3949             RETURN;
3950         }
3951     }
3952     else {
3953         if (gimme == G_ARRAY)
3954             RETURN;
3955     }
3956     if (iters || !pm->op_pmreplroot) {
3957         GETTARGET;
3958         PUSHi(iters);
3959         RETURN;
3960     }
3961     RETPUSHUNDEF;
3962 }
3963