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