pp.c

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