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