pp.c

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