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