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