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