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