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