pp.c

   1 /*    pp.c
   2  *
   3  *    Copyright (c) 1991-1997, 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 /*
  19  * The compiler on Concurrent CX/UX systems has a subtle bug which only
  20  * seems to show up when compiling pp.c - it generates the wrong double
  21  * precision constant value for (double)UV_MAX when used inline in the body
  22  * of the code below, so this makes a static variable up front (which the
  23  * compiler seems to get correct) and uses it in place of UV_MAX below.
  24  */
  25 #ifdef CXUX_BROKEN_CONSTANT_CONVERT
  26 static double UV_MAX_cxux = ((double)UV_MAX);
  27 #endif
  28
  29 /*
  30  * Types used in bitwise operations.
  31  *
  32  * Normally we'd just use IV and UV.  However, some hardware and
  33  * software combinations (e.g. Alpha and current OSF/1) don't have a
  34  * floating-point type to use for NV that has adequate bits to fully
  35  * hold an IV/UV.  (In other words, sizeof(long) == sizeof(double).)
  36  *
  37  * It just so happens that "int" is the right size almost everywhere.
  38  */
  39 typedef int IBW;
  40 typedef unsigned UBW;
  41
  42 /*
  43  * Mask used after bitwise operations.
  44  *
  45  * There is at least one realm (Cray word machines) that doesn't
  46  * have an integral type (except char) small enough to be represented
  47  * in a double without loss; that is, it has no 32-bit type.
  48  */
  49 #if BYTEORDER > 0xFFFF && defined(_CRAY) && !defined(_CRAYMPP)
  50 #  define BW_BITS  32
  51 #  define BW_MASK  ((1 << BW_BITS) - 1)
  52 #  define BW_SIGN  (1 << (BW_BITS - 1))
  53 #  define BWi(i)  (((i) & BW_SIGN) ? ((i) | ~BW_MASK) : ((i) & BW_MASK))
  54 #  define BWu(u)  ((u) & BW_MASK)
  55 #else
  56 #  define BWi(i)  (i)
  57 #  define BWu(u)  (u)
  58 #endif
  59
  60 /*
  61  * Offset for integer pack/unpack.
  62  *
  63  * On architectures where I16 and I32 aren't really 16 and 32 bits,
  64  * which for now are all Crays, pack and unpack have to play games.
  65  */
  66
  67 /*
  68  * These values are required for portability of pack() output.
  69  * If they're not right on your machine, then pack() and unpack()
  70  * wouldn't work right anyway; you'll need to apply the Cray hack.
  71  * (I'd like to check them with #if, but you can't use sizeof() in
  72  * the preprocessor.)
  73  */
  74 #define SIZE16 2
  75 #define SIZE32 4
  76
  77 #if BYTEORDER > 0xFFFF && defined(_CRAY) && !defined(_CRAYMPP)
  78 #  if BYTEORDER == 0x12345678
  79 #    define OFF16(p)    (char*)(p)
  80 #    define OFF32(p)    (char*)(p)
  81 #  else
  82 #    if BYTEORDER == 0x87654321
  83 #      define OFF16(p)  ((char*)(p) + (sizeof(U16) - SIZE16))
  84 #      define OFF32(p)  ((char*)(p) + (sizeof(U32) - SIZE32))
  85 #    else
  86        }}}} bad cray byte order
  87 #    endif
  88 #  endif
  89 #  define COPY16(s,p)  (*(p) = 0, Copy(s, OFF16(p), SIZE16, char))
  90 #  define COPY32(s,p)  (*(p) = 0, Copy(s, OFF32(p), SIZE32, char))
  91 #  define CAT16(sv,p)  sv_catpvn(sv, OFF16(p), SIZE16)
  92 #  define CAT32(sv,p)  sv_catpvn(sv, OFF32(p), SIZE32)
  93 #else
  94 #  define COPY16(s,p)  Copy(s, p, SIZE16, char)
  95 #  define COPY32(s,p)  Copy(s, p, SIZE32, char)
  96 #  define CAT16(sv,p)  sv_catpvn(sv, (char*)(p), SIZE16)
  97 #  define CAT32(sv,p)  sv_catpvn(sv, (char*)(p), SIZE32)
  98 #endif
  99
 100 static void doencodes _((SV* sv, char* s, I32 len));
 101 static SV* refto _((SV* sv));
 102 static U32 seed _((void));
 103
 104 static bool srand_called = FALSE;
 105
 106 /* variations on pp_null */
 107
 108 PP(pp_stub)
 109 {
 110     dSP;
 111     if (GIMME_V == G_SCALAR)
 112         XPUSHs(&sv_undef);
 113     RETURN;
 114 }
 115
 116 PP(pp_scalar)
 117 {
 118     return NORMAL;
 119 }
 120
 121 /* Pushy stuff. */
 122
 123 PP(pp_padav)
 124 {
 125     dSP; dTARGET;
 126     if (op->op_private & OPpLVAL_INTRO)
 127         SAVECLEARSV(curpad[op->op_targ]);
 128     EXTEND(SP, 1);
 129     if (op->op_flags & OPf_REF) {
 130         PUSHs(TARG);
 131         RETURN;
 132     }
 133     if (GIMME == G_ARRAY) {
 134         I32 maxarg = AvFILL((AV*)TARG) + 1;
 135         EXTEND(SP, maxarg);
 136         Copy(AvARRAY((AV*)TARG), SP+1, maxarg, SV*);
 137         SP += maxarg;
 138     }
 139     else {
 140         SV* sv = sv_newmortal();
 141         I32 maxarg = AvFILL((AV*)TARG) + 1;
 142         sv_setiv(sv, maxarg);
 143         PUSHs(sv);
 144     }
 145     RETURN;
 146 }
 147
 148 PP(pp_padhv)
 149 {
 150     dSP; dTARGET;
 151     I32 gimme;
 152
 153     XPUSHs(TARG);
 154     if (op->op_private & OPpLVAL_INTRO)
 155         SAVECLEARSV(curpad[op->op_targ]);
 156     if (op->op_flags & OPf_REF)
 157         RETURN;
 158     gimme = GIMME_V;
 159     if (gimme == G_ARRAY) {
 160         RETURNOP(do_kv(ARGS));
 161     }
 162     else if (gimme == G_SCALAR) {
 163         SV* sv = sv_newmortal();
 164         if (HvFILL((HV*)TARG))
 165             sv_setpvf(sv, "%ld/%ld",
 166                       (long)HvFILL((HV*)TARG), (long)HvMAX((HV*)TARG) + 1);
 167         else
 168             sv_setiv(sv, 0);
 169         SETs(sv);
 170     }
 171     RETURN;
 172 }
 173
 174 PP(pp_padany)
 175 {
 176     DIE("NOT IMPL LINE %d",__LINE__);
 177 }
 178
 179 /* Translations. */
 180
 181 PP(pp_rv2gv)
 182 {
 183     dSP; dTOPss;
 184
 185     if (SvROK(sv)) {
 186       wasref:
 187         sv = SvRV(sv);
 188         if (SvTYPE(sv) == SVt_PVIO) {
 189             GV *gv = (GV*) sv_newmortal();
 190             gv_init(gv, 0, "", 0, 0);
 191             GvIOp(gv) = (IO *)sv;
 192             (void)SvREFCNT_inc(sv);
 193             sv = (SV*) gv;
 194         } else if (SvTYPE(sv) != SVt_PVGV)
 195             DIE("Not a GLOB reference");
 196     }
 197     else {
 198         if (SvTYPE(sv) != SVt_PVGV) {
 199             char *sym;
 200
 201             if (SvGMAGICAL(sv)) {
 202                 mg_get(sv);
 203                 if (SvROK(sv))
 204                     goto wasref;
 205             }
 206             if (!SvOK(sv)) {
 207                 if (op->op_flags & OPf_REF ||
 208                     op->op_private & HINT_STRICT_REFS)
 209                     DIE(no_usym, "a symbol");
 210                 if (dowarn)
 211                     warn(warn_uninit);
 212                 RETSETUNDEF;
 213             }
 214             sym = SvPV(sv, na);
 215             if (op->op_private & HINT_STRICT_REFS)
 216                 DIE(no_symref, sym, "a symbol");
 217             sv = (SV*)gv_fetchpv(sym, TRUE, SVt_PVGV);
 218         }
 219     }
 220     if (op->op_private & OPpLVAL_INTRO)
 221         save_gp((GV*)sv, !(op->op_flags & OPf_SPECIAL));
 222     SETs(sv);
 223     RETURN;
 224 }
 225
 226 PP(pp_rv2sv)
 227 {
 228     dSP; dTOPss;
 229
 230     if (SvROK(sv)) {
 231       wasref:
 232         sv = SvRV(sv);
 233         switch (SvTYPE(sv)) {
 234         case SVt_PVAV:
 235         case SVt_PVHV:
 236         case SVt_PVCV:
 237             DIE("Not a SCALAR reference");
 238         }
 239     }
 240     else {
 241         GV *gv = (GV*)sv;
 242         char *sym;
 243
 244         if (SvTYPE(gv) != SVt_PVGV) {
 245             if (SvGMAGICAL(sv)) {
 246                 mg_get(sv);
 247                 if (SvROK(sv))
 248                     goto wasref;
 249             }
 250             if (!SvOK(sv)) {
 251                 if (op->op_flags & OPf_REF ||
 252                     op->op_private & HINT_STRICT_REFS)
 253                     DIE(no_usym, "a SCALAR");
 254                 if (dowarn)
 255                     warn(warn_uninit);
 256                 RETSETUNDEF;
 257             }
 258             sym = SvPV(sv, na);
 259             if (op->op_private & HINT_STRICT_REFS)
 260                 DIE(no_symref, sym, "a SCALAR");
 261             gv = (GV*)gv_fetchpv(sym, TRUE, SVt_PV);
 262         }
 263         sv = GvSV(gv);
 264     }
 265     if (op->op_flags & OPf_MOD) {
 266         if (op->op_private & OPpLVAL_INTRO)
 267             sv = save_scalar((GV*)TOPs);
 268         else if (op->op_private & OPpDEREF)
 269             vivify_ref(sv, op->op_private & OPpDEREF);
 270     }
 271     SETs(sv);
 272     RETURN;
 273 }
 274
 275 PP(pp_av2arylen)
 276 {
 277     dSP;
 278     AV *av = (AV*)TOPs;
 279     SV *sv = AvARYLEN(av);
 280     if (!sv) {
 281         AvARYLEN(av) = sv = NEWSV(0,0);
 282         sv_upgrade(sv, SVt_IV);
 283         sv_magic(sv, (SV*)av, '#', Nullch, 0);
 284     }
 285     SETs(sv);
 286     RETURN;
 287 }
 288
 289 PP(pp_pos)
 290 {
 291     dSP; dTARGET; dPOPss;
 292
 293     if (op->op_flags & OPf_MOD) {
 294         if (SvTYPE(TARG) < SVt_PVLV) {
 295             sv_upgrade(TARG, SVt_PVLV);
 296             sv_magic(TARG, Nullsv, '.', Nullch, 0);
 297         }
 298
 299         LvTYPE(TARG) = '.';
 300         LvTARG(TARG) = sv;
 301         PUSHs(TARG);    /* no SvSETMAGIC */
 302         RETURN;
 303     }
 304     else {
 305         MAGIC* mg;
 306
 307         if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) {
 308             mg = mg_find(sv, 'g');
 309             if (mg && mg->mg_len >= 0) {
 310                 PUSHi(mg->mg_len + curcop->cop_arybase);
 311                 RETURN;
 312             }
 313         }
 314         RETPUSHUNDEF;
 315     }
 316 }
 317
 318 PP(pp_rv2cv)
 319 {
 320     dSP;
 321     GV *gv;
 322     HV *stash;
 323
 324     /* We usually try to add a non-existent subroutine in case of AUTOLOAD. */
 325     /* (But not in defined().) */
 326     CV *cv = sv_2cv(TOPs, &stash, &gv, !(op->op_flags & OPf_SPECIAL));
 327     if (cv) {
 328         if (CvCLONE(cv))
 329             cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
 330     }
 331     else
 332         cv = (CV*)&sv_undef;
 333     SETs((SV*)cv);
 334     RETURN;
 335 }
 336
 337 PP(pp_prototype)
 338 {
 339     dSP;
 340     CV *cv;
 341     HV *stash;
 342     GV *gv;
 343     SV *ret;
 344
 345     ret = &sv_undef;
 346     cv = sv_2cv(TOPs, &stash, &gv, FALSE);
 347     if (cv && SvPOK(cv))
 348         ret = sv_2mortal(newSVpv(SvPVX(cv), SvCUR(cv)));
 349     SETs(ret);
 350     RETURN;
 351 }
 352
 353 PP(pp_anoncode)
 354 {
 355     dSP;
 356     CV* cv = (CV*)curpad[op->op_targ];
 357     if (CvCLONE(cv))
 358         cv = (CV*)sv_2mortal((SV*)cv_clone(cv));
 359     EXTEND(SP,1);
 360     PUSHs((SV*)cv);
 361     RETURN;
 362 }
 363
 364 PP(pp_srefgen)
 365 {
 366     dSP;
 367     *SP = refto(*SP);
 368     RETURN;
 369 }
 370
 371 PP(pp_refgen)
 372 {
 373     dSP; dMARK;
 374     if (GIMME != G_ARRAY) {
 375         MARK[1] = *SP;
 376         SP = MARK + 1;
 377     }
 378     EXTEND_MORTAL(SP - MARK);
 379     while (++MARK <= SP)
 380         *MARK = refto(*MARK);
 381     RETURN;
 382 }
 383
 384 static SV*
 385 refto(sv)
 386 SV* sv;
 387 {
 388     SV* rv;
 389
 390     if (SvTYPE(sv) == SVt_PVLV && LvTYPE(sv) == 'y') {
 391         if (LvTARGLEN(sv))
 392             vivify_defelem(sv);
 393         if (!(sv = LvTARG(sv)))
 394             sv = &sv_undef;
 395     }
 396     else if (SvPADTMP(sv))
 397         sv = newSVsv(sv);
 398     else {
 399         dTHR;                   /* just for SvREFCNT_inc */
 400         SvTEMP_off(sv);
 401         (void)SvREFCNT_inc(sv);
 402     }
 403     rv = sv_newmortal();
 404     sv_upgrade(rv, SVt_RV);
 405     SvRV(rv) = sv;
 406     SvROK_on(rv);
 407     return rv;
 408 }
 409
 410 PP(pp_ref)
 411 {
 412     dSP; dTARGET;
 413     SV *sv;
 414     char *pv;
 415
 416     sv = POPs;
 417
 418     if (sv && SvGMAGICAL(sv))
 419         mg_get(sv);
 420
 421     if (!sv || !SvROK(sv))
 422         RETPUSHNO;
 423
 424     sv = SvRV(sv);
 425     pv = sv_reftype(sv,TRUE);
 426     PUSHp(pv, strlen(pv));
 427     RETURN;
 428 }
 429
 430 PP(pp_bless)
 431 {
 432     dSP;
 433     HV *stash;
 434
 435     if (MAXARG == 1)
 436         stash = curcop->cop_stash;
 437     else
 438         stash = gv_stashsv(POPs, TRUE);
 439
 440     (void)sv_bless(TOPs, stash);
 441     RETURN;
 442 }
 443
 444 PP(pp_gelem)
 445 {
 446     GV *gv;
 447     SV *sv;
 448     SV *ref;
 449     char *elem;
 450     dSP;
 451
 452     sv = POPs;
 453     elem = SvPV(sv, na);
 454     gv = (GV*)POPs;
 455     ref = Nullsv;
 456     sv = Nullsv;
 457     switch (elem ? *elem : '\0')
 458     {
 459     case 'A':
 460         if (strEQ(elem, "ARRAY"))
 461             ref = (SV*)GvAV(gv);
 462         break;
 463     case 'C':
 464         if (strEQ(elem, "CODE"))
 465             ref = (SV*)GvCVu(gv);
 466         break;
 467     case 'F':
 468         if (strEQ(elem, "FILEHANDLE")) /* XXX deprecate in 5.005 */
 469             ref = (SV*)GvIOp(gv);
 470         break;
 471     case 'G':
 472         if (strEQ(elem, "GLOB"))
 473             ref = (SV*)gv;
 474         break;
 475     case 'H':
 476         if (strEQ(elem, "HASH"))
 477             ref = (SV*)GvHV(gv);
 478         break;
 479     case 'I':
 480         if (strEQ(elem, "IO"))
 481             ref = (SV*)GvIOp(gv);
 482         break;
 483     case 'N':
 484         if (strEQ(elem, "NAME"))
 485             sv = newSVpv(GvNAME(gv), GvNAMELEN(gv));
 486         break;
 487     case 'P':
 488         if (strEQ(elem, "PACKAGE"))
 489             sv = newSVpv(HvNAME(GvSTASH(gv)), 0);
 490         break;
 491     case 'S':
 492         if (strEQ(elem, "SCALAR"))
 493             ref = GvSV(gv);
 494         break;
 495     }
 496     if (ref)
 497         sv = newRV(ref);
 498     if (sv)
 499         sv_2mortal(sv);
 500     else
 501         sv = &sv_undef;
 502     XPUSHs(sv);
 503     RETURN;
 504 }
 505
 506 /* Pattern matching */
 507
 508 PP(pp_study)
 509 {
 510     dSP; dPOPss;
 511     register unsigned char *s;
 512     register I32 pos;
 513     register I32 ch;
 514     register I32 *sfirst;
 515     register I32 *snext;
 516     STRLEN len;
 517
 518     if (sv == lastscream) {
 519         if (SvSCREAM(sv))
 520             RETPUSHYES;
 521     }
 522     else {
 523         if (lastscream) {
 524             SvSCREAM_off(lastscream);
 525             SvREFCNT_dec(lastscream);
 526         }
 527         lastscream = SvREFCNT_inc(sv);
 528     }
 529
 530     s = (unsigned char*)(SvPV(sv, len));
 531     pos = len;
 532     if (pos <= 0)
 533         RETPUSHNO;
 534     if (pos > maxscream) {
 535         if (maxscream < 0) {
 536             maxscream = pos + 80;
 537             New(301, screamfirst, 256, I32);
 538             New(302, screamnext, maxscream, I32);
 539         }
 540         else {
 541             maxscream = pos + pos / 4;
 542             Renew(screamnext, maxscream, I32);
 543         }
 544     }
 545
 546     sfirst = screamfirst;
 547     snext = screamnext;
 548
 549     if (!sfirst || !snext)
 550         DIE("do_study: out of memory");
 551
 552     for (ch = 256; ch; --ch)
 553         *sfirst++ = -1;
 554     sfirst -= 256;
 555
 556     while (--pos >= 0) {
 557         ch = s[pos];
 558         if (sfirst[ch] >= 0)
 559             snext[pos] = sfirst[ch] - pos;
 560         else
 561             snext[pos] = -pos;
 562         sfirst[ch] = pos;
 563     }
 564
 565     SvSCREAM_on(sv);
 566     sv_magic(sv, Nullsv, 'g', Nullch, 0);       /* piggyback on m//g magic */
 567     RETPUSHYES;
 568 }
 569
 570 PP(pp_trans)
 571 {
 572     dSP; dTARG;
 573     SV *sv;
 574
 575     if (op->op_flags & OPf_STACKED)
 576         sv = POPs;
 577     else {
 578         sv = GvSV(defgv);
 579         EXTEND(SP,1);
 580     }
 581     TARG = sv_newmortal();
 582     PUSHi(do_trans(sv, op));
 583     RETURN;
 584 }
 585
 586 /* Lvalue operators. */
 587
 588 PP(pp_schop)
 589 {
 590     dSP; dTARGET;
 591     do_chop(TARG, TOPs);
 592     SETTARG;
 593     RETURN;
 594 }
 595
 596 PP(pp_chop)
 597 {
 598     dSP; dMARK; dTARGET;
 599     while (SP > MARK)
 600         do_chop(TARG, POPs);
 601     PUSHTARG;
 602     RETURN;
 603 }
 604
 605 PP(pp_schomp)
 606 {
 607     dSP; dTARGET;
 608     SETi(do_chomp(TOPs));
 609     RETURN;
 610 }
 611
 612 PP(pp_chomp)
 613 {
 614     dSP; dMARK; dTARGET;
 615     register I32 count = 0;
 616
 617     while (SP > MARK)
 618         count += do_chomp(POPs);
 619     PUSHi(count);
 620     RETURN;
 621 }
 622
 623 PP(pp_defined)
 624 {
 625     dSP;
 626     register SV* sv;
 627
 628     sv = POPs;
 629     if (!sv || !SvANY(sv))
 630         RETPUSHNO;
 631     switch (SvTYPE(sv)) {
 632     case SVt_PVAV:
 633         if (AvMAX(sv) >= 0 || SvGMAGICAL(sv))
 634             RETPUSHYES;
 635         break;
 636     case SVt_PVHV:
 637         if (HvARRAY(sv) || SvGMAGICAL(sv))
 638             RETPUSHYES;
 639         break;
 640     case SVt_PVCV:
 641         if (CvROOT(sv) || CvXSUB(sv))
 642             RETPUSHYES;
 643         break;
 644     default:
 645         if (SvGMAGICAL(sv))
 646             mg_get(sv);
 647         if (SvOK(sv))
 648             RETPUSHYES;
 649     }
 650     RETPUSHNO;
 651 }
 652
 653 PP(pp_undef)
 654 {
 655     dSP;
 656     SV *sv;
 657
 658     if (!op->op_private) {
 659         EXTEND(SP, 1);
 660         RETPUSHUNDEF;
 661     }
 662
 663     sv = POPs;
 664     if (!sv)
 665         RETPUSHUNDEF;
 666
 667     if (SvTHINKFIRST(sv)) {
 668         if (SvREADONLY(sv))
 669             RETPUSHUNDEF;
 670         if (SvROK(sv))
 671             sv_unref(sv);
 672     }
 673
 674     switch (SvTYPE(sv)) {
 675     case SVt_NULL:
 676         break;
 677     case SVt_PVAV:
 678         av_undef((AV*)sv);
 679         break;
 680     case SVt_PVHV:
 681         hv_undef((HV*)sv);
 682         break;
 683     case SVt_PVCV:
 684         if (cv_const_sv((CV*)sv))
 685             warn("Constant subroutine %s undefined",
 686                  CvANON((CV*)sv) ? "(anonymous)" : GvENAME(CvGV((CV*)sv)));
 687         /* FALL THROUGH */
 688     case SVt_PVFM:
 689         { GV* gv = (GV*)SvREFCNT_inc(CvGV((CV*)sv));
 690           cv_undef((CV*)sv);
 691           CvGV((CV*)sv) = gv; }   /* let user-undef'd sub keep its identity */
 692         break;
 693     case SVt_PVGV:
 694         if (SvFAKE(sv))
 695             sv_setsv(sv, &sv_undef);
 696         break;
 697     default:
 698         if (SvTYPE(sv) >= SVt_PV && SvPVX(sv) && SvLEN(sv)) {
 699             (void)SvOOK_off(sv);
 700             Safefree(SvPVX(sv));
 701             SvPV_set(sv, Nullch);
 702             SvLEN_set(sv, 0);
 703         }
 704         (void)SvOK_off(sv);
 705         SvSETMAGIC(sv);
 706     }
 707
 708     RETPUSHUNDEF;
 709 }
 710
 711 PP(pp_predec)
 712 {
 713     dSP;
 714     if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
 715         croak(no_modify);
 716     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
 717         SvIVX(TOPs) != IV_MIN)
 718     {
 719         --SvIVX(TOPs);
 720         SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
 721     }
 722     else
 723         sv_dec(TOPs);
 724     SvSETMAGIC(TOPs);
 725     return NORMAL;
 726 }
 727
 728 PP(pp_postinc)
 729 {
 730     dSP; dTARGET;
 731     if (SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
 732         croak(no_modify);
 733     sv_setsv(TARG, TOPs);
 734     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
 735         SvIVX(TOPs) != IV_MAX)
 736     {
 737         ++SvIVX(TOPs);
 738         SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
 739     }
 740     else
 741         sv_inc(TOPs);
 742     SvSETMAGIC(TOPs);
 743     if (!SvOK(TARG))
 744         sv_setiv(TARG, 0);
 745     SETs(TARG);
 746     return NORMAL;
 747 }
 748
 749 PP(pp_postdec)
 750 {
 751     dSP; dTARGET;
 752     if(SvREADONLY(TOPs) || SvTYPE(TOPs) > SVt_PVLV)
 753         croak(no_modify);
 754     sv_setsv(TARG, TOPs);
 755     if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs) &&
 756         SvIVX(TOPs) != IV_MIN)
 757     {
 758         --SvIVX(TOPs);
 759         SvFLAGS(TOPs) &= ~(SVp_NOK|SVp_POK);
 760     }
 761     else
 762         sv_dec(TOPs);
 763     SvSETMAGIC(TOPs);
 764     SETs(TARG);
 765     return NORMAL;
 766 }
 767
 768 /* Ordinary operators. */
 769
 770 PP(pp_pow)
 771 {
 772     dSP; dATARGET; tryAMAGICbin(pow,opASSIGN);
 773     {
 774       dPOPTOPnnrl;
 775       SETn( pow( left, right) );
 776       RETURN;
 777     }
 778 }
 779
 780 PP(pp_multiply)
 781 {
 782     dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
 783     {
 784       dPOPTOPnnrl;
 785       SETn( left * right );
 786       RETURN;
 787     }
 788 }
 789
 790 PP(pp_divide)
 791 {
 792     dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
 793     {
 794       dPOPPOPnnrl;
 795       double value;
 796       if (right == 0.0)
 797         DIE("Illegal division by zero");
 798 #ifdef SLOPPYDIVIDE
 799       /* insure that 20./5. == 4. */
 800       {
 801         IV k;
 802         if ((double)I_V(left)  == left &&
 803             (double)I_V(right) == right &&
 804             (k = I_V(left)/I_V(right))*I_V(right) == I_V(left)) {
 805             value = k;
 806         } else {
 807             value = left / right;
 808         }
 809       }
 810 #else
 811       value = left / right;
 812 #endif
 813       PUSHn( value );
 814       RETURN;
 815     }
 816 }
 817
 818 PP(pp_modulo)
 819 {
 820     dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
 821     {
 822       UV left;
 823       UV right;
 824       bool left_neg;
 825       bool right_neg;
 826       UV ans;
 827
 828       if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
 829         IV i = SvIVX(POPs);
 830         right = (right_neg = (i < 0)) ? -i : i;
 831       }
 832       else {
 833         double n = POPn;
 834         right = U_V((right_neg = (n < 0)) ? -n : n);
 835       }
 836
 837       if (SvIOK(TOPs) && !SvNOK(TOPs) && !SvPOK(TOPs)) {
 838         IV i = SvIVX(POPs);
 839         left = (left_neg = (i < 0)) ? -i : i;
 840       }
 841       else {
 842         double n = POPn;
 843         left = U_V((left_neg = (n < 0)) ? -n : n);
 844       }
 845
 846       if (!right)
 847         DIE("Illegal modulus zero");
 848
 849       ans = left % right;
 850       if ((left_neg != right_neg) && ans)
 851         ans = right - ans;
 852       if (right_neg) {
 853         /* XXX may warn: unary minus operator applied to unsigned type */
 854         /* could change -foo to be (~foo)+1 instead     */
 855         if (ans <= -(UV)IV_MAX)
 856           sv_setiv(TARG, (IV) -ans);
 857         else
 858           sv_setnv(TARG, -(double)ans);
 859       }
 860       else
 861         sv_setuv(TARG, ans);
 862       PUSHTARG;
 863       RETURN;
 864     }
 865 }
 866
 867 PP(pp_repeat)
 868 {
 869   dSP; dATARGET; tryAMAGICbin(repeat,opASSIGN);
 870   {
 871     register I32 count = POPi;
 872     if (GIMME == G_ARRAY && op->op_private & OPpREPEAT_DOLIST) {
 873         dMARK;
 874         I32 items = SP - MARK;
 875         I32 max;
 876
 877         max = items * count;
 878         MEXTEND(MARK, max);
 879         if (count > 1) {
 880             while (SP > MARK) {
 881                 if (*SP)
 882                     SvTEMP_off((*SP));
 883                 SP--;
 884             }
 885             MARK++;
 886             repeatcpy((char*)(MARK + items), (char*)MARK,
 887                 items * sizeof(SV*), count - 1);
 888             SP += max;
 889         }
 890         else if (count <= 0)
 891             SP -= items;
 892     }
 893     else {      /* Note: mark already snarfed by pp_list */
 894         SV *tmpstr;
 895         STRLEN len;
 896
 897         tmpstr = POPs;
 898         if (TARG == tmpstr && SvTHINKFIRST(tmpstr)) {
 899             if (SvREADONLY(tmpstr) && curcop != &compiling)
 900                 DIE("Can't x= to readonly value");
 901             if (SvROK(tmpstr))
 902                 sv_unref(tmpstr);
 903         }
 904         SvSetSV(TARG, tmpstr);
 905         SvPV_force(TARG, len);
 906         if (count != 1) {
 907             if (count < 1)
 908                 SvCUR_set(TARG, 0);
 909             else {
 910                 SvGROW(TARG, (count * len) + 1);
 911                 repeatcpy(SvPVX(TARG) + len, SvPVX(TARG), len, count - 1);
 912                 SvCUR(TARG) *= count;
 913             }
 914             *SvEND(TARG) = '\0';
 915         }
 916         (void)SvPOK_only(TARG);
 917         PUSHTARG;
 918     }
 919     RETURN;
 920   }
 921 }
 922
 923 PP(pp_subtract)
 924 {
 925     dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
 926     {
 927       dPOPTOPnnrl_ul;
 928       SETn( left - right );
 929       RETURN;
 930     }
 931 }
 932
 933 PP(pp_left_shift)
 934 {
 935     dSP; dATARGET; tryAMAGICbin(lshift,opASSIGN);
 936     {
 937       IBW shift = POPi;
 938       if (op->op_private & HINT_INTEGER) {
 939         IBW i = TOPi;
 940         i = BWi(i) << shift;
 941         SETi(BWi(i));
 942       }
 943       else {
 944         UBW u = TOPu;
 945         u <<= shift;
 946         SETu(BWu(u));
 947       }
 948       RETURN;
 949     }
 950 }
 951
 952 PP(pp_right_shift)
 953 {
 954     dSP; dATARGET; tryAMAGICbin(rshift,opASSIGN);
 955     {
 956       IBW shift = POPi;
 957       if (op->op_private & HINT_INTEGER) {
 958         IBW i = TOPi;
 959         i = BWi(i) >> shift;
 960         SETi(BWi(i));
 961       }
 962       else {
 963         UBW u = TOPu;
 964         u >>= shift;
 965         SETu(BWu(u));
 966       }
 967       RETURN;
 968     }
 969 }
 970
 971 PP(pp_lt)
 972 {
 973     dSP; tryAMAGICbinSET(lt,0);
 974     {
 975       dPOPnv;
 976       SETs(boolSV(TOPn < value));
 977       RETURN;
 978     }
 979 }
 980
 981 PP(pp_gt)
 982 {
 983     dSP; tryAMAGICbinSET(gt,0);
 984     {
 985       dPOPnv;
 986       SETs(boolSV(TOPn > value));
 987       RETURN;
 988     }
 989 }
 990
 991 PP(pp_le)
 992 {
 993     dSP; tryAMAGICbinSET(le,0);
 994     {
 995       dPOPnv;
 996       SETs(boolSV(TOPn <= value));
 997       RETURN;
 998     }
 999 }
1000
1001 PP(pp_ge)
1002 {
1003     dSP; tryAMAGICbinSET(ge,0);
1004     {
1005       dPOPnv;
1006       SETs(boolSV(TOPn >= value));
1007       RETURN;
1008     }
1009 }
1010
1011 PP(pp_ne)
1012 {
1013     dSP; tryAMAGICbinSET(ne,0);
1014     {
1015       dPOPnv;
1016       SETs(boolSV(TOPn != value));
1017       RETURN;
1018     }
1019 }
1020
1021 PP(pp_ncmp)
1022 {
1023     dSP; dTARGET; tryAMAGICbin(ncmp,0);
1024     {
1025       dPOPTOPnnrl;
1026       I32 value;
1027
1028       if (left == right)
1029         value = 0;
1030       else if (left < right)
1031         value = -1;
1032       else if (left > right)
1033         value = 1;
1034       else {
1035         SETs(&sv_undef);
1036         RETURN;
1037       }
1038       SETi(value);
1039       RETURN;
1040     }
1041 }
1042
1043 PP(pp_slt)
1044 {
1045     dSP; tryAMAGICbinSET(slt,0);
1046     {
1047       dPOPTOPssrl;
1048       int cmp = ((op->op_private & OPpLOCALE)
1049                  ? sv_cmp_locale(left, right)
1050                  : sv_cmp(left, right));
1051       SETs(boolSV(cmp < 0));
1052       RETURN;
1053     }
1054 }
1055
1056 PP(pp_sgt)
1057 {
1058     dSP; tryAMAGICbinSET(sgt,0);
1059     {
1060       dPOPTOPssrl;
1061       int cmp = ((op->op_private & OPpLOCALE)
1062                  ? sv_cmp_locale(left, right)
1063                  : sv_cmp(left, right));
1064       SETs(boolSV(cmp > 0));
1065       RETURN;
1066     }
1067 }
1068
1069 PP(pp_sle)
1070 {
1071     dSP; tryAMAGICbinSET(sle,0);
1072     {
1073       dPOPTOPssrl;
1074       int cmp = ((op->op_private & OPpLOCALE)
1075                  ? sv_cmp_locale(left, right)
1076                  : sv_cmp(left, right));
1077       SETs(boolSV(cmp <= 0));
1078       RETURN;
1079     }
1080 }
1081
1082 PP(pp_sge)
1083 {
1084     dSP; tryAMAGICbinSET(sge,0);
1085     {
1086       dPOPTOPssrl;
1087       int cmp = ((op->op_private & OPpLOCALE)
1088                  ? sv_cmp_locale(left, right)
1089                  : sv_cmp(left, right));
1090       SETs(boolSV(cmp >= 0));
1091       RETURN;
1092     }
1093 }
1094
1095 PP(pp_seq)
1096 {
1097     dSP; tryAMAGICbinSET(seq,0);
1098     {
1099       dPOPTOPssrl;
1100       SETs(boolSV(sv_eq(left, right)));
1101       RETURN;
1102     }
1103 }
1104
1105 PP(pp_sne)
1106 {
1107     dSP; tryAMAGICbinSET(sne,0);
1108     {
1109       dPOPTOPssrl;
1110       SETs(boolSV(!sv_eq(left, right)));
1111       RETURN;
1112     }
1113 }
1114
1115 PP(pp_scmp)
1116 {
1117     dSP; dTARGET;  tryAMAGICbin(scmp,0);
1118     {
1119       dPOPTOPssrl;
1120       int cmp = ((op->op_private & OPpLOCALE)
1121                  ? sv_cmp_locale(left, right)
1122                  : sv_cmp(left, right));
1123       SETi( cmp );
1124       RETURN;
1125     }
1126 }
1127
1128 PP(pp_bit_and)
1129 {
1130     dSP; dATARGET; tryAMAGICbin(band,opASSIGN);
1131     {
1132       dPOPTOPssrl;
1133       if (SvNIOKp(left) || SvNIOKp(right)) {
1134         if (op->op_private & HINT_INTEGER) {
1135           IBW value = SvIV(left) & SvIV(right);
1136           SETi(BWi(value));
1137         }
1138         else {
1139           UBW value = SvUV(left) & SvUV(right);
1140           SETu(BWu(value));
1141         }
1142       }
1143       else {
1144         do_vop(op->op_type, TARG, left, right);
1145         SETTARG;
1146       }
1147       RETURN;
1148     }
1149 }
1150
1151 PP(pp_bit_xor)
1152 {
1153     dSP; dATARGET; tryAMAGICbin(bxor,opASSIGN);
1154     {
1155       dPOPTOPssrl;
1156       if (SvNIOKp(left) || SvNIOKp(right)) {
1157         if (op->op_private & HINT_INTEGER) {
1158           IBW value = (USE_LEFT(left) ? SvIV(left) : 0) ^ SvIV(right);
1159           SETi(BWi(value));
1160         }
1161         else {
1162           UBW value = (USE_LEFT(left) ? SvUV(left) : 0) ^ SvUV(right);
1163           SETu(BWu(value));
1164         }
1165       }
1166       else {
1167         do_vop(op->op_type, TARG, left, right);
1168         SETTARG;
1169       }
1170       RETURN;
1171     }
1172 }
1173
1174 PP(pp_bit_or)
1175 {
1176     dSP; dATARGET; tryAMAGICbin(bor,opASSIGN);
1177     {
1178       dPOPTOPssrl;
1179       if (SvNIOKp(left) || SvNIOKp(right)) {
1180         if (op->op_private & HINT_INTEGER) {
1181           IBW value = (USE_LEFT(left) ? SvIV(left) : 0) | SvIV(right);
1182           SETi(BWi(value));
1183         }
1184         else {
1185           UBW value = (USE_LEFT(left) ? SvUV(left) : 0) | SvUV(right);
1186           SETu(BWu(value));
1187         }
1188       }
1189       else {
1190         do_vop(op->op_type, TARG, left, right);
1191         SETTARG;
1192       }
1193       RETURN;
1194     }
1195 }
1196
1197 PP(pp_negate)
1198 {
1199     dSP; dTARGET; tryAMAGICun(neg);
1200     {
1201         dTOPss;
1202         if (SvGMAGICAL(sv))
1203             mg_get(sv);
1204         if (SvIOKp(sv) && !SvNOKp(sv) && !SvPOKp(sv) && SvIVX(sv) != IV_MIN)
1205             SETi(-SvIVX(sv));
1206         else if (SvNIOKp(sv))
1207             SETn(-SvNV(sv));
1208         else if (SvPOKp(sv)) {
1209             STRLEN len;
1210             char *s = SvPV(sv, len);
1211             if (isIDFIRST(*s)) {
1212                 sv_setpvn(TARG, "-", 1);
1213                 sv_catsv(TARG, sv);
1214             }
1215             else if (*s == '+' || *s == '-') {
1216                 sv_setsv(TARG, sv);
1217                 *SvPV_force(TARG, len) = *s == '-' ? '+' : '-';
1218             }
1219             else
1220                 sv_setnv(TARG, -SvNV(sv));
1221             SETTARG;
1222         }
1223         else
1224             SETn(-SvNV(sv));
1225     }
1226     RETURN;
1227 }
1228
1229 PP(pp_not)
1230 {
1231 #ifdef OVERLOAD
1232     dSP; tryAMAGICunSET(not);
1233 #endif /* OVERLOAD */
1234     *stack_sp = boolSV(!SvTRUE(*stack_sp));
1235     return NORMAL;
1236 }
1237
1238 PP(pp_complement)
1239 {
1240     dSP; dTARGET; tryAMAGICun(compl);
1241     {
1242       dTOPss;
1243       if (SvNIOKp(sv)) {
1244         if (op->op_private & HINT_INTEGER) {
1245           IBW value = ~SvIV(sv);
1246           SETi(BWi(value));
1247         }
1248         else {
1249           UBW value = ~SvUV(sv);
1250           SETu(BWu(value));
1251         }
1252       }
1253       else {
1254         register char *tmps;
1255         register long *tmpl;
1256         register I32 anum;
1257         STRLEN len;
1258
1259         SvSetSV(TARG, sv);
1260         tmps = SvPV_force(TARG, len);
1261         anum = len;
1262 #ifdef LIBERAL
1263         for ( ; anum && (unsigned long)tmps % sizeof(long); anum--, tmps++)
1264             *tmps = ~*tmps;
1265         tmpl = (long*)tmps;
1266         for ( ; anum >= sizeof(long); anum -= sizeof(long), tmpl++)
1267             *tmpl = ~*tmpl;
1268         tmps = (char*)tmpl;
1269 #endif
1270         for ( ; anum > 0; anum--, tmps++)
1271             *tmps = ~*tmps;
1272
1273         SETs(TARG);
1274       }
1275       RETURN;
1276     }
1277 }
1278
1279 /* integer versions of some of the above */
1280
1281 PP(pp_i_multiply)
1282 {
1283     dSP; dATARGET; tryAMAGICbin(mult,opASSIGN);
1284     {
1285       dPOPTOPiirl;
1286       SETi( left * right );
1287       RETURN;
1288     }
1289 }
1290
1291 PP(pp_i_divide)
1292 {
1293     dSP; dATARGET; tryAMAGICbin(div,opASSIGN);
1294     {
1295       dPOPiv;
1296       if (value == 0)
1297         DIE("Illegal division by zero");
1298       value = POPi / value;
1299       PUSHi( value );
1300       RETURN;
1301     }
1302 }
1303
1304 PP(pp_i_modulo)
1305 {
1306     dSP; dATARGET; tryAMAGICbin(mod,opASSIGN);
1307     {
1308       dPOPTOPiirl;
1309       if (!right)
1310         DIE("Illegal modulus zero");
1311       SETi( left % right );
1312       RETURN;
1313     }
1314 }
1315
1316 PP(pp_i_add)
1317 {
1318     dSP; dATARGET; tryAMAGICbin(add,opASSIGN);
1319     {
1320       dPOPTOPiirl;
1321       SETi( left + right );
1322       RETURN;
1323     }
1324 }
1325
1326 PP(pp_i_subtract)
1327 {
1328     dSP; dATARGET; tryAMAGICbin(subtr,opASSIGN);
1329     {
1330       dPOPTOPiirl;
1331       SETi( left - right );
1332       RETURN;
1333     }
1334 }
1335
1336 PP(pp_i_lt)
1337 {
1338     dSP; tryAMAGICbinSET(lt,0);
1339     {
1340       dPOPTOPiirl;
1341       SETs(boolSV(left < right));
1342       RETURN;
1343     }
1344 }
1345
1346 PP(pp_i_gt)
1347 {
1348     dSP; tryAMAGICbinSET(gt,0);
1349     {
1350       dPOPTOPiirl;
1351       SETs(boolSV(left > right));
1352       RETURN;
1353     }
1354 }
1355
1356 PP(pp_i_le)
1357 {
1358     dSP; tryAMAGICbinSET(le,0);
1359     {
1360       dPOPTOPiirl;
1361       SETs(boolSV(left <= right));
1362       RETURN;
1363     }
1364 }
1365
1366 PP(pp_i_ge)
1367 {
1368     dSP; tryAMAGICbinSET(ge,0);
1369     {
1370       dPOPTOPiirl;
1371       SETs(boolSV(left >= right));
1372       RETURN;
1373     }
1374 }
1375
1376 PP(pp_i_eq)
1377 {
1378     dSP; tryAMAGICbinSET(eq,0);
1379     {
1380       dPOPTOPiirl;
1381       SETs(boolSV(left == right));
1382       RETURN;
1383     }
1384 }
1385
1386 PP(pp_i_ne)
1387 {
1388     dSP; tryAMAGICbinSET(ne,0);
1389     {
1390       dPOPTOPiirl;
1391       SETs(boolSV(left != right));
1392       RETURN;
1393     }
1394 }
1395
1396 PP(pp_i_ncmp)
1397 {
1398     dSP; dTARGET; tryAMAGICbin(ncmp,0);
1399     {
1400       dPOPTOPiirl;
1401       I32 value;
1402
1403       if (left > right)
1404         value = 1;
1405       else if (left < right)
1406         value = -1;
1407       else
1408         value = 0;
1409       SETi(value);
1410       RETURN;
1411     }
1412 }
1413
1414 PP(pp_i_negate)
1415 {
1416     dSP; dTARGET; tryAMAGICun(neg);
1417     SETi(-TOPi);
1418     RETURN;
1419 }
1420
1421 /* High falutin' math. */
1422
1423 PP(pp_atan2)
1424 {
1425     dSP; dTARGET; tryAMAGICbin(atan2,0);
1426     {
1427       dPOPTOPnnrl;
1428       SETn(atan2(left, right));
1429       RETURN;
1430     }
1431 }
1432
1433 PP(pp_sin)
1434 {
1435     dSP; dTARGET; tryAMAGICun(sin);
1436     {
1437       double value;
1438       value = POPn;
1439       value = sin(value);
1440       XPUSHn(value);
1441       RETURN;
1442     }
1443 }
1444
1445 PP(pp_cos)
1446 {
1447     dSP; dTARGET; tryAMAGICun(cos);
1448     {
1449       double value;
1450       value = POPn;
1451       value = cos(value);
1452       XPUSHn(value);
1453       RETURN;
1454     }
1455 }
1456
1457 PP(pp_rand)
1458 {
1459     dSP; dTARGET;
1460     double value;
1461     if (MAXARG < 1)
1462         value = 1.0;
1463     else
1464         value = POPn;
1465     if (value == 0.0)
1466         value = 1.0;
1467     if (!srand_called) {
1468         (void)srand((unsigned)seed());
1469         srand_called = TRUE;
1470     }
1471 #if RANDBITS == 31
1472     value = rand() * value / 2147483648.0;
1473 #else
1474 #if RANDBITS == 16
1475     value = rand() * value / 65536.0;
1476 #else
1477 #if RANDBITS == 15
1478     value = rand() * value / 32768.0;
1479 #else
1480     value = rand() * value / (double)(((unsigned long)1) << RANDBITS);
1481 #endif
1482 #endif
1483 #endif
1484     XPUSHn(value);
1485     RETURN;
1486 }
1487
1488 PP(pp_srand)
1489 {
1490     dSP;
1491     UV anum;
1492     if (MAXARG < 1)
1493         anum = seed();
1494     else
1495         anum = POPu;
1496     (void)srand((unsigned)anum);
1497     srand_called = TRUE;
1498     EXTEND(SP, 1);
1499     RETPUSHYES;
1500 }
1501
1502 static U32
1503 seed()
1504 {
1505     /*
1506      * This is really just a quick hack which grabs various garbage
1507      * values.  It really should be a real hash algorithm which
1508      * spreads the effect of every input bit onto every output bit,
1509      * if someone who knows about such tings would bother to write it.
1510      * Might be a good idea to add that function to CORE as well.
1511      * No numbers below come from careful analysis or anyting here,
1512      * except they are primes and SEED_C1 > 1E6 to get a full-width
1513      * value from (tv_sec * SEED_C1 + tv_usec).  The multipliers should
1514      * probably be bigger too.
1515      */
1516 #if RANDBITS > 16
1517 #  define SEED_C1       1000003
1518 #define   SEED_C4       73819
1519 #else
1520 #  define SEED_C1       25747
1521 #define   SEED_C4       20639
1522 #endif
1523 #define   SEED_C2       3
1524 #define   SEED_C3       269
1525 #define   SEED_C5       26107
1526
1527     dTHR;
1528     U32 u;
1529 #ifdef VMS
1530 #  include <starlet.h>
1531     /* when[] = (low 32 bits, high 32 bits) of time since epoch
1532      * in 100-ns units, typically incremented ever 10 ms.        */
1533     unsigned int when[2];
1534     _ckvmssts(sys$gettim(when));
1535     u = (U32)SEED_C1 * when[0] + (U32)SEED_C2 * when[1];
1536 #else
1537 #  ifdef HAS_GETTIMEOFDAY
1538     struct timeval when;
1539     gettimeofday(&when,(struct timezone *) 0);
1540     u = (U32)SEED_C1 * when.tv_sec + (U32)SEED_C2 * when.tv_usec;
1541 #  else
1542     Time_t when;
1543     (void)time(&when);
1544     u = (U32)SEED_C1 * when;
1545 #  endif
1546 #endif
1547     u += SEED_C3 * (U32)getpid();
1548     u += SEED_C4 * (U32)(UV)stack_sp;
1549 #ifndef PLAN9           /* XXX Plan9 assembler chokes on this; fix needed  */
1550     u += SEED_C5 * (U32)(UV)&when;
1551 #endif
1552     return u;
1553 }
1554
1555 PP(pp_exp)
1556 {
1557     dSP; dTARGET; tryAMAGICun(exp);
1558     {
1559       double value;
1560       value = POPn;
1561       value = exp(value);
1562       XPUSHn(value);
1563       RETURN;
1564     }
1565 }
1566
1567 PP(pp_log)
1568 {
1569     dSP; dTARGET; tryAMAGICun(log);
1570     {
1571       double value;
1572       value = POPn;
1573       if (value <= 0.0) {
1574         SET_NUMERIC_STANDARD();
1575         DIE("Can't take log of %g", value);
1576       }
1577       value = log(value);
1578       XPUSHn(value);
1579       RETURN;
1580     }
1581 }
1582
1583 PP(pp_sqrt)
1584 {
1585     dSP; dTARGET; tryAMAGICun(sqrt);
1586     {
1587       double value;
1588       value = POPn;
1589       if (value < 0.0) {
1590         SET_NUMERIC_STANDARD();
1591         DIE("Can't take sqrt of %g", value);
1592       }
1593       value = sqrt(value);
1594       XPUSHn(value);
1595       RETURN;
1596     }
1597 }
1598
1599 PP(pp_int)
1600 {
1601     dSP; dTARGET;
1602     {
1603       double value = TOPn;
1604       IV iv;
1605
1606       if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs)) {
1607         iv = SvIVX(TOPs);
1608         SETi(iv);
1609       }
1610       else {
1611         if (value >= 0.0)
1612           (void)modf(value, &value);
1613         else {
1614           (void)modf(-value, &value);
1615           value = -value;
1616         }
1617         iv = I_V(value);
1618         if (iv == value)
1619           SETi(iv);
1620         else
1621           SETn(value);
1622       }
1623     }
1624     RETURN;
1625 }
1626
1627 PP(pp_abs)
1628 {
1629     dSP; dTARGET; tryAMAGICun(abs);
1630     {
1631       double value = TOPn;
1632       IV iv;
1633
1634       if (SvIOKp(TOPs) && !SvNOKp(TOPs) && !SvPOKp(TOPs) &&
1635           (iv = SvIVX(TOPs)) != IV_MIN) {
1636         if (iv < 0)
1637           iv = -iv;
1638         SETi(iv);
1639       }
1640       else {
1641         if (value < 0.0)
1642             value = -value;
1643         SETn(value);
1644       }
1645     }
1646     RETURN;
1647 }
1648
1649 PP(pp_hex)
1650 {
1651     dSP; dTARGET;
1652     char *tmps;
1653     I32 argtype;
1654
1655     tmps = POPp;
1656     XPUSHu(scan_hex(tmps, 99, &argtype));
1657     RETURN;
1658 }
1659
1660 PP(pp_oct)
1661 {
1662     dSP; dTARGET;
1663     UV value;
1664     I32 argtype;
1665     char *tmps;
1666
1667     tmps = POPp;
1668     while (*tmps && isSPACE(*tmps))
1669         tmps++;
1670     if (*tmps == '0')
1671         tmps++;
1672     if (*tmps == 'x')
1673         value = scan_hex(++tmps, 99, &argtype);
1674     else
1675         value = scan_oct(tmps, 99, &argtype);
1676     XPUSHu(value);
1677     RETURN;
1678 }
1679
1680 /* String stuff. */
1681
1682 PP(pp_length)
1683 {
1684     dSP; dTARGET;
1685     SETi( sv_len(TOPs) );
1686     RETURN;
1687 }
1688
1689 PP(pp_substr)
1690 {
1691     dSP; dTARGET;
1692     SV *sv;
1693     I32 len;
1694     STRLEN curlen;
1695     I32 pos;
1696     I32 rem;
1697     I32 fail;
1698     I32 lvalue = op->op_flags & OPf_MOD;
1699     char *tmps;
1700     I32 arybase = curcop->cop_arybase;
1701
1702     if (MAXARG > 2)
1703         len = POPi;
1704     pos = POPi;
1705     sv = POPs;
1706     tmps = SvPV(sv, curlen);
1707     if (pos >= arybase) {
1708         pos -= arybase;
1709         rem = curlen-pos;
1710         fail = rem;
1711         if (MAXARG > 2) {
1712             if (len < 0) {
1713                 rem += len;
1714                 if (rem < 0)
1715                     rem = 0;
1716             }
1717             else if (rem > len)
1718                      rem = len;
1719         }
1720     }
1721     else {
1722         pos += curlen;
1723         if (MAXARG < 3)
1724             rem = curlen;
1725         else if (len >= 0) {
1726             rem = pos+len;
1727             if (rem > (I32)curlen)
1728                 rem = curlen;
1729         }
1730         else {
1731             rem = curlen+len;
1732             if (rem < pos)
1733                 rem = pos;
1734         }
1735         if (pos < 0)
1736             pos = 0;
1737         fail = rem;
1738         rem -= pos;
1739     }
1740     if (fail < 0) {
1741         if (dowarn || lvalue)
1742             warn("substr outside of string");
1743         RETPUSHUNDEF;
1744     }
1745     else {
1746         tmps += pos;
1747         sv_setpvn(TARG, tmps, rem);
1748         if (lvalue) {                   /* it's an lvalue! */
1749             if (!SvGMAGICAL(sv)) {
1750                 if (SvROK(sv)) {
1751                     SvPV_force(sv,na);
1752                     if (dowarn)
1753                         warn("Attempt to use reference as lvalue in substr");
1754                 }
1755                 if (SvOK(sv))           /* is it defined ? */
1756                     (void)SvPOK_only(sv);
1757                 else
1758                     sv_setpvn(sv,"",0); /* avoid lexical reincarnation */
1759             }
1760
1761             if (SvTYPE(TARG) < SVt_PVLV) {
1762                 sv_upgrade(TARG, SVt_PVLV);
1763                 sv_magic(TARG, Nullsv, 'x', Nullch, 0);
1764             }
1765
1766             LvTYPE(TARG) = 'x';
1767             LvTARG(TARG) = sv;
1768             LvTARGOFF(TARG) = pos;
1769             LvTARGLEN(TARG) = rem;
1770         }
1771     }
1772     PUSHs(TARG);                /* avoid SvSETMAGIC here */
1773     RETURN;
1774 }
1775
1776 PP(pp_vec)
1777 {
1778     dSP; dTARGET;
1779     register I32 size = POPi;
1780     register I32 offset = POPi;
1781     register SV *src = POPs;
1782     I32 lvalue = op->op_flags & OPf_MOD;
1783     STRLEN srclen;
1784     unsigned char *s = (unsigned char*)SvPV(src, srclen);
1785     unsigned long retnum;
1786     I32 len;
1787
1788     offset *= size;             /* turn into bit offset */
1789     len = (offset + size + 7) / 8;
1790     if (offset < 0 || size < 1)
1791         retnum = 0;
1792     else {
1793         if (lvalue) {                      /* it's an lvalue! */
1794             if (SvTYPE(TARG) < SVt_PVLV) {
1795                 sv_upgrade(TARG, SVt_PVLV);
1796                 sv_magic(TARG, Nullsv, 'v', Nullch, 0);
1797             }
1798
1799             LvTYPE(TARG) = 'v';
1800             LvTARG(TARG) = src;
1801             LvTARGOFF(TARG) = offset;
1802             LvTARGLEN(TARG) = size;
1803         }
1804         if (len > srclen) {
1805             if (size <= 8)
1806                 retnum = 0;
1807             else {
1808                 offset >>= 3;
1809                 if (size == 16) {
1810                     if (offset >= srclen)
1811                         retnum = 0;
1812                     else
1813                         retnum = (unsigned long) s[offset] << 8;
1814                 }
1815                 else if (size == 32) {
1816                     if (offset >= srclen)
1817                         retnum = 0;
1818                     else if (offset + 1 >= srclen)
1819                         retnum = (unsigned long) s[offset] << 24;
1820                     else if (offset + 2 >= srclen)
1821                         retnum = ((unsigned long) s[offset] << 24) +
1822                             ((unsigned long) s[offset + 1] << 16);
1823                     else
1824                         retnum = ((unsigned long) s[offset] << 24) +
1825                             ((unsigned long) s[offset + 1] << 16) +
1826                             (s[offset + 2] << 8);
1827                 }
1828             }
1829         }
1830         else if (size < 8)
1831             retnum = (s[offset >> 3] >> (offset & 7)) & ((1 << size) - 1);
1832         else {
1833             offset >>= 3;
1834             if (size == 8)
1835                 retnum = s[offset];
1836             else if (size == 16)
1837                 retnum = ((unsigned long) s[offset] << 8) + s[offset+1];
1838             else if (size == 32)
1839                 retnum = ((unsigned long) s[offset] << 24) +
1840                         ((unsigned long) s[offset + 1] << 16) +
1841                         (s[offset + 2] << 8) + s[offset+3];
1842         }
1843     }
1844
1845     sv_setiv(TARG, (IV)retnum);
1846     PUSHs(TARG);
1847     RETURN;
1848 }
1849
1850 PP(pp_index)
1851 {
1852     dSP; dTARGET;
1853     SV *big;
1854     SV *little;
1855     I32 offset;
1856     I32 retval;
1857     char *tmps;
1858     char *tmps2;
1859     STRLEN biglen;
1860     I32 arybase = curcop->cop_arybase;
1861
1862     if (MAXARG < 3)
1863         offset = 0;
1864     else
1865         offset = POPi - arybase;
1866     little = POPs;
1867     big = POPs;
1868     tmps = SvPV(big, biglen);
1869     if (offset < 0)
1870         offset = 0;
1871     else if (offset > biglen)
1872         offset = biglen;
1873     if (!(tmps2 = fbm_instr((unsigned char*)tmps + offset,
1874       (unsigned char*)tmps + biglen, little)))
1875         retval = -1 + arybase;
1876     else
1877         retval = tmps2 - tmps + arybase;
1878     PUSHi(retval);
1879     RETURN;
1880 }
1881
1882 PP(pp_rindex)
1883 {
1884     dSP; dTARGET;
1885     SV *big;
1886     SV *little;
1887     STRLEN blen;
1888     STRLEN llen;
1889     SV *offstr;
1890     I32 offset;
1891     I32 retval;
1892     char *tmps;
1893     char *tmps2;
1894     I32 arybase = curcop->cop_arybase;
1895
1896     if (MAXARG >= 3)
1897         offstr = POPs;
1898     little = POPs;
1899     big = POPs;
1900     tmps2 = SvPV(little, llen);
1901     tmps = SvPV(big, blen);
1902     if (MAXARG < 3)
1903         offset = blen;
1904     else
1905         offset = SvIV(offstr) - arybase + llen;
1906     if (offset < 0)
1907         offset = 0;
1908     else if (offset > blen)
1909         offset = blen;
1910     if (!(tmps2 = rninstr(tmps,  tmps  + offset,
1911                           tmps2, tmps2 + llen)))
1912         retval = -1 + arybase;
1913     else
1914         retval = tmps2 - tmps + arybase;
1915     PUSHi(retval);
1916     RETURN;
1917 }
1918
1919 PP(pp_sprintf)
1920 {
1921     dSP; dMARK; dORIGMARK; dTARGET;
1922 #ifdef USE_LOCALE_NUMERIC
1923     if (op->op_private & OPpLOCALE)
1924         SET_NUMERIC_LOCAL();
1925     else
1926         SET_NUMERIC_STANDARD();
1927 #endif
1928     do_sprintf(TARG, SP-MARK, MARK+1);
1929     TAINT_IF(SvTAINTED(TARG));
1930     SP = ORIGMARK;
1931     PUSHTARG;
1932     RETURN;
1933 }
1934
1935 PP(pp_ord)
1936 {
1937     dSP; dTARGET;
1938     I32 value;
1939     char *tmps;
1940
1941 #ifndef I286
1942     tmps = POPp;
1943     value = (I32) (*tmps & 255);
1944 #else
1945     I32 anum;
1946     tmps = POPp;
1947     anum = (I32) *tmps;
1948     value = (I32) (anum & 255);
1949 #endif
1950     XPUSHi(value);
1951     RETURN;
1952 }
1953
1954 PP(pp_chr)
1955 {
1956     dSP; dTARGET;
1957     char *tmps;
1958
1959     (void)SvUPGRADE(TARG,SVt_PV);
1960     SvGROW(TARG,2);
1961     SvCUR_set(TARG, 1);
1962     tmps = SvPVX(TARG);
1963     *tmps++ = POPi;
1964     *tmps = '\0';
1965     (void)SvPOK_only(TARG);
1966     XPUSHs(TARG);
1967     RETURN;
1968 }
1969
1970 PP(pp_crypt)
1971 {
1972     dSP; dTARGET; dPOPTOPssrl;
1973 #ifdef HAS_CRYPT
1974     char *tmps = SvPV(left, na);
1975 #ifdef FCRYPT
1976     sv_setpv(TARG, fcrypt(tmps, SvPV(right, na)));
1977 #else
1978     sv_setpv(TARG, crypt(tmps, SvPV(right, na)));
1979 #endif
1980 #else
1981     DIE(
1982       "The crypt() function is unimplemented due to excessive paranoia.");
1983 #endif
1984     SETs(TARG);
1985     RETURN;
1986 }
1987
1988 PP(pp_ucfirst)
1989 {
1990     dSP;
1991     SV *sv = TOPs;
1992     register char *s;
1993
1994     if (!SvPADTMP(sv)) {
1995         dTARGET;
1996         sv_setsv(TARG, sv);
1997         sv = TARG;
1998         SETs(sv);
1999     }
2000     s = SvPV_force(sv, na);
2001     if (*s) {
2002         if (op->op_private & OPpLOCALE) {
2003             TAINT;
2004             SvTAINTED_on(sv);
2005             *s = toUPPER_LC(*s);
2006         }
2007         else
2008             *s = toUPPER(*s);
2009     }
2010
2011     RETURN;
2012 }
2013
2014 PP(pp_lcfirst)
2015 {
2016     dSP;
2017     SV *sv = TOPs;
2018     register char *s;
2019
2020     if (!SvPADTMP(sv)) {
2021         dTARGET;
2022         sv_setsv(TARG, sv);
2023         sv = TARG;
2024         SETs(sv);
2025     }
2026     s = SvPV_force(sv, na);
2027     if (*s) {
2028         if (op->op_private & OPpLOCALE) {
2029             TAINT;
2030             SvTAINTED_on(sv);
2031             *s = toLOWER_LC(*s);
2032         }
2033         else
2034             *s = toLOWER(*s);
2035     }
2036
2037     SETs(sv);
2038     RETURN;
2039 }
2040
2041 PP(pp_uc)
2042 {
2043     dSP;
2044     SV *sv = TOPs;
2045     register char *s;
2046     STRLEN len;
2047
2048     if (!SvPADTMP(sv)) {
2049         dTARGET;
2050         sv_setsv(TARG, sv);
2051         sv = TARG;
2052         SETs(sv);
2053     }
2054
2055     s = SvPV_force(sv, len);
2056     if (len) {
2057         register char *send = s + len;
2058
2059         if (op->op_private & OPpLOCALE) {
2060             TAINT;
2061             SvTAINTED_on(sv);
2062             for (; s < send; s++)
2063                 *s = toUPPER_LC(*s);
2064         }
2065         else {
2066             for (; s < send; s++)
2067                 *s = toUPPER(*s);
2068         }
2069     }
2070     RETURN;
2071 }
2072
2073 PP(pp_lc)
2074 {
2075     dSP;
2076     SV *sv = TOPs;
2077     register char *s;
2078     STRLEN len;
2079
2080     if (!SvPADTMP(sv)) {
2081         dTARGET;
2082         sv_setsv(TARG, sv);
2083         sv = TARG;
2084         SETs(sv);
2085     }
2086
2087     s = SvPV_force(sv, len);
2088     if (len) {
2089         register char *send = s + len;
2090
2091         if (op->op_private & OPpLOCALE) {
2092             TAINT;
2093             SvTAINTED_on(sv);
2094             for (; s < send; s++)
2095                 *s = toLOWER_LC(*s);
2096         }
2097         else {
2098             for (; s < send; s++)
2099                 *s = toLOWER(*s);
2100         }
2101     }
2102     RETURN;
2103 }
2104
2105 PP(pp_quotemeta)
2106 {
2107     dSP; dTARGET;
2108     SV *sv = TOPs;
2109     STRLEN len;
2110     register char *s = SvPV(sv,len);
2111     register char *d;
2112
2113     if (len) {
2114         (void)SvUPGRADE(TARG, SVt_PV);
2115         SvGROW(TARG, (len * 2) + 1);
2116         d = SvPVX(TARG);
2117         while (len--) {
2118             if (!isALNUM(*s))
2119                 *d++ = '\\';
2120             *d++ = *s++;
2121         }
2122         *d = '\0';
2123         SvCUR_set(TARG, d - SvPVX(TARG));
2124         (void)SvPOK_only(TARG);
2125     }
2126     else
2127         sv_setpvn(TARG, s, len);
2128     SETs(TARG);
2129     RETURN;
2130 }
2131
2132 /* Arrays. */
2133
2134 PP(pp_aslice)
2135 {
2136     dSP; dMARK; dORIGMARK;
2137     register SV** svp;
2138     register AV* av = (AV*)POPs;
2139     register I32 lval = op->op_flags & OPf_MOD;
2140     I32 arybase = curcop->cop_arybase;
2141     I32 elem;
2142
2143     if (SvTYPE(av) == SVt_PVAV) {
2144         if (lval && op->op_private & OPpLVAL_INTRO) {
2145             I32 max = -1;
2146             for (svp = mark + 1; svp <= sp; svp++) {
2147                 elem = SvIVx(*svp);
2148                 if (elem > max)
2149                     max = elem;
2150             }
2151             if (max > AvMAX(av))
2152                 av_extend(av, max);
2153         }
2154         while (++MARK <= SP) {
2155             elem = SvIVx(*MARK);
2156
2157             if (elem > 0)
2158                 elem -= arybase;
2159             svp = av_fetch(av, elem, lval);
2160             if (lval) {
2161                 if (!svp || *svp == &sv_undef)
2162                     DIE(no_aelem, elem);
2163                 if (op->op_private & OPpLVAL_INTRO)
2164                     save_svref(svp);
2165             }
2166             *MARK = svp ? *svp : &sv_undef;
2167         }
2168     }
2169     if (GIMME != G_ARRAY) {
2170         MARK = ORIGMARK;
2171         *++MARK = *SP;
2172         SP = MARK;
2173     }
2174     RETURN;
2175 }
2176
2177 /* Associative arrays. */
2178
2179 PP(pp_each)
2180 {
2181     dSP; dTARGET;
2182     HV *hash = (HV*)POPs;
2183     HE *entry;
2184     I32 gimme = GIMME_V;
2185     I32 realhv = (SvTYPE(hash) == SVt_PVHV);
2186
2187     PUTBACK;
2188     /* might clobber stack_sp */
2189     entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash);
2190     SPAGAIN;
2191
2192     EXTEND(SP, 2);
2193     if (entry) {
2194         PUSHs(hv_iterkeysv(entry));     /* won't clobber stack_sp */
2195         if (gimme == G_ARRAY) {
2196             PUTBACK;
2197             /* might clobber stack_sp */
2198             sv_setsv(TARG, realhv ?
2199                      hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry));
2200             SPAGAIN;
2201             PUSHs(TARG);
2202         }
2203     }
2204     else if (gimme == G_SCALAR)
2205         RETPUSHUNDEF;
2206
2207     RETURN;
2208 }
2209
2210 PP(pp_values)
2211 {
2212     return do_kv(ARGS);
2213 }
2214
2215 PP(pp_keys)
2216 {
2217     return do_kv(ARGS);
2218 }
2219
2220 PP(pp_delete)
2221 {
2222     dSP;
2223     I32 gimme = GIMME_V;
2224     I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
2225     SV *sv;
2226     HV *hv;
2227
2228     if (op->op_private & OPpSLICE) {
2229         dMARK; dORIGMARK;
2230         U32 hvtype;
2231         hv = (HV*)POPs;
2232         hvtype = SvTYPE(hv);
2233         while (++MARK <= SP) {
2234             if (hvtype == SVt_PVHV)
2235                 sv = hv_delete_ent(hv, *MARK, discard, 0);
2236             else if (hvtype == SVt_PVAV)
2237                 sv = avhv_delete_ent((AV*)hv, *MARK, discard, 0);
2238             else
2239                 DIE("Not a HASH reference");
2240             *MARK = sv ? sv : &sv_undef;
2241         }
2242         if (discard)
2243             SP = ORIGMARK;
2244         else if (gimme == G_SCALAR) {
2245             MARK = ORIGMARK;
2246             *++MARK = *SP;
2247             SP = MARK;
2248         }
2249     }
2250     else {
2251         SV *keysv = POPs;
2252         hv = (HV*)POPs;
2253         if (SvTYPE(hv) == SVt_PVHV)
2254             sv = hv_delete_ent(hv, keysv, discard, 0);
2255         else if (SvTYPE(hv) == SVt_PVAV)
2256             sv = avhv_delete_ent((AV*)hv, keysv, discard, 0);
2257         else
2258             DIE("Not a HASH reference");
2259         if (!sv)
2260             sv = &sv_undef;
2261         if (!discard)
2262             PUSHs(sv);
2263     }
2264     RETURN;
2265 }
2266
2267 PP(pp_exists)
2268 {
2269     dSP;
2270     SV *tmpsv = POPs;
2271     HV *hv = (HV*)POPs;
2272     if (SvTYPE(hv) == SVt_PVHV) {
2273         if (hv_exists_ent(hv, tmpsv, 0))
2274             RETPUSHYES;
2275     } else if (SvTYPE(hv) == SVt_PVAV) {
2276         if (avhv_exists_ent((AV*)hv, tmpsv, 0))
2277             RETPUSHYES;
2278     } else {
2279         DIE("Not a HASH reference");
2280     }
2281     RETPUSHNO;
2282 }
2283
2284 PP(pp_hslice)
2285 {
2286     dSP; dMARK; dORIGMARK;
2287     register HE *he;
2288     register HV *hv = (HV*)POPs;
2289     register I32 lval = op->op_flags & OPf_MOD;
2290     I32 realhv = (SvTYPE(hv) == SVt_PVHV);
2291
2292     if (realhv || SvTYPE(hv) == SVt_PVAV) {
2293         while (++MARK <= SP) {
2294             SV *keysv = *MARK;
2295             SV **svp;
2296             if (realhv) {
2297                 he = hv_fetch_ent(hv, keysv, lval, 0);
2298                 svp = he ? &HeVAL(he) : 0;
2299             } else {
2300                 svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
2301             }
2302             if (lval) {
2303                 if (!he || HeVAL(he) == &sv_undef)
2304                     DIE(no_helem, SvPV(keysv, na));
2305                 if (op->op_private & OPpLVAL_INTRO)
2306                     save_svref(&HeVAL(he));
2307             }
2308             *MARK = he ? HeVAL(he) : &sv_undef;
2309         }
2310     }
2311     if (GIMME != G_ARRAY) {
2312         MARK = ORIGMARK;
2313         *++MARK = *SP;
2314         SP = MARK;
2315     }
2316     RETURN;
2317 }
2318
2319 /* List operators. */
2320
2321 PP(pp_list)
2322 {
2323     dSP; dMARK;
2324     if (GIMME != G_ARRAY) {
2325         if (++MARK <= SP)
2326             *MARK = *SP;                /* unwanted list, return last item */
2327         else
2328             *MARK = &sv_undef;
2329         SP = MARK;
2330     }
2331     RETURN;
2332 }
2333
2334 PP(pp_lslice)
2335 {
2336     dSP;
2337     SV **lastrelem = stack_sp;
2338     SV **lastlelem = stack_base + POPMARK;
2339     SV **firstlelem = stack_base + POPMARK + 1;
2340     register SV **firstrelem = lastlelem + 1;
2341     I32 arybase = curcop->cop_arybase;
2342     I32 lval = op->op_flags & OPf_MOD;
2343     I32 is_something_there = lval;
2344
2345     register I32 max = lastrelem - lastlelem;
2346     register SV **lelem;
2347     register I32 ix;
2348
2349     if (GIMME != G_ARRAY) {
2350         ix = SvIVx(*lastlelem);
2351         if (ix < 0)
2352             ix += max;
2353         else
2354             ix -= arybase;
2355         if (ix < 0 || ix >= max)
2356             *firstlelem = &sv_undef;
2357         else
2358             *firstlelem = firstrelem[ix];
2359         SP = firstlelem;
2360         RETURN;
2361     }
2362
2363     if (max == 0) {
2364         SP = firstlelem - 1;
2365         RETURN;
2366     }
2367
2368     for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
2369         ix = SvIVx(*lelem);
2370         if (ix < 0) {
2371             ix += max;
2372             if (ix < 0)
2373                 *lelem = &sv_undef;
2374             else if (!(*lelem = firstrelem[ix]))
2375                 *lelem = &sv_undef;
2376         }
2377         else {
2378             ix -= arybase;
2379             if (ix >= max || !(*lelem = firstrelem[ix]))
2380                 *lelem = &sv_undef;
2381         }
2382         if (!is_something_there && (SvOK(*lelem) || SvGMAGICAL(*lelem)))
2383             is_something_there = TRUE;
2384     }
2385     if (is_something_there)
2386         SP = lastlelem;
2387     else
2388         SP = firstlelem - 1;
2389     RETURN;
2390 }
2391
2392 PP(pp_anonlist)
2393 {
2394     dSP; dMARK; dORIGMARK;
2395     I32 items = SP - MARK;
2396     SV *av = sv_2mortal((SV*)av_make(items, MARK+1));
2397     SP = ORIGMARK;              /* av_make() might realloc stack_sp */
2398     XPUSHs(av);
2399     RETURN;
2400 }
2401
2402 PP(pp_anonhash)
2403 {
2404     dSP; dMARK; dORIGMARK;
2405     HV* hv = (HV*)sv_2mortal((SV*)newHV());
2406
2407     while (MARK < SP) {
2408         SV* key = *++MARK;
2409         SV *val = NEWSV(46, 0);
2410         if (MARK < SP)
2411             sv_setsv(val, *++MARK);
2412         else if (dowarn)
2413             warn("Odd number of elements in hash list");
2414         (void)hv_store_ent(hv,key,val,0);
2415     }
2416     SP = ORIGMARK;
2417     XPUSHs((SV*)hv);
2418     RETURN;
2419 }
2420
2421 PP(pp_splice)
2422 {
2423     dSP; dMARK; dORIGMARK;
2424     register AV *ary = (AV*)*++MARK;
2425     register SV **src;
2426     register SV **dst;
2427     register I32 i;
2428     register I32 offset;
2429     register I32 length;
2430     I32 newlen;
2431     I32 after;
2432     I32 diff;
2433     SV **tmparyval = 0;
2434
2435     SP++;
2436
2437     if (++MARK < SP) {
2438         offset = i = SvIVx(*MARK);
2439         if (offset < 0)
2440             offset += AvFILL(ary) + 1;
2441         else
2442             offset -= curcop->cop_arybase;
2443         if (offset < 0)
2444             DIE(no_aelem, i);
2445         if (++MARK < SP) {
2446             length = SvIVx(*MARK++);
2447             if (length < 0)
2448                 length = 0;
2449         }
2450         else
2451             length = AvMAX(ary) + 1;            /* close enough to infinity */
2452     }
2453     else {
2454         offset = 0;
2455         length = AvMAX(ary) + 1;
2456     }
2457     if (offset > AvFILL(ary) + 1)
2458         offset = AvFILL(ary) + 1;
2459     after = AvFILL(ary) + 1 - (offset + length);
2460     if (after < 0) {                            /* not that much array */
2461         length += after;                        /* offset+length now in array */
2462         after = 0;
2463         if (!AvALLOC(ary))
2464             av_extend(ary, 0);
2465     }
2466
2467     /* At this point, MARK .. SP-1 is our new LIST */
2468
2469     newlen = SP - MARK;
2470     diff = newlen - length;
2471     if (newlen && !AvREAL(ary)) {
2472         if (AvREIFY(ary))
2473             av_reify(ary);
2474         else
2475             assert(AvREAL(ary));                /* would leak, so croak */
2476     }
2477
2478     if (diff < 0) {                             /* shrinking the area */
2479         if (newlen) {
2480             New(451, tmparyval, newlen, SV*);   /* so remember insertion */
2481             Copy(MARK, tmparyval, newlen, SV*);
2482         }
2483
2484         MARK = ORIGMARK + 1;
2485         if (GIMME == G_ARRAY) {                 /* copy return vals to stack */
2486             MEXTEND(MARK, length);
2487             Copy(AvARRAY(ary)+offset, MARK, length, SV*);
2488             if (AvREAL(ary)) {
2489                 EXTEND_MORTAL(length);
2490                 for (i = length, dst = MARK; i; i--) {
2491                     if (!SvIMMORTAL(*dst))
2492                         sv_2mortal(*dst);       /* free them eventualy */
2493                     dst++;
2494                 }
2495             }
2496             MARK += length - 1;
2497         }
2498         else {
2499             *MARK = AvARRAY(ary)[offset+length-1];
2500             if (AvREAL(ary)) {
2501                 if (!SvIMMORTAL(*MARK))
2502                     sv_2mortal(*MARK);
2503                 for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
2504                     SvREFCNT_dec(*dst++);       /* free them now */
2505             }
2506         }
2507         AvFILL(ary) += diff;
2508
2509         /* pull up or down? */
2510
2511         if (offset < after) {                   /* easier to pull up */
2512             if (offset) {                       /* esp. if nothing to pull */
2513                 src = &AvARRAY(ary)[offset-1];
2514                 dst = src - diff;               /* diff is negative */
2515                 for (i = offset; i > 0; i--)    /* can't trust Copy */
2516                     *dst-- = *src--;
2517             }
2518             dst = AvARRAY(ary);
2519             SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
2520             AvMAX(ary) += diff;
2521         }
2522         else {
2523             if (after) {                        /* anything to pull down? */
2524                 src = AvARRAY(ary) + offset + length;
2525                 dst = src + diff;               /* diff is negative */
2526                 Move(src, dst, after, SV*);
2527             }
2528             dst = &AvARRAY(ary)[AvFILL(ary)+1];
2529                                                 /* avoid later double free */
2530         }
2531         i = -diff;
2532         while (i)
2533             dst[--i] = &sv_undef;
2534
2535         if (newlen) {
2536             for (src = tmparyval, dst = AvARRAY(ary) + offset;
2537               newlen; newlen--) {
2538                 *dst = NEWSV(46, 0);
2539                 sv_setsv(*dst++, *src++);
2540             }
2541             Safefree(tmparyval);
2542         }
2543     }
2544     else {                                      /* no, expanding (or same) */
2545         if (length) {
2546             New(452, tmparyval, length, SV*);   /* so remember deletion */
2547             Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
2548         }
2549
2550         if (diff > 0) {                         /* expanding */
2551
2552             /* push up or down? */
2553
2554             if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
2555                 if (offset) {
2556                     src = AvARRAY(ary);
2557                     dst = src - diff;
2558                     Move(src, dst, offset, SV*);
2559                 }
2560                 SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
2561                 AvMAX(ary) += diff;
2562                 AvFILL(ary) += diff;
2563             }
2564             else {
2565                 if (AvFILL(ary) + diff >= AvMAX(ary))   /* oh, well */
2566                     av_extend(ary, AvFILL(ary) + diff);
2567                 AvFILL(ary) += diff;
2568
2569                 if (after) {
2570                     dst = AvARRAY(ary) + AvFILL(ary);
2571                     src = dst - diff;
2572                     for (i = after; i; i--) {
2573                         *dst-- = *src--;
2574                     }
2575                 }
2576             }
2577         }
2578
2579         for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
2580             *dst = NEWSV(46, 0);
2581             sv_setsv(*dst++, *src++);
2582         }
2583         MARK = ORIGMARK + 1;
2584         if (GIMME == G_ARRAY) {                 /* copy return vals to stack */
2585             if (length) {
2586                 Copy(tmparyval, MARK, length, SV*);
2587                 if (AvREAL(ary)) {
2588                     EXTEND_MORTAL(length);
2589                     for (i = length, dst = MARK; i; i--) {
2590                         if (!SvIMMORTAL(*dst))
2591                             sv_2mortal(*dst);   /* free them eventualy */
2592                         dst++;
2593                     }
2594                 }
2595                 Safefree(tmparyval);
2596             }
2597             MARK += length - 1;
2598         }
2599         else if (length--) {
2600             *MARK = tmparyval[length];
2601             if (AvREAL(ary)) {
2602                 if (!SvIMMORTAL(*MARK))
2603                     sv_2mortal(*MARK);
2604                 while (length-- > 0)
2605                     SvREFCNT_dec(tmparyval[length]);
2606             }
2607             Safefree(tmparyval);
2608         }
2609         else
2610             *MARK = &sv_undef;
2611     }
2612     SP = MARK;
2613     RETURN;
2614 }
2615
2616 PP(pp_push)
2617 {
2618     dSP; dMARK; dORIGMARK; dTARGET;
2619     register AV *ary = (AV*)*++MARK;
2620     register SV *sv = &sv_undef;
2621
2622     for (++MARK; MARK <= SP; MARK++) {
2623         sv = NEWSV(51, 0);
2624         if (*MARK)
2625             sv_setsv(sv, *MARK);
2626         av_push(ary, sv);
2627     }
2628     SP = ORIGMARK;
2629     PUSHi( AvFILL(ary) + 1 );
2630     RETURN;
2631 }
2632
2633 PP(pp_pop)
2634 {
2635     dSP;
2636     AV *av = (AV*)POPs;
2637     SV *sv = av_pop(av);
2638     if (!SvIMMORTAL(sv) && AvREAL(av))
2639         (void)sv_2mortal(sv);
2640     PUSHs(sv);
2641     RETURN;
2642 }
2643
2644 PP(pp_shift)
2645 {
2646     dSP;
2647     AV *av = (AV*)POPs;
2648     SV *sv = av_shift(av);
2649     EXTEND(SP, 1);
2650     if (!sv)
2651         RETPUSHUNDEF;
2652     if (!SvIMMORTAL(sv) && AvREAL(av))
2653         (void)sv_2mortal(sv);
2654     PUSHs(sv);
2655     RETURN;
2656 }
2657
2658 PP(pp_unshift)
2659 {
2660     dSP; dMARK; dORIGMARK; dTARGET;
2661     register AV *ary = (AV*)*++MARK;
2662     register SV *sv;
2663     register I32 i = 0;
2664
2665     av_unshift(ary, SP - MARK);
2666     while (MARK < SP) {
2667         sv = NEWSV(27, 0);
2668         sv_setsv(sv, *++MARK);
2669         (void)av_store(ary, i++, sv);
2670     }
2671
2672     SP = ORIGMARK;
2673     PUSHi( AvFILL(ary) + 1 );
2674     RETURN;
2675 }
2676
2677 PP(pp_reverse)
2678 {
2679     dSP; dMARK;
2680     register SV *tmp;
2681     SV **oldsp = SP;
2682
2683     if (GIMME == G_ARRAY) {
2684         MARK++;
2685         while (MARK < SP) {
2686             tmp = *MARK;
2687             *MARK++ = *SP;
2688             *SP-- = tmp;
2689         }
2690         SP = oldsp;
2691     }
2692     else {
2693         register char *up;
2694         register char *down;
2695         register I32 tmp;
2696         dTARGET;
2697         STRLEN len;
2698
2699         if (SP - MARK > 1)
2700             do_join(TARG, &sv_no, MARK, SP);
2701         else
2702             sv_setsv(TARG, (SP > MARK) ? *SP : GvSV(defgv));
2703         up = SvPV_force(TARG, len);
2704         if (len > 1) {
2705             down = SvPVX(TARG) + len - 1;
2706             while (down > up) {
2707                 tmp = *up;
2708                 *up++ = *down;
2709                 *down-- = tmp;
2710             }
2711             (void)SvPOK_only(TARG);
2712         }
2713         SP = MARK + 1;
2714         SETTARG;
2715     }
2716     RETURN;
2717 }
2718
2719 static SV      *
2720 mul128(sv, m)
2721      SV             *sv;
2722      U8              m;
2723 {
2724   STRLEN          len;
2725   char           *s = SvPV(sv, len);
2726   char           *t;
2727   U32             i = 0;
2728
2729   if (!strnEQ(s, "0000", 4)) {  /* need to grow sv */
2730     SV             *new = newSVpv("0000000000", 10);
2731
2732     sv_catsv(new, sv);
2733     SvREFCNT_dec(sv);           /* free old sv */
2734     sv = new;
2735     s = SvPV(sv, len);
2736   }
2737   t = s + len - 1;
2738   while (!*t)                   /* trailing '\0'? */
2739     t--;
2740   while (t > s) {
2741     i = ((*t - '0') << 7) + m;
2742     *(t--) = '0' + (i % 10);
2743     m = i / 10;
2744   }
2745   return (sv);
2746 }
2747
2748 /* Explosives and implosives. */
2749
2750 PP(pp_unpack)
2751 {
2752     dSP;
2753     dPOPPOPssrl;
2754     SV **oldsp = sp;
2755     I32 gimme = GIMME_V;
2756     SV *sv;
2757     STRLEN llen;
2758     STRLEN rlen;
2759     register char *pat = SvPV(left, llen);
2760     register char *s = SvPV(right, rlen);
2761     char *strend = s + rlen;
2762     char *strbeg = s;
2763     register char *patend = pat + llen;
2764     I32 datumtype;
2765     register I32 len;
2766     register I32 bits;
2767
2768     /* These must not be in registers: */
2769     I16 ashort;
2770     int aint;
2771     I32 along;
2772 #ifdef HAS_QUAD
2773     Quad_t aquad;
2774 #endif
2775     U16 aushort;
2776     unsigned int auint;
2777     U32 aulong;
2778 #ifdef HAS_QUAD
2779     unsigned Quad_t auquad;
2780 #endif
2781     char *aptr;
2782     float afloat;
2783     double adouble;
2784     I32 checksum = 0;
2785     register U32 culong;
2786     double cdouble;
2787     static char* bitcount = 0;
2788     int commas = 0;
2789
2790     if (gimme != G_ARRAY) {             /* arrange to do first one only */
2791         /*SUPPRESS 530*/
2792         for (patend = pat; !isALPHA(*patend) || *patend == 'x'; patend++) ;
2793         if (strchr("aAbBhHP", *patend) || *pat == '%') {
2794             patend++;
2795             while (isDIGIT(*patend) || *patend == '*')
2796                 patend++;
2797         }
2798         else
2799             patend++;
2800     }
2801     while (pat < patend) {
2802       reparse:
2803         datumtype = *pat++ & 0xFF;
2804         if (isSPACE(datumtype))
2805             continue;
2806         if (pat >= patend)
2807             len = 1;
2808         else if (*pat == '*') {
2809             len = strend - strbeg;      /* long enough */
2810             pat++;
2811         }
2812         else if (isDIGIT(*pat)) {
2813             len = *pat++ - '0';
2814             while (isDIGIT(*pat))
2815                 len = (len * 10) + (*pat++ - '0');
2816         }
2817         else
2818             len = (datumtype != '@');
2819         switch(datumtype) {
2820         default:
2821             croak("Invalid type in unpack: '%c'", (int)datumtype);
2822         case ',': /* grandfather in commas but with a warning */
2823             if (commas++ == 0 && dowarn)
2824                 warn("Invalid type in unpack: '%c'", (int)datumtype);
2825             break;
2826         case '%':
2827             if (len == 1 && pat[-1] != '1')
2828                 len = 16;
2829             checksum = len;
2830             culong = 0;
2831             cdouble = 0;
2832             if (pat < patend)
2833                 goto reparse;
2834             break;
2835         case '@':
2836             if (len > strend - strbeg)
2837                 DIE("@ outside of string");
2838             s = strbeg + len;
2839             break;
2840         case 'X':
2841             if (len > s - strbeg)
2842                 DIE("X outside of string");
2843             s -= len;
2844             break;
2845         case 'x':
2846             if (len > strend - s)
2847                 DIE("x outside of string");
2848             s += len;
2849             break;
2850         case 'A':
2851         case 'a':
2852             if (len > strend - s)
2853                 len = strend - s;
2854             if (checksum)
2855                 goto uchar_checksum;
2856             sv = NEWSV(35, len);
2857             sv_setpvn(sv, s, len);
2858             s += len;
2859             if (datumtype == 'A') {
2860                 aptr = s;       /* borrow register */
2861                 s = SvPVX(sv) + len - 1;
2862                 while (s >= SvPVX(sv) && (!*s || isSPACE(*s)))
2863                     s--;
2864                 *++s = '\0';
2865                 SvCUR_set(sv, s - SvPVX(sv));
2866                 s = aptr;       /* unborrow register */
2867             }
2868             XPUSHs(sv_2mortal(sv));
2869             break;
2870         case 'B':
2871         case 'b':
2872             if (pat[-1] == '*' || len > (strend - s) * 8)
2873                 len = (strend - s) * 8;
2874             if (checksum) {
2875                 if (!bitcount) {
2876                     Newz(601, bitcount, 256, char);
2877                     for (bits = 1; bits < 256; bits++) {
2878                         if (bits & 1)   bitcount[bits]++;
2879                         if (bits & 2)   bitcount[bits]++;
2880                         if (bits & 4)   bitcount[bits]++;
2881                         if (bits & 8)   bitcount[bits]++;
2882                         if (bits & 16)  bitcount[bits]++;
2883                         if (bits & 32)  bitcount[bits]++;
2884                         if (bits & 64)  bitcount[bits]++;
2885                         if (bits & 128) bitcount[bits]++;
2886                     }
2887                 }
2888                 while (len >= 8) {
2889                     culong += bitcount[*(unsigned char*)s++];
2890                     len -= 8;
2891                 }
2892                 if (len) {
2893                     bits = *s;
2894                     if (datumtype == 'b') {
2895                         while (len-- > 0) {
2896                             if (bits & 1) culong++;
2897                             bits >>= 1;
2898                         }
2899                     }
2900                     else {
2901                         while (len-- > 0) {
2902                             if (bits & 128) culong++;
2903                             bits <<= 1;
2904                         }
2905                     }
2906                 }
2907                 break;
2908             }
2909             sv = NEWSV(35, len + 1);
2910             SvCUR_set(sv, len);
2911             SvPOK_on(sv);
2912             aptr = pat;                 /* borrow register */
2913             pat = SvPVX(sv);
2914             if (datumtype == 'b') {
2915                 aint = len;
2916                 for (len = 0; len < aint; len++) {
2917                     if (len & 7)                /*SUPPRESS 595*/
2918                         bits >>= 1;
2919                     else
2920                         bits = *s++;
2921                     *pat++ = '0' + (bits & 1);
2922                 }
2923             }
2924             else {
2925                 aint = len;
2926                 for (len = 0; len < aint; len++) {
2927                     if (len & 7)
2928                         bits <<= 1;
2929                     else
2930                         bits = *s++;
2931                     *pat++ = '0' + ((bits & 128) != 0);
2932                 }
2933             }
2934             *pat = '\0';
2935             pat = aptr;                 /* unborrow register */
2936             XPUSHs(sv_2mortal(sv));
2937             break;
2938         case 'H':
2939         case 'h':
2940             if (pat[-1] == '*' || len > (strend - s) * 2)
2941                 len = (strend - s) * 2;
2942             sv = NEWSV(35, len + 1);
2943             SvCUR_set(sv, len);
2944             SvPOK_on(sv);
2945             aptr = pat;                 /* borrow register */
2946             pat = SvPVX(sv);
2947             if (datumtype == 'h') {
2948                 aint = len;
2949                 for (len = 0; len < aint; len++) {
2950                     if (len & 1)
2951                         bits >>= 4;
2952                     else
2953                         bits = *s++;
2954                     *pat++ = hexdigit[bits & 15];
2955                 }
2956             }
2957             else {
2958                 aint = len;
2959                 for (len = 0; len < aint; len++) {
2960                     if (len & 1)
2961                         bits <<= 4;
2962                     else
2963                         bits = *s++;
2964                     *pat++ = hexdigit[(bits >> 4) & 15];
2965                 }
2966             }
2967             *pat = '\0';
2968             pat = aptr;                 /* unborrow register */
2969             XPUSHs(sv_2mortal(sv));
2970             break;
2971         case 'c':
2972             if (len > strend - s)
2973                 len = strend - s;
2974             if (checksum) {
2975                 while (len-- > 0) {
2976                     aint = *s++;
2977                     if (aint >= 128)    /* fake up signed chars */
2978                         aint -= 256;
2979                     culong += aint;
2980                 }
2981             }
2982             else {
2983                 EXTEND(SP, len);
2984                 EXTEND_MORTAL(len);
2985                 while (len-- > 0) {
2986                     aint = *s++;
2987                     if (aint >= 128)    /* fake up signed chars */
2988                         aint -= 256;
2989                     sv = NEWSV(36, 0);
2990                     sv_setiv(sv, (IV)aint);
2991                     PUSHs(sv_2mortal(sv));
2992                 }
2993             }
2994             break;
2995         case 'C':
2996             if (len > strend - s)
2997                 len = strend - s;
2998             if (checksum) {
2999               uchar_checksum:
3000                 while (len-- > 0) {
3001                     auint = *s++ & 255;
3002                     culong += auint;
3003                 }
3004             }
3005             else {
3006                 EXTEND(SP, len);
3007                 EXTEND_MORTAL(len);
3008                 while (len-- > 0) {
3009                     auint = *s++ & 255;
3010                     sv = NEWSV(37, 0);
3011                     sv_setiv(sv, (IV)auint);
3012                     PUSHs(sv_2mortal(sv));
3013                 }
3014             }
3015             break;
3016         case 's':
3017             along = (strend - s) / SIZE16;
3018             if (len > along)
3019                 len = along;
3020             if (checksum) {
3021                 while (len-- > 0) {
3022                     COPY16(s, &ashort);
3023                     s += SIZE16;
3024                     culong += ashort;
3025                 }
3026             }
3027             else {
3028                 EXTEND(SP, len);
3029                 EXTEND_MORTAL(len);
3030                 while (len-- > 0) {
3031                     COPY16(s, &ashort);
3032                     s += SIZE16;
3033                     sv = NEWSV(38, 0);
3034                     sv_setiv(sv, (IV)ashort);
3035                     PUSHs(sv_2mortal(sv));
3036                 }
3037             }
3038             break;
3039         case 'v':
3040         case 'n':
3041         case 'S':
3042             along = (strend - s) / SIZE16;
3043             if (len > along)
3044                 len = along;
3045             if (checksum) {
3046                 while (len-- > 0) {
3047                     COPY16(s, &aushort);
3048                     s += SIZE16;
3049 #ifdef HAS_NTOHS
3050                     if (datumtype == 'n')
3051                         aushort = ntohs(aushort);
3052 #endif
3053 #ifdef HAS_VTOHS
3054                     if (datumtype == 'v')
3055                         aushort = vtohs(aushort);
3056 #endif
3057                     culong += aushort;
3058                 }
3059             }
3060             else {
3061                 EXTEND(SP, len);
3062                 EXTEND_MORTAL(len);
3063                 while (len-- > 0) {
3064                     COPY16(s, &aushort);
3065                     s += SIZE16;
3066                     sv = NEWSV(39, 0);
3067 #ifdef HAS_NTOHS
3068                     if (datumtype == 'n')
3069                         aushort = ntohs(aushort);
3070 #endif
3071 #ifdef HAS_VTOHS
3072                     if (datumtype == 'v')
3073                         aushort = vtohs(aushort);
3074 #endif
3075                     sv_setiv(sv, (IV)aushort);
3076                     PUSHs(sv_2mortal(sv));
3077                 }
3078             }
3079             break;
3080         case 'i':
3081             along = (strend - s) / sizeof(int);
3082             if (len > along)
3083                 len = along;
3084             if (checksum) {
3085                 while (len-- > 0) {
3086                     Copy(s, &aint, 1, int);
3087                     s += sizeof(int);
3088                     if (checksum > 32)
3089                         cdouble += (double)aint;
3090                     else
3091                         culong += aint;
3092                 }
3093             }
3094             else {
3095                 EXTEND(SP, len);
3096                 EXTEND_MORTAL(len);
3097                 while (len-- > 0) {
3098                     Copy(s, &aint, 1, int);
3099                     s += sizeof(int);
3100                     sv = NEWSV(40, 0);
3101                     sv_setiv(sv, (IV)aint);
3102                     PUSHs(sv_2mortal(sv));
3103                 }
3104             }
3105             break;
3106         case 'I':
3107             along = (strend - s) / sizeof(unsigned int);
3108             if (len > along)
3109                 len = along;
3110             if (checksum) {
3111                 while (len-- > 0) {
3112                     Copy(s, &auint, 1, unsigned int);
3113                     s += sizeof(unsigned int);
3114                     if (checksum > 32)
3115                         cdouble += (double)auint;
3116                     else
3117                         culong += auint;
3118                 }
3119             }
3120             else {
3121                 EXTEND(SP, len);
3122                 EXTEND_MORTAL(len);
3123                 while (len-- > 0) {
3124                     Copy(s, &auint, 1, unsigned int);
3125                     s += sizeof(unsigned int);
3126                     sv = NEWSV(41, 0);
3127                     sv_setuv(sv, (UV)auint);
3128                     PUSHs(sv_2mortal(sv));
3129                 }
3130             }
3131             break;
3132         case 'l':
3133             along = (strend - s) / SIZE32;
3134             if (len > along)
3135                 len = along;
3136             if (checksum) {
3137                 while (len-- > 0) {
3138                     COPY32(s, &along);
3139                     s += SIZE32;
3140                     if (checksum > 32)
3141                         cdouble += (double)along;
3142                     else
3143                         culong += along;
3144                 }
3145             }
3146             else {
3147                 EXTEND(SP, len);
3148                 EXTEND_MORTAL(len);
3149                 while (len-- > 0) {
3150                     COPY32(s, &along);
3151                     s += SIZE32;
3152                     sv = NEWSV(42, 0);
3153                     sv_setiv(sv, (IV)along);
3154                     PUSHs(sv_2mortal(sv));
3155                 }
3156             }
3157             break;
3158         case 'V':
3159         case 'N':
3160         case 'L':
3161             along = (strend - s) / SIZE32;
3162             if (len > along)
3163                 len = along;
3164             if (checksum) {
3165                 while (len-- > 0) {
3166                     COPY32(s, &aulong);
3167                     s += SIZE32;
3168 #ifdef HAS_NTOHL
3169                     if (datumtype == 'N')
3170                         aulong = ntohl(aulong);
3171 #endif
3172 #ifdef HAS_VTOHL
3173                     if (datumtype == 'V')
3174                         aulong = vtohl(aulong);
3175 #endif
3176                     if (checksum > 32)
3177                         cdouble += (double)aulong;
3178                     else
3179                         culong += aulong;
3180                 }
3181             }
3182             else {
3183                 EXTEND(SP, len);
3184                 EXTEND_MORTAL(len);
3185                 while (len-- > 0) {
3186                     COPY32(s, &aulong);
3187                     s += SIZE32;
3188 #ifdef HAS_NTOHL
3189                     if (datumtype == 'N')
3190                         aulong = ntohl(aulong);
3191 #endif
3192 #ifdef HAS_VTOHL
3193                     if (datumtype == 'V')
3194                         aulong = vtohl(aulong);
3195 #endif
3196                     sv = NEWSV(43, 0);
3197                     sv_setuv(sv, (UV)aulong);
3198                     PUSHs(sv_2mortal(sv));
3199                 }
3200             }
3201             break;
3202         case 'p':
3203             along = (strend - s) / sizeof(char*);
3204             if (len > along)
3205                 len = along;
3206             EXTEND(SP, len);
3207             EXTEND_MORTAL(len);
3208             while (len-- > 0) {
3209                 if (sizeof(char*) > strend - s)
3210                     break;
3211                 else {
3212                     Copy(s, &aptr, 1, char*);
3213                     s += sizeof(char*);
3214                 }
3215                 sv = NEWSV(44, 0);
3216                 if (aptr)
3217                     sv_setpv(sv, aptr);
3218                 PUSHs(sv_2mortal(sv));
3219             }
3220             break;
3221         case 'w':
3222             EXTEND(SP, len);
3223             EXTEND_MORTAL(len);
3224             {
3225                 UV auv = 0;
3226                 U32 bytes = 0;
3227
3228                 while ((len > 0) && (s < strend)) {
3229                     auv = (auv << 7) | (*s & 0x7f);
3230                     if (!(*s++ & 0x80)) {
3231                         bytes = 0;
3232                         sv = NEWSV(40, 0);
3233                         sv_setuv(sv, auv);
3234                         PUSHs(sv_2mortal(sv));
3235                         len--;
3236                         auv = 0;
3237                     }
3238                     else if (++bytes >= sizeof(UV)) {   /* promote to string */
3239                         char *t;
3240
3241                         sv = newSVpvf("%.*Vu", (int)TYPE_DIGITS(UV), auv);
3242                         while (s < strend) {
3243                             sv = mul128(sv, *s & 0x7f);
3244                             if (!(*s++ & 0x80)) {
3245                                 bytes = 0;
3246                                 break;
3247                             }
3248                         }
3249                         t = SvPV(sv, na);
3250                         while (*t == '0')
3251                             t++;
3252                         sv_chop(sv, t);
3253                         PUSHs(sv_2mortal(sv));
3254                         len--;
3255                         auv = 0;
3256                     }
3257                 }
3258                 if ((s >= strend) && bytes)
3259                     croak("Unterminated compressed integer");
3260             }
3261             break;
3262         case 'P':
3263             EXTEND(SP, 1);
3264             if (sizeof(char*) > strend - s)
3265                 break;
3266             else {
3267                 Copy(s, &aptr, 1, char*);
3268                 s += sizeof(char*);
3269             }
3270             sv = NEWSV(44, 0);
3271             if (aptr)
3272                 sv_setpvn(sv, aptr, len);
3273             PUSHs(sv_2mortal(sv));
3274             break;
3275 #ifdef HAS_QUAD
3276         case 'q':
3277             EXTEND(SP, len);
3278             EXTEND_MORTAL(len);
3279             while (len-- > 0) {
3280                 if (s + sizeof(Quad_t) > strend)
3281                     aquad = 0;
3282                 else {
3283                     Copy(s, &aquad, 1, Quad_t);
3284                     s += sizeof(Quad_t);
3285                 }
3286                 sv = NEWSV(42, 0);
3287                 if (aquad >= IV_MIN && aquad <= IV_MAX)
3288                     sv_setiv(sv, (IV)aquad);
3289                 else
3290                     sv_setnv(sv, (double)aquad);
3291                 PUSHs(sv_2mortal(sv));
3292             }
3293             break;
3294         case 'Q':
3295             EXTEND(SP, len);
3296             EXTEND_MORTAL(len);
3297             while (len-- > 0) {
3298                 if (s + sizeof(unsigned Quad_t) > strend)
3299                     auquad = 0;
3300                 else {
3301                     Copy(s, &auquad, 1, unsigned Quad_t);
3302                     s += sizeof(unsigned Quad_t);
3303                 }
3304                 sv = NEWSV(43, 0);
3305                 if (aquad <= UV_MAX)
3306                     sv_setuv(sv, (UV)auquad);
3307                 else
3308                     sv_setnv(sv, (double)auquad);
3309                 PUSHs(sv_2mortal(sv));
3310             }
3311             break;
3312 #endif
3313         /* float and double added gnb@melba.bby.oz.au 22/11/89 */
3314         case 'f':
3315         case 'F':
3316             along = (strend - s) / sizeof(float);
3317             if (len > along)
3318                 len = along;
3319             if (checksum) {
3320                 while (len-- > 0) {
3321                     Copy(s, &afloat, 1, float);
3322                     s += sizeof(float);
3323                     cdouble += afloat;
3324                 }
3325             }
3326             else {
3327                 EXTEND(SP, len);
3328                 EXTEND_MORTAL(len);
3329                 while (len-- > 0) {
3330                     Copy(s, &afloat, 1, float);
3331                     s += sizeof(float);
3332                     sv = NEWSV(47, 0);
3333                     sv_setnv(sv, (double)afloat);
3334                     PUSHs(sv_2mortal(sv));
3335                 }
3336             }
3337             break;
3338         case 'd':
3339         case 'D':
3340             along = (strend - s) / sizeof(double);
3341             if (len > along)
3342                 len = along;
3343             if (checksum) {
3344                 while (len-- > 0) {
3345                     Copy(s, &adouble, 1, double);
3346                     s += sizeof(double);
3347                     cdouble += adouble;
3348                 }
3349             }
3350             else {
3351                 EXTEND(SP, len);
3352                 EXTEND_MORTAL(len);
3353                 while (len-- > 0) {
3354                     Copy(s, &adouble, 1, double);
3355                     s += sizeof(double);
3356                     sv = NEWSV(48, 0);
3357                     sv_setnv(sv, (double)adouble);
3358                     PUSHs(sv_2mortal(sv));
3359                 }
3360             }
3361             break;
3362         case 'u':
3363             along = (strend - s) * 3 / 4;
3364             sv = NEWSV(42, along);
3365             if (along)
3366                 SvPOK_on(sv);
3367             while (s < strend && *s > ' ' && *s < 'a') {
3368                 I32 a, b, c, d;
3369                 char hunk[4];
3370
3371                 hunk[3] = '\0';
3372                 len = (*s++ - ' ') & 077;
3373                 while (len > 0) {
3374                     if (s < strend && *s >= ' ')
3375                         a = (*s++ - ' ') & 077;
3376                     else
3377                         a = 0;
3378                     if (s < strend && *s >= ' ')
3379                         b = (*s++ - ' ') & 077;
3380                     else
3381                         b = 0;
3382                     if (s < strend && *s >= ' ')
3383                         c = (*s++ - ' ') & 077;
3384                     else
3385                         c = 0;
3386                     if (s < strend && *s >= ' ')
3387                         d = (*s++ - ' ') & 077;
3388                     else
3389                         d = 0;
3390                     hunk[0] = a << 2 | b >> 4;
3391                     hunk[1] = b << 4 | c >> 2;
3392                     hunk[2] = c << 6 | d;
3393                     sv_catpvn(sv, hunk, len > 3 ? 3 : len);
3394                     len -= 3;
3395                 }
3396                 if (*s == '\n')
3397                     s++;
3398                 else if (s[1] == '\n')          /* possible checksum byte */
3399                     s += 2;
3400             }
3401             XPUSHs(sv_2mortal(sv));
3402             break;
3403         }
3404         if (checksum) {
3405             sv = NEWSV(42, 0);
3406             if (strchr("fFdD", datumtype) ||
3407               (checksum > 32 && strchr("iIlLN", datumtype)) ) {
3408                 double trouble;
3409
3410                 adouble = 1.0;
3411                 while (checksum >= 16) {
3412                     checksum -= 16;
3413                     adouble *= 65536.0;
3414                 }
3415                 while (checksum >= 4) {
3416                     checksum -= 4;
3417                     adouble *= 16.0;
3418                 }
3419                 while (checksum--)
3420                     adouble *= 2.0;
3421                 along = (1 << checksum) - 1;
3422                 while (cdouble < 0.0)
3423                     cdouble += adouble;
3424                 cdouble = modf(cdouble / adouble, &trouble) * adouble;
3425                 sv_setnv(sv, cdouble);
3426             }
3427             else {
3428                 if (checksum < 32) {
3429                     aulong = (1 << checksum) - 1;
3430                     culong &= aulong;
3431                 }
3432                 sv_setuv(sv, (UV)culong);
3433             }
3434             XPUSHs(sv_2mortal(sv));
3435             checksum = 0;
3436         }
3437     }
3438     if (sp == oldsp && gimme == G_SCALAR)
3439         PUSHs(&sv_undef);
3440     RETURN;
3441 }
3442
3443 static void
3444 doencodes(sv, s, len)
3445 register SV *sv;
3446 register char *s;
3447 register I32 len;
3448 {
3449     char hunk[5];
3450
3451     *hunk = len + ' ';
3452     sv_catpvn(sv, hunk, 1);
3453     hunk[4] = '\0';
3454     while (len > 0) {
3455         hunk[0] = ' ' + (077 & (*s >> 2));
3456         hunk[1] = ' ' + (077 & ((*s << 4) & 060 | (s[1] >> 4) & 017));
3457         hunk[2] = ' ' + (077 & ((s[1] << 2) & 074 | (s[2] >> 6) & 03));
3458         hunk[3] = ' ' + (077 & (s[2] & 077));
3459         sv_catpvn(sv, hunk, 4);
3460         s += 3;
3461         len -= 3;
3462     }
3463     for (s = SvPVX(sv); *s; s++) {
3464         if (*s == ' ')
3465             *s = '`';
3466     }
3467     sv_catpvn(sv, "\n", 1);
3468 }
3469
3470 static SV      *
3471 is_an_int(s, l)
3472      char           *s;
3473      STRLEN          l;
3474 {
3475   SV             *result = newSVpv("", l);
3476   char           *result_c = SvPV(result, na);  /* convenience */
3477   char           *out = result_c;
3478   bool            skip = 1;
3479   bool            ignore = 0;
3480
3481   while (*s) {
3482     switch (*s) {
3483     case ' ':
3484       break;
3485     case '+':
3486       if (!skip) {
3487         SvREFCNT_dec(result);
3488         return (NULL);
3489       }
3490       break;
3491     case '0':
3492     case '1':
3493     case '2':
3494     case '3':
3495     case '4':
3496     case '5':
3497     case '6':
3498     case '7':
3499     case '8':
3500     case '9':
3501       skip = 0;
3502       if (!ignore) {
3503         *(out++) = *s;
3504       }
3505       break;
3506     case '.':
3507       ignore = 1;
3508       break;
3509     default:
3510       SvREFCNT_dec(result);
3511       return (NULL);
3512     }
3513     s++;
3514   }
3515   *(out++) = '\0';
3516   SvCUR_set(result, out - result_c);
3517   return (result);
3518 }
3519
3520 static int
3521 div128(pnum, done)
3522      SV             *pnum;                  /* must be '\0' terminated */
3523      bool           *done;
3524 {
3525   STRLEN          len;
3526   char           *s = SvPV(pnum, len);
3527   int             m = 0;
3528   int             r = 0;
3529   char           *t = s;
3530
3531   *done = 1;
3532   while (*t) {
3533     int             i;
3534
3535     i = m * 10 + (*t - '0');
3536     m = i & 0x7F;
3537     r = (i >> 7);               /* r < 10 */
3538     if (r) {
3539       *done = 0;
3540     }
3541     *(t++) = '0' + r;
3542   }
3543   *(t++) = '\0';
3544   SvCUR_set(pnum, (STRLEN) (t - s));
3545   return (m);
3546 }
3547
3548
3549 PP(pp_pack)
3550 {
3551     dSP; dMARK; dORIGMARK; dTARGET;
3552     register SV *cat = TARG;
3553     register I32 items;
3554     STRLEN fromlen;
3555     register char *pat = SvPVx(*++MARK, fromlen);
3556     register char *patend = pat + fromlen;
3557     register I32 len;
3558     I32 datumtype;
3559     SV *fromstr;
3560     /*SUPPRESS 442*/
3561     static char null10[] = {0,0,0,0,0,0,0,0,0,0};
3562     static char *space10 = "          ";
3563
3564     /* These must not be in registers: */
3565     char achar;
3566     I16 ashort;
3567     int aint;
3568     unsigned int auint;
3569     I32 along;
3570     U32 aulong;
3571 #ifdef HAS_QUAD
3572     Quad_t aquad;
3573     unsigned Quad_t auquad;
3574 #endif
3575     char *aptr;
3576     float afloat;
3577     double adouble;
3578     int commas = 0;
3579
3580     items = SP - MARK;
3581     MARK++;
3582     sv_setpvn(cat, "", 0);
3583     while (pat < patend) {
3584 #define NEXTFROM (items-- > 0 ? *MARK++ : &sv_no)
3585         datumtype = *pat++ & 0xFF;
3586         if (isSPACE(datumtype))
3587             continue;
3588         if (*pat == '*') {
3589             len = strchr("@Xxu", datumtype) ? 0 : items;
3590             pat++;
3591         }
3592         else if (isDIGIT(*pat)) {
3593             len = *pat++ - '0';
3594             while (isDIGIT(*pat))
3595                 len = (len * 10) + (*pat++ - '0');
3596         }
3597         else
3598             len = 1;
3599         switch(datumtype) {
3600         default:
3601             croak("Invalid type in pack: '%c'", (int)datumtype);
3602         case ',': /* grandfather in commas but with a warning */
3603             if (commas++ == 0 && dowarn)
3604                 warn("Invalid type in pack: '%c'", (int)datumtype);
3605             break;
3606         case '%':
3607             DIE("%% may only be used in unpack");
3608         case '@':
3609             len -= SvCUR(cat);
3610             if (len > 0)
3611                 goto grow;
3612             len = -len;
3613             if (len > 0)
3614                 goto shrink;
3615             break;
3616         case 'X':
3617           shrink:
3618             if (SvCUR(cat) < len)
3619                 DIE("X outside of string");
3620             SvCUR(cat) -= len;
3621             *SvEND(cat) = '\0';
3622             break;
3623         case 'x':
3624           grow:
3625             while (len >= 10) {
3626                 sv_catpvn(cat, null10, 10);
3627                 len -= 10;
3628             }
3629             sv_catpvn(cat, null10, len);
3630             break;
3631         case 'A':
3632         case 'a':
3633             fromstr = NEXTFROM;
3634             aptr = SvPV(fromstr, fromlen);
3635             if (pat[-1] == '*')
3636                 len = fromlen;
3637             if (fromlen > len)
3638                 sv_catpvn(cat, aptr, len);
3639             else {
3640                 sv_catpvn(cat, aptr, fromlen);
3641                 len -= fromlen;
3642                 if (datumtype == 'A') {
3643                     while (len >= 10) {
3644                         sv_catpvn(cat, space10, 10);
3645                         len -= 10;
3646                     }
3647                     sv_catpvn(cat, space10, len);
3648                 }
3649                 else {
3650                     while (len >= 10) {
3651                         sv_catpvn(cat, null10, 10);
3652                         len -= 10;
3653                     }
3654                     sv_catpvn(cat, null10, len);
3655                 }
3656             }
3657             break;
3658         case 'B':
3659         case 'b':
3660             {
3661                 char *savepat = pat;
3662                 I32 saveitems;
3663
3664                 fromstr = NEXTFROM;
3665                 saveitems = items;
3666                 aptr = SvPV(fromstr, fromlen);
3667                 if (pat[-1] == '*')
3668                     len = fromlen;
3669                 pat = aptr;
3670                 aint = SvCUR(cat);
3671                 SvCUR(cat) += (len+7)/8;
3672                 SvGROW(cat, SvCUR(cat) + 1);
3673                 aptr = SvPVX(cat) + aint;
3674                 if (len > fromlen)
3675                     len = fromlen;
3676                 aint = len;
3677                 items = 0;
3678                 if (datumtype == 'B') {
3679                     for (len = 0; len++ < aint;) {
3680                         items |= *pat++ & 1;
3681                         if (len & 7)
3682                             items <<= 1;
3683                         else {
3684                             *aptr++ = items & 0xff;
3685                             items = 0;
3686                         }
3687                     }
3688                 }
3689                 else {
3690                     for (len = 0; len++ < aint;) {
3691                         if (*pat++ & 1)
3692                             items |= 128;
3693                         if (len & 7)
3694                             items >>= 1;
3695                         else {
3696                             *aptr++ = items & 0xff;
3697                             items = 0;
3698                         }
3699                     }
3700                 }
3701                 if (aint & 7) {
3702                     if (datumtype == 'B')
3703                         items <<= 7 - (aint & 7);
3704                     else
3705                         items >>= 7 - (aint & 7);
3706                     *aptr++ = items & 0xff;
3707                 }
3708                 pat = SvPVX(cat) + SvCUR(cat);
3709                 while (aptr <= pat)
3710                     *aptr++ = '\0';
3711
3712                 pat = savepat;
3713                 items = saveitems;
3714             }
3715             break;
3716         case 'H':
3717         case 'h':
3718             {
3719                 char *savepat = pat;
3720                 I32 saveitems;
3721
3722                 fromstr = NEXTFROM;
3723                 saveitems = items;
3724                 aptr = SvPV(fromstr, fromlen);
3725                 if (pat[-1] == '*')
3726                     len = fromlen;
3727                 pat = aptr;
3728                 aint = SvCUR(cat);
3729                 SvCUR(cat) += (len+1)/2;
3730                 SvGROW(cat, SvCUR(cat) + 1);
3731                 aptr = SvPVX(cat) + aint;
3732                 if (len > fromlen)
3733                     len = fromlen;
3734                 aint = len;
3735                 items = 0;
3736                 if (datumtype == 'H') {
3737                     for (len = 0; len++ < aint;) {
3738                         if (isALPHA(*pat))
3739                             items |= ((*pat++ & 15) + 9) & 15;
3740                         else
3741                             items |= *pat++ & 15;
3742                         if (len & 1)
3743                             items <<= 4;
3744                         else {
3745                             *aptr++ = items & 0xff;
3746                             items = 0;
3747                         }
3748                     }
3749                 }
3750                 else {
3751                     for (len = 0; len++ < aint;) {
3752                         if (isALPHA(*pat))
3753                             items |= (((*pat++ & 15) + 9) & 15) << 4;
3754                         else
3755                             items |= (*pat++ & 15) << 4;
3756                         if (len & 1)
3757                             items >>= 4;
3758                         else {
3759                             *aptr++ = items & 0xff;
3760                             items = 0;
3761                         }
3762                     }
3763                 }
3764                 if (aint & 1)
3765                     *aptr++ = items & 0xff;
3766                 pat = SvPVX(cat) + SvCUR(cat);
3767                 while (aptr <= pat)
3768                     *aptr++ = '\0';
3769
3770                 pat = savepat;
3771                 items = saveitems;
3772             }
3773             break;
3774         case 'C':
3775         case 'c':
3776             while (len-- > 0) {
3777                 fromstr = NEXTFROM;
3778                 aint = SvIV(fromstr);
3779                 achar = aint;
3780                 sv_catpvn(cat, &achar, sizeof(char));
3781             }
3782             break;
3783         /* Float and double added by gnb@melba.bby.oz.au  22/11/89 */
3784         case 'f':
3785         case 'F':
3786             while (len-- > 0) {
3787                 fromstr = NEXTFROM;
3788                 afloat = (float)SvNV(fromstr);
3789                 sv_catpvn(cat, (char *)&afloat, sizeof (float));
3790             }
3791             break;
3792         case 'd':
3793         case 'D':
3794             while (len-- > 0) {
3795                 fromstr = NEXTFROM;
3796                 adouble = (double)SvNV(fromstr);
3797                 sv_catpvn(cat, (char *)&adouble, sizeof (double));
3798             }
3799             break;
3800         case 'n':
3801             while (len-- > 0) {
3802                 fromstr = NEXTFROM;
3803                 ashort = (I16)SvIV(fromstr);
3804 #ifdef HAS_HTONS
3805                 ashort = htons(ashort);
3806 #endif
3807                 CAT16(cat, &ashort);
3808             }
3809             break;
3810         case 'v':
3811             while (len-- > 0) {
3812                 fromstr = NEXTFROM;
3813                 ashort = (I16)SvIV(fromstr);
3814 #ifdef HAS_HTOVS
3815                 ashort = htovs(ashort);
3816 #endif
3817                 CAT16(cat, &ashort);
3818             }
3819             break;
3820         case 'S':
3821         case 's':
3822             while (len-- > 0) {
3823                 fromstr = NEXTFROM;
3824                 ashort = (I16)SvIV(fromstr);
3825                 CAT16(cat, &ashort);
3826             }
3827             break;
3828         case 'I':
3829             while (len-- > 0) {
3830                 fromstr = NEXTFROM;
3831                 auint = SvUV(fromstr);
3832                 sv_catpvn(cat, (char*)&auint, sizeof(unsigned int));
3833             }
3834             break;
3835         case 'w':
3836             while (len-- > 0) {
3837                 fromstr = NEXTFROM;
3838                 adouble = floor(SvNV(fromstr));
3839
3840                 if (adouble < 0)
3841                     croak("Cannot compress negative numbers");
3842
3843                 if (
3844 #ifdef BW_BITS
3845                     adouble <= BW_MASK
3846 #else
3847 #ifdef CXUX_BROKEN_CONSTANT_CONVERT
3848                     adouble <= UV_MAX_cxux
3849 #else
3850                     adouble <= UV_MAX
3851 #endif
3852 #endif
3853                     )
3854                 {
3855                     char   buf[1 + sizeof(UV)];
3856                     char  *in = buf + sizeof(buf);
3857                     UV     auv = U_V(adouble);;
3858
3859                     do {
3860                         *--in = (auv & 0x7f) | 0x80;
3861                         auv >>= 7;
3862                     } while (auv);
3863                     buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
3864                     sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
3865                 }
3866                 else if (SvPOKp(fromstr)) {  /* decimal string arithmetics */
3867                     char           *from, *result, *in;
3868                     SV             *norm;
3869                     STRLEN          len;
3870                     bool            done;
3871
3872                     /* Copy string and check for compliance */
3873                     from = SvPV(fromstr, len);
3874                     if ((norm = is_an_int(from, len)) == NULL)
3875                         croak("can compress only unsigned integer");
3876
3877                     New('w', result, len, char);
3878                     in = result + len;
3879                     done = FALSE;
3880                     while (!done)
3881                         *--in = div128(norm, &done) | 0x80;
3882                     result[len - 1] &= 0x7F; /* clear continue bit */
3883                     sv_catpvn(cat, in, (result + len) - in);
3884                     Safefree(result);
3885                     SvREFCNT_dec(norm); /* free norm */
3886                 }
3887                 else if (SvNOKp(fromstr)) {
3888                     char   buf[sizeof(double) * 2];     /* 8/7 <= 2 */
3889                     char  *in = buf + sizeof(buf);
3890
3891                     do {
3892                         double next = floor(adouble / 128);
3893                         *--in = (unsigned char)(adouble - (next * 128)) | 0x80;
3894                         if (--in < buf)  /* this cannot happen ;-) */
3895                             croak ("Cannot compress integer");
3896                         adouble = next;
3897                     } while (adouble > 0);
3898                     buf[sizeof(buf) - 1] &= 0x7f; /* clear continue bit */
3899                     sv_catpvn(cat, in, (buf + sizeof(buf)) - in);
3900                 }
3901                 else
3902                     croak("Cannot compress non integer");
3903             }
3904             break;
3905         case 'i':
3906             while (len-- > 0) {
3907                 fromstr = NEXTFROM;
3908                 aint = SvIV(fromstr);
3909                 sv_catpvn(cat, (char*)&aint, sizeof(int));
3910             }
3911             break;
3912         case 'N':
3913             while (len-- > 0) {
3914                 fromstr = NEXTFROM;
3915                 aulong = SvUV(fromstr);
3916 #ifdef HAS_HTONL
3917                 aulong = htonl(aulong);
3918 #endif
3919                 CAT32(cat, &aulong);
3920             }
3921             break;
3922         case 'V':
3923             while (len-- > 0) {
3924                 fromstr = NEXTFROM;
3925                 aulong = SvUV(fromstr);
3926 #ifdef HAS_HTOVL
3927                 aulong = htovl(aulong);
3928 #endif
3929                 CAT32(cat, &aulong);
3930             }
3931             break;
3932         case 'L':
3933             while (len-- > 0) {
3934                 fromstr = NEXTFROM;
3935                 aulong = SvUV(fromstr);
3936                 CAT32(cat, &aulong);
3937             }
3938             break;
3939         case 'l':
3940             while (len-- > 0) {
3941                 fromstr = NEXTFROM;
3942                 along = SvIV(fromstr);
3943                 CAT32(cat, &along);
3944             }
3945             break;
3946 #ifdef HAS_QUAD
3947         case 'Q':
3948             while (len-- > 0) {
3949                 fromstr = NEXTFROM;
3950                 auquad = (unsigned Quad_t)SvIV(fromstr);
3951                 sv_catpvn(cat, (char*)&auquad, sizeof(unsigned Quad_t));
3952             }
3953             break;
3954         case 'q':
3955             while (len-- > 0) {
3956                 fromstr = NEXTFROM;
3957                 aquad = (Quad_t)SvIV(fromstr);
3958                 sv_catpvn(cat, (char*)&aquad, sizeof(Quad_t));
3959             }
3960             break;
3961 #endif /* HAS_QUAD */
3962         case 'P':
3963             len = 1;            /* assume SV is correct length */
3964             /* FALL THROUGH */
3965         case 'p':
3966             while (len-- > 0) {
3967                 fromstr = NEXTFROM;
3968                 if (fromstr == &sv_undef)
3969                     aptr = NULL;
3970                 else {
3971                     /* XXX better yet, could spirit away the string to
3972                      * a safe spot and hang on to it until the result
3973                      * of pack() (and all copies of the result) are
3974                      * gone.
3975                      */
3976                     if (dowarn && (SvTEMP(fromstr) || SvPADTMP(fromstr)))
3977                         warn("Attempt to pack pointer to temporary value");
3978                     if (SvPOK(fromstr) || SvNIOK(fromstr))
3979                         aptr = SvPV(fromstr,na);
3980                     else
3981                         aptr = SvPV_force(fromstr,na);
3982                 }
3983                 sv_catpvn(cat, (char*)&aptr, sizeof(char*));
3984             }
3985             break;
3986         case 'u':
3987             fromstr = NEXTFROM;
3988             aptr = SvPV(fromstr, fromlen);
3989             SvGROW(cat, fromlen * 4 / 3);
3990             if (len <= 1)
3991                 len = 45;
3992             else
3993                 len = len / 3 * 3;
3994             while (fromlen > 0) {
3995                 I32 todo;
3996
3997                 if (fromlen > len)
3998                     todo = len;
3999                 else
4000                     todo = fromlen;
4001                 doencodes(cat, aptr, todo);
4002                 fromlen -= todo;
4003                 aptr += todo;
4004             }
4005             break;
4006         }
4007     }
4008     SvSETMAGIC(cat);
4009     SP = ORIGMARK;
4010     PUSHs(cat);
4011     RETURN;
4012 }
4013 #undef NEXTFROM
4014
4015 PP(pp_split)
4016 {
4017     dSP; dTARG;
4018     AV *ary;
4019     register I32 limit = POPi;                  /* note, negative is forever */
4020     SV *sv = POPs;
4021     STRLEN len;
4022     register char *s = SvPV(sv, len);
4023     char *strend = s + len;
4024     register PMOP *pm;
4025     register REGEXP *rx;
4026     register SV *dstr;
4027     register char *m;
4028     I32 iters = 0;
4029     I32 maxiters = (strend - s) + 10;
4030     I32 i;
4031     char *orig;
4032     I32 origlimit = limit;
4033     I32 realarray = 0;
4034     I32 base;
4035     AV *oldstack = curstack;
4036     I32 gimme = GIMME_V;
4037     I32 oldsave = savestack_ix;
4038
4039 #ifdef DEBUGGING
4040     Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*);
4041 #else
4042     pm = (PMOP*)POPs;
4043 #endif
4044     if (!pm || !s)
4045         DIE("panic: do_split");
4046     rx = pm->op_pmregexp;
4047
4048     TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
4049              (pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE)));
4050
4051     if (pm->op_pmreplroot)
4052         ary = GvAVn((GV*)pm->op_pmreplroot);
4053     else if (gimme != G_ARRAY)
4054 #ifdef USE_THREADS
4055         ary = (AV*)curpad[0];
4056 #else
4057         ary = GvAVn(defgv);
4058 #endif /* USE_THREADS */
4059     else
4060         ary = Nullav;
4061     if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
4062         realarray = 1;
4063         if (!AvREAL(ary)) {
4064             AvREAL_on(ary);
4065             for (i = AvFILL(ary); i >= 0; i--)
4066                 AvARRAY(ary)[i] = &sv_undef;    /* don't free mere refs */
4067         }
4068         av_extend(ary,0);
4069         av_clear(ary);
4070         /* temporarily switch stacks */
4071         SWITCHSTACK(curstack, ary);
4072     }
4073     base = SP - stack_base;
4074     orig = s;
4075     if (pm->op_pmflags & PMf_SKIPWHITE) {
4076         if (pm->op_pmflags & PMf_LOCALE) {
4077             while (isSPACE_LC(*s))
4078                 s++;
4079         }
4080         else {
4081             while (isSPACE(*s))
4082                 s++;
4083         }
4084     }
4085     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
4086         SAVEINT(multiline);
4087         multiline = pm->op_pmflags & PMf_MULTILINE;
4088     }
4089
4090     if (!limit)
4091         limit = maxiters + 2;
4092     if (pm->op_pmflags & PMf_WHITE) {
4093         while (--limit) {
4094             m = s;
4095             while (m < strend &&
4096                    !((pm->op_pmflags & PMf_LOCALE)
4097                      ? isSPACE_LC(*m) : isSPACE(*m)))
4098                 ++m;
4099             if (m >= strend)
4100                 break;
4101
4102             dstr = NEWSV(30, m-s);
4103             sv_setpvn(dstr, s, m-s);
4104             if (!realarray)
4105                 sv_2mortal(dstr);
4106             XPUSHs(dstr);
4107
4108             s = m + 1;
4109             while (s < strend &&
4110                    ((pm->op_pmflags & PMf_LOCALE)
4111                     ? isSPACE_LC(*s) : isSPACE(*s)))
4112                 ++s;
4113         }
4114     }
4115     else if (strEQ("^", rx->precomp)) {
4116         while (--limit) {
4117             /*SUPPRESS 530*/
4118             for (m = s; m < strend && *m != '\n'; m++) ;
4119             m++;
4120             if (m >= strend)
4121                 break;
4122             dstr = NEWSV(30, m-s);
4123             sv_setpvn(dstr, s, m-s);
4124             if (!realarray)
4125                 sv_2mortal(dstr);
4126             XPUSHs(dstr);
4127             s = m;
4128         }
4129     }
4130     else if (pm->op_pmshort && !rx->nparens) {
4131         i = SvCUR(pm->op_pmshort);
4132         if (i == 1) {
4133             i = *SvPVX(pm->op_pmshort);
4134             while (--limit) {
4135                 /*SUPPRESS 530*/
4136                 for (m = s; m < strend && *m != i; m++) ;
4137                 if (m >= strend)
4138                     break;
4139                 dstr = NEWSV(30, m-s);
4140                 sv_setpvn(dstr, s, m-s);
4141                 if (!realarray)
4142                     sv_2mortal(dstr);
4143                 XPUSHs(dstr);
4144                 s = m + 1;
4145             }
4146         }
4147         else {
4148 #ifndef lint
4149             while (s < strend && --limit &&
4150               (m=fbm_instr((unsigned char*)s, (unsigned char*)strend,
4151                     pm->op_pmshort)) )
4152 #endif
4153             {
4154                 dstr = NEWSV(31, m-s);
4155                 sv_setpvn(dstr, s, m-s);
4156                 if (!realarray)
4157                     sv_2mortal(dstr);
4158                 XPUSHs(dstr);
4159                 s = m + i;
4160             }
4161         }
4162     }
4163     else {
4164         maxiters += (strend - s) * rx->nparens;
4165         while (s < strend && --limit &&
4166                pregexec(rx, s, strend, orig, 1, Nullsv, TRUE))
4167         {
4168             TAINT_IF(rx->exec_tainted);
4169             if (rx->subbase
4170               && rx->subbase != orig) {
4171                 m = s;
4172                 s = orig;
4173                 orig = rx->subbase;
4174                 s = orig + (m - s);
4175                 strend = s + (strend - m);
4176             }
4177             m = rx->startp[0];
4178             dstr = NEWSV(32, m-s);
4179             sv_setpvn(dstr, s, m-s);
4180             if (!realarray)
4181                 sv_2mortal(dstr);
4182             XPUSHs(dstr);
4183             if (rx->nparens) {
4184                 for (i = 1; i <= rx->nparens; i++) {
4185                     s = rx->startp[i];
4186                     m = rx->endp[i];
4187                     if (m && s) {
4188                         dstr = NEWSV(33, m-s);
4189                         sv_setpvn(dstr, s, m-s);
4190                     }
4191                     else
4192                         dstr = NEWSV(33, 0);
4193                     if (!realarray)
4194                         sv_2mortal(dstr);
4195                     XPUSHs(dstr);
4196                 }
4197             }
4198             s = rx->endp[0];
4199         }
4200     }
4201     LEAVE_SCOPE(oldsave);
4202     iters = (SP - stack_base) - base;
4203     if (iters > maxiters)
4204         DIE("Split loop");
4205
4206     /* keep field after final delim? */
4207     if (s < strend || (iters && origlimit)) {
4208         dstr = NEWSV(34, strend-s);
4209         sv_setpvn(dstr, s, strend-s);
4210         if (!realarray)
4211             sv_2mortal(dstr);
4212         XPUSHs(dstr);
4213         iters++;
4214     }
4215     else if (!origlimit) {
4216         while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0))
4217             iters--, SP--;
4218     }
4219     if (realarray) {
4220         SWITCHSTACK(ary, oldstack);
4221         if (SvSMAGICAL(ary)) {
4222             PUTBACK;
4223             mg_set((SV*)ary);
4224             SPAGAIN;
4225         }
4226         if (gimme == G_ARRAY) {
4227             EXTEND(SP, iters);
4228             Copy(AvARRAY(ary), SP + 1, iters, SV*);
4229             SP += iters;
4230             RETURN;
4231         }
4232     }
4233     else {
4234         if (gimme == G_ARRAY)
4235             RETURN;
4236     }
4237     if (iters || !pm->op_pmreplroot) {
4238         GETTARGET;
4239         PUSHi(iters);
4240         RETURN;
4241     }
4242     RETPUSHUNDEF;
4243 }
4244
4245 #ifdef USE_THREADS
4246 void
4247 unlock_condpair(svv)
4248 void *svv;
4249 {
4250     dTHR;
4251     MAGIC *mg = mg_find((SV*)svv, 'm');
4252
4253     if (!mg)
4254         croak("panic: unlock_condpair unlocking non-mutex");
4255     MUTEX_LOCK(MgMUTEXP(mg));
4256     if (MgOWNER(mg) != thr)
4257         croak("panic: unlock_condpair unlocking mutex that we don't own");
4258     MgOWNER(mg) = 0;
4259     COND_SIGNAL(MgOWNERCONDP(mg));
4260     DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: unlock 0x%lx\n",
4261                           (unsigned long)thr, (unsigned long)svv);)
4262     MUTEX_UNLOCK(MgMUTEXP(mg));
4263 }
4264 #endif /* USE_THREADS */
4265
4266 PP(pp_lock)
4267 {
4268     dSP;
4269     dTOPss;
4270     SV *retsv = sv;
4271 #ifdef USE_THREADS
4272     MAGIC *mg;
4273
4274     if (SvROK(sv))
4275         sv = SvRV(sv);
4276
4277     mg = condpair_magic(sv);
4278     MUTEX_LOCK(MgMUTEXP(mg));
4279     if (MgOWNER(mg) == thr)
4280         MUTEX_UNLOCK(MgMUTEXP(mg));
4281     else {
4282         while (MgOWNER(mg))
4283             COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
4284         MgOWNER(mg) = thr;
4285         DEBUG_L(PerlIO_printf(PerlIO_stderr(), "0x%lx: pp_lock lock 0x%lx\n",
4286                               (unsigned long)thr, (unsigned long)sv);)
4287         MUTEX_UNLOCK(MgMUTEXP(mg));
4288         SvREFCNT_inc(sv);       /* keep alive until magic_mutexfree */
4289         save_destructor(unlock_condpair, sv);
4290     }
4291 #endif /* USE_THREADS */
4292     if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
4293         || SvTYPE(retsv) == SVt_PVCV) {
4294         retsv = refto(retsv);
4295     }
4296     SETs(retsv);
4297     RETURN;
4298 }