pp.c

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