pp.c

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