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