pp.c

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