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