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