pp.c

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