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