pp.c

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