pp.c

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