pp.c

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