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