pp.c

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