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     char *tmps = SvPV(left, n_a);
3099 #ifdef FCRYPT
3100     sv_setpv(TARG, fcrypt(tmps, SvPV(right, n_a)));
3101 #else
3102     sv_setpv(TARG, PerlProc_crypt(tmps, SvPV(right, n_a)));
3103 #endif
3104 #else
3105     DIE(aTHX_
3106       "The crypt() function is unimplemented due to excessive paranoia.");
3107 #endif
3108     SETs(TARG);
3109     RETURN;
3110 }
3111
3112 PP(pp_ucfirst)
3113 {
3114     dSP;
3115     SV *sv = TOPs;
3116     register U8 *s;
3117     STRLEN slen;
3118
3119     if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && UTF8_IS_START(*s)) {
3120         STRLEN ulen;
3121         U8 tmpbuf[UTF8_MAXLEN+1];
3122         U8 *tend;
3123         UV uv;
3124
3125         if (IN_LOCALE_RUNTIME) {
3126             TAINT;
3127             SvTAINTED_on(sv);
3128             uv = toTITLE_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
3129         }
3130         else {
3131             uv   = toTITLE_utf8(s);
3132             ulen = UNISKIP(uv);
3133         }
3134
3135         tend = uvchr_to_utf8(tmpbuf, uv);
3136
3137         if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
3138             dTARGET;
3139             sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
3140             sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
3141             SvUTF8_on(TARG);
3142             SETs(TARG);
3143         }
3144         else {
3145             s = (U8*)SvPV_force(sv, slen);
3146             Copy(tmpbuf, s, ulen, U8);
3147         }
3148     }
3149     else {
3150         if (!SvPADTMP(sv) || SvREADONLY(sv)) {
3151             dTARGET;
3152             SvUTF8_off(TARG);                           /* decontaminate */
3153             sv_setsv(TARG, sv);
3154             sv = TARG;
3155             SETs(sv);
3156         }
3157         s = (U8*)SvPV_force(sv, slen);
3158         if (*s) {
3159             if (IN_LOCALE_RUNTIME) {
3160                 TAINT;
3161                 SvTAINTED_on(sv);
3162                 *s = toUPPER_LC(*s);
3163             }
3164             else
3165                 *s = toUPPER(*s);
3166         }
3167     }
3168     if (SvSMAGICAL(sv))
3169         mg_set(sv);
3170     RETURN;
3171 }
3172
3173 PP(pp_lcfirst)
3174 {
3175     dSP;
3176     SV *sv = TOPs;
3177     register U8 *s;
3178     STRLEN slen;
3179
3180     if (DO_UTF8(sv) && (s = (U8*)SvPV(sv, slen)) && slen && UTF8_IS_START(*s)) {
3181         STRLEN ulen;
3182         U8 tmpbuf[UTF8_MAXLEN+1];
3183         U8 *tend;
3184         UV uv;
3185
3186         if (IN_LOCALE_RUNTIME) {
3187             TAINT;
3188             SvTAINTED_on(sv);
3189             uv = toLOWER_LC_uvchr(utf8n_to_uvchr(s, slen, &ulen, 0));
3190         }
3191         else {
3192             uv   = toLOWER_utf8(s);
3193             ulen = UNISKIP(uv);
3194         }
3195
3196         tend = uvchr_to_utf8(tmpbuf, uv);
3197
3198         if (!SvPADTMP(sv) || tend - tmpbuf != ulen || SvREADONLY(sv)) {
3199             dTARGET;
3200             sv_setpvn(TARG, (char*)tmpbuf, tend - tmpbuf);
3201             sv_catpvn(TARG, (char*)(s + ulen), slen - ulen);
3202             SvUTF8_on(TARG);
3203             SETs(TARG);
3204         }
3205         else {
3206             s = (U8*)SvPV_force(sv, slen);
3207             Copy(tmpbuf, s, ulen, U8);
3208         }
3209     }
3210     else {
3211         if (!SvPADTMP(sv) || SvREADONLY(sv)) {
3212             dTARGET;
3213             SvUTF8_off(TARG);                           /* decontaminate */
3214             sv_setsv(TARG, sv);
3215             sv = TARG;
3216             SETs(sv);
3217         }
3218         s = (U8*)SvPV_force(sv, slen);
3219         if (*s) {
3220             if (IN_LOCALE_RUNTIME) {
3221                 TAINT;
3222                 SvTAINTED_on(sv);
3223                 *s = toLOWER_LC(*s);
3224             }
3225             else
3226                 *s = toLOWER(*s);
3227         }
3228     }
3229     if (SvSMAGICAL(sv))
3230         mg_set(sv);
3231     RETURN;
3232 }
3233
3234 PP(pp_uc)
3235 {
3236     dSP;
3237     SV *sv = TOPs;
3238     register U8 *s;
3239     STRLEN len;
3240
3241     if (DO_UTF8(sv)) {
3242         dTARGET;
3243         STRLEN ulen;
3244         register U8 *d;
3245         U8 *send;
3246
3247         s = (U8*)SvPV(sv,len);
3248         if (!len) {
3249             SvUTF8_off(TARG);                           /* decontaminate */
3250             sv_setpvn(TARG, "", 0);
3251             SETs(TARG);
3252         }
3253         else {
3254             (void)SvUPGRADE(TARG, SVt_PV);
3255             SvGROW(TARG, (len * 2) + 1);
3256             (void)SvPOK_only(TARG);
3257             d = (U8*)SvPVX(TARG);
3258             send = s + len;
3259             if (IN_LOCALE_RUNTIME) {
3260                 TAINT;
3261                 SvTAINTED_on(TARG);
3262                 while (s < send) {
3263                     d = uvchr_to_utf8(d, toUPPER_LC_uvchr( utf8n_to_uvchr(s, len, &ulen, 0)));
3264                     s += ulen;
3265                 }
3266             }
3267             else {
3268                 while (s < send) {
3269                     d = uvchr_to_utf8(d, toUPPER_utf8( s ));
3270                     s += UTF8SKIP(s);
3271                 }
3272             }
3273             *d = '\0';
3274             SvUTF8_on(TARG);
3275             SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
3276             SETs(TARG);
3277         }
3278     }
3279     else {
3280         if (!SvPADTMP(sv) || SvREADONLY(sv)) {
3281             dTARGET;
3282             SvUTF8_off(TARG);                           /* decontaminate */
3283             sv_setsv(TARG, sv);
3284             sv = TARG;
3285             SETs(sv);
3286         }
3287         s = (U8*)SvPV_force(sv, len);
3288         if (len) {
3289             register U8 *send = s + len;
3290
3291             if (IN_LOCALE_RUNTIME) {
3292                 TAINT;
3293                 SvTAINTED_on(sv);
3294                 for (; s < send; s++)
3295                     *s = toUPPER_LC(*s);
3296             }
3297             else {
3298                 for (; s < send; s++)
3299                     *s = toUPPER(*s);
3300             }
3301         }
3302     }
3303     if (SvSMAGICAL(sv))
3304         mg_set(sv);
3305     RETURN;
3306 }
3307
3308 PP(pp_lc)
3309 {
3310     dSP;
3311     SV *sv = TOPs;
3312     register U8 *s;
3313     STRLEN len;
3314
3315     if (DO_UTF8(sv)) {
3316         dTARGET;
3317         STRLEN ulen;
3318         register U8 *d;
3319         U8 *send;
3320
3321         s = (U8*)SvPV(sv,len);
3322         if (!len) {
3323             SvUTF8_off(TARG);                           /* decontaminate */
3324             sv_setpvn(TARG, "", 0);
3325             SETs(TARG);
3326         }
3327         else {
3328             (void)SvUPGRADE(TARG, SVt_PV);
3329             SvGROW(TARG, (len * 2) + 1);
3330             (void)SvPOK_only(TARG);
3331             d = (U8*)SvPVX(TARG);
3332             send = s + len;
3333             if (IN_LOCALE_RUNTIME) {
3334                 TAINT;
3335                 SvTAINTED_on(TARG);
3336                 while (s < send) {
3337                     d = uvchr_to_utf8(d, toLOWER_LC_uvchr( utf8n_to_uvchr(s, len, &ulen, 0)));
3338                     s += ulen;
3339                 }
3340             }
3341             else {
3342                 while (s < send) {
3343                     d = uvchr_to_utf8(d, toLOWER_utf8(s));
3344                     s += UTF8SKIP(s);
3345                 }
3346             }
3347             *d = '\0';
3348             SvUTF8_on(TARG);
3349             SvCUR_set(TARG, d - (U8*)SvPVX(TARG));
3350             SETs(TARG);
3351         }
3352     }
3353     else {
3354         if (!SvPADTMP(sv) || SvREADONLY(sv)) {
3355             dTARGET;
3356             SvUTF8_off(TARG);                           /* decontaminate */
3357             sv_setsv(TARG, sv);
3358             sv = TARG;
3359             SETs(sv);
3360         }
3361
3362         s = (U8*)SvPV_force(sv, len);
3363         if (len) {
3364             register U8 *send = s + len;
3365
3366             if (IN_LOCALE_RUNTIME) {
3367                 TAINT;
3368                 SvTAINTED_on(sv);
3369                 for (; s < send; s++)
3370                     *s = toLOWER_LC(*s);
3371             }
3372             else {
3373                 for (; s < send; s++)
3374                     *s = toLOWER(*s);
3375             }
3376         }
3377     }
3378     if (SvSMAGICAL(sv))
3379         mg_set(sv);
3380     RETURN;
3381 }
3382
3383 PP(pp_quotemeta)
3384 {
3385     dSP; dTARGET;
3386     SV *sv = TOPs;
3387     STRLEN len;
3388     register char *s = SvPV(sv,len);
3389     register char *d;
3390
3391     SvUTF8_off(TARG);                           /* decontaminate */
3392     if (len) {
3393         (void)SvUPGRADE(TARG, SVt_PV);
3394         SvGROW(TARG, (len * 2) + 1);
3395         d = SvPVX(TARG);
3396         if (DO_UTF8(sv)) {
3397             while (len) {
3398                 if (UTF8_IS_CONTINUED(*s)) {
3399                     STRLEN ulen = UTF8SKIP(s);
3400                     if (ulen > len)
3401                         ulen = len;
3402                     len -= ulen;
3403                     while (ulen--)
3404                         *d++ = *s++;
3405                 }
3406                 else {
3407                     if (!isALNUM(*s))
3408                         *d++ = '\\';
3409                     *d++ = *s++;
3410                     len--;
3411                 }
3412             }
3413             SvUTF8_on(TARG);
3414         }
3415         else {
3416             while (len--) {
3417                 if (!isALNUM(*s))
3418                     *d++ = '\\';
3419                 *d++ = *s++;
3420             }
3421         }
3422         *d = '\0';
3423         SvCUR_set(TARG, d - SvPVX(TARG));
3424         (void)SvPOK_only_UTF8(TARG);
3425     }
3426     else
3427         sv_setpvn(TARG, s, len);
3428     SETs(TARG);
3429     if (SvSMAGICAL(TARG))
3430         mg_set(TARG);
3431     RETURN;
3432 }
3433
3434 /* Arrays. */
3435
3436 PP(pp_aslice)
3437 {
3438     dSP; dMARK; dORIGMARK;
3439     register SV** svp;
3440     register AV* av = (AV*)POPs;
3441     register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
3442     I32 arybase = PL_curcop->cop_arybase;
3443     I32 elem;
3444
3445     if (SvTYPE(av) == SVt_PVAV) {
3446         if (lval && PL_op->op_private & OPpLVAL_INTRO) {
3447             I32 max = -1;
3448             for (svp = MARK + 1; svp <= SP; svp++) {
3449                 elem = SvIVx(*svp);
3450                 if (elem > max)
3451                     max = elem;
3452             }
3453             if (max > AvMAX(av))
3454                 av_extend(av, max);
3455         }
3456         while (++MARK <= SP) {
3457             elem = SvIVx(*MARK);
3458
3459             if (elem > 0)
3460                 elem -= arybase;
3461             svp = av_fetch(av, elem, lval);
3462             if (lval) {
3463                 if (!svp || *svp == &PL_sv_undef)
3464                     DIE(aTHX_ PL_no_aelem, elem);
3465                 if (PL_op->op_private & OPpLVAL_INTRO)
3466                     save_aelem(av, elem, svp);
3467             }
3468             *MARK = svp ? *svp : &PL_sv_undef;
3469         }
3470     }
3471     if (GIMME != G_ARRAY) {
3472         MARK = ORIGMARK;
3473         *++MARK = *SP;
3474         SP = MARK;
3475     }
3476     RETURN;
3477 }
3478
3479 /* Associative arrays. */
3480
3481 PP(pp_each)
3482 {
3483     dSP;
3484     HV *hash = (HV*)POPs;
3485     HE *entry;
3486     I32 gimme = GIMME_V;
3487     I32 realhv = (SvTYPE(hash) == SVt_PVHV);
3488
3489     PUTBACK;
3490     /* might clobber stack_sp */
3491     entry = realhv ? hv_iternext(hash) : avhv_iternext((AV*)hash);
3492     SPAGAIN;
3493
3494     EXTEND(SP, 2);
3495     if (entry) {
3496         PUSHs(hv_iterkeysv(entry));     /* won't clobber stack_sp */
3497         if (gimme == G_ARRAY) {
3498             SV *val;
3499             PUTBACK;
3500             /* might clobber stack_sp */
3501             val = realhv ?
3502                   hv_iterval(hash, entry) : avhv_iterval((AV*)hash, entry);
3503             SPAGAIN;
3504             PUSHs(val);
3505         }
3506     }
3507     else if (gimme == G_SCALAR)
3508         RETPUSHUNDEF;
3509
3510     RETURN;
3511 }
3512
3513 PP(pp_values)
3514 {
3515     return do_kv();
3516 }
3517
3518 PP(pp_keys)
3519 {
3520     return do_kv();
3521 }
3522
3523 PP(pp_delete)
3524 {
3525     dSP;
3526     I32 gimme = GIMME_V;
3527     I32 discard = (gimme == G_VOID) ? G_DISCARD : 0;
3528     SV *sv;
3529     HV *hv;
3530
3531     if (PL_op->op_private & OPpSLICE) {
3532         dMARK; dORIGMARK;
3533         U32 hvtype;
3534         hv = (HV*)POPs;
3535         hvtype = SvTYPE(hv);
3536         if (hvtype == SVt_PVHV) {                       /* hash element */
3537             while (++MARK <= SP) {
3538                 sv = hv_delete_ent(hv, *MARK, discard, 0);
3539                 *MARK = sv ? sv : &PL_sv_undef;
3540             }
3541         }
3542         else if (hvtype == SVt_PVAV) {
3543             if (PL_op->op_flags & OPf_SPECIAL) {        /* array element */
3544                 while (++MARK <= SP) {
3545                     sv = av_delete((AV*)hv, SvIV(*MARK), discard);
3546                     *MARK = sv ? sv : &PL_sv_undef;
3547                 }
3548             }
3549             else {                                      /* pseudo-hash element */
3550                 while (++MARK <= SP) {
3551                     sv = avhv_delete_ent((AV*)hv, *MARK, discard, 0);
3552                     *MARK = sv ? sv : &PL_sv_undef;
3553                 }
3554             }
3555         }
3556         else
3557             DIE(aTHX_ "Not a HASH reference");
3558         if (discard)
3559             SP = ORIGMARK;
3560         else if (gimme == G_SCALAR) {
3561             MARK = ORIGMARK;
3562             *++MARK = *SP;
3563             SP = MARK;
3564         }
3565     }
3566     else {
3567         SV *keysv = POPs;
3568         hv = (HV*)POPs;
3569         if (SvTYPE(hv) == SVt_PVHV)
3570             sv = hv_delete_ent(hv, keysv, discard, 0);
3571         else if (SvTYPE(hv) == SVt_PVAV) {
3572             if (PL_op->op_flags & OPf_SPECIAL)
3573                 sv = av_delete((AV*)hv, SvIV(keysv), discard);
3574             else
3575                 sv = avhv_delete_ent((AV*)hv, keysv, discard, 0);
3576         }
3577         else
3578             DIE(aTHX_ "Not a HASH reference");
3579         if (!sv)
3580             sv = &PL_sv_undef;
3581         if (!discard)
3582             PUSHs(sv);
3583     }
3584     RETURN;
3585 }
3586
3587 PP(pp_exists)
3588 {
3589     dSP;
3590     SV *tmpsv;
3591     HV *hv;
3592
3593     if (PL_op->op_private & OPpEXISTS_SUB) {
3594         GV *gv;
3595         CV *cv;
3596         SV *sv = POPs;
3597         cv = sv_2cv(sv, &hv, &gv, FALSE);
3598         if (cv)
3599             RETPUSHYES;
3600         if (gv && isGV(gv) && GvCV(gv) && !GvCVGEN(gv))
3601             RETPUSHYES;
3602         RETPUSHNO;
3603     }
3604     tmpsv = POPs;
3605     hv = (HV*)POPs;
3606     if (SvTYPE(hv) == SVt_PVHV) {
3607         if (hv_exists_ent(hv, tmpsv, 0))
3608             RETPUSHYES;
3609     }
3610     else if (SvTYPE(hv) == SVt_PVAV) {
3611         if (PL_op->op_flags & OPf_SPECIAL) {            /* array element */
3612             if (av_exists((AV*)hv, SvIV(tmpsv)))
3613                 RETPUSHYES;
3614         }
3615         else if (avhv_exists_ent((AV*)hv, tmpsv, 0))    /* pseudo-hash element */
3616             RETPUSHYES;
3617     }
3618     else {
3619         DIE(aTHX_ "Not a HASH reference");
3620     }
3621     RETPUSHNO;
3622 }
3623
3624 PP(pp_hslice)
3625 {
3626     dSP; dMARK; dORIGMARK;
3627     register HV *hv = (HV*)POPs;
3628     register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
3629     I32 realhv = (SvTYPE(hv) == SVt_PVHV);
3630
3631     if (!realhv && PL_op->op_private & OPpLVAL_INTRO)
3632         DIE(aTHX_ "Can't localize pseudo-hash element");
3633
3634     if (realhv || SvTYPE(hv) == SVt_PVAV) {
3635         while (++MARK <= SP) {
3636             SV *keysv = *MARK;
3637             SV **svp;
3638             I32 preeminent = SvRMAGICAL(hv) ? 1 :
3639                                 realhv ? hv_exists_ent(hv, keysv, 0)
3640                                        : avhv_exists_ent((AV*)hv, keysv, 0);
3641             if (realhv) {
3642                 HE *he = hv_fetch_ent(hv, keysv, lval, 0);
3643                 svp = he ? &HeVAL(he) : 0;
3644             }
3645             else {
3646                 svp = avhv_fetch_ent((AV*)hv, keysv, lval, 0);
3647             }
3648             if (lval) {
3649                 if (!svp || *svp == &PL_sv_undef) {
3650                     STRLEN n_a;
3651                     DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
3652                 }
3653                 if (PL_op->op_private & OPpLVAL_INTRO) {
3654                     if (preeminent)
3655                         save_helem(hv, keysv, svp);
3656                     else {
3657                         STRLEN keylen;
3658                         char *key = SvPV(keysv, keylen);
3659                         SAVEDELETE(hv, savepvn(key,keylen), keylen);
3660                     }
3661                 }
3662             }
3663             *MARK = svp ? *svp : &PL_sv_undef;
3664         }
3665     }
3666     if (GIMME != G_ARRAY) {
3667         MARK = ORIGMARK;
3668         *++MARK = *SP;
3669         SP = MARK;
3670     }
3671     RETURN;
3672 }
3673
3674 /* List operators. */
3675
3676 PP(pp_list)
3677 {
3678     dSP; dMARK;
3679     if (GIMME != G_ARRAY) {
3680         if (++MARK <= SP)
3681             *MARK = *SP;                /* unwanted list, return last item */
3682         else
3683             *MARK = &PL_sv_undef;
3684         SP = MARK;
3685     }
3686     RETURN;
3687 }
3688
3689 PP(pp_lslice)
3690 {
3691     dSP;
3692     SV **lastrelem = PL_stack_sp;
3693     SV **lastlelem = PL_stack_base + POPMARK;
3694     SV **firstlelem = PL_stack_base + POPMARK + 1;
3695     register SV **firstrelem = lastlelem + 1;
3696     I32 arybase = PL_curcop->cop_arybase;
3697     I32 lval = PL_op->op_flags & OPf_MOD;
3698     I32 is_something_there = lval;
3699
3700     register I32 max = lastrelem - lastlelem;
3701     register SV **lelem;
3702     register I32 ix;
3703
3704     if (GIMME != G_ARRAY) {
3705         ix = SvIVx(*lastlelem);
3706         if (ix < 0)
3707             ix += max;
3708         else
3709             ix -= arybase;
3710         if (ix < 0 || ix >= max)
3711             *firstlelem = &PL_sv_undef;
3712         else
3713             *firstlelem = firstrelem[ix];
3714         SP = firstlelem;
3715         RETURN;
3716     }
3717
3718     if (max == 0) {
3719         SP = firstlelem - 1;
3720         RETURN;
3721     }
3722
3723     for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
3724         ix = SvIVx(*lelem);
3725         if (ix < 0)
3726             ix += max;
3727         else
3728             ix -= arybase;
3729         if (ix < 0 || ix >= max)
3730             *lelem = &PL_sv_undef;
3731         else {
3732             is_something_there = TRUE;
3733             if (!(*lelem = firstrelem[ix]))
3734                 *lelem = &PL_sv_undef;
3735         }
3736     }
3737     if (is_something_there)
3738         SP = lastlelem;
3739     else
3740         SP = firstlelem - 1;
3741     RETURN;
3742 }
3743
3744 PP(pp_anonlist)
3745 {
3746     dSP; dMARK; dORIGMARK;
3747     I32 items = SP - MARK;
3748     SV *av = sv_2mortal((SV*)av_make(items, MARK+1));
3749     SP = ORIGMARK;              /* av_make() might realloc stack_sp */
3750     XPUSHs(av);
3751     RETURN;
3752 }
3753
3754 PP(pp_anonhash)
3755 {
3756     dSP; dMARK; dORIGMARK;
3757     HV* hv = (HV*)sv_2mortal((SV*)newHV());
3758
3759     while (MARK < SP) {
3760         SV* key = *++MARK;
3761         SV *val = NEWSV(46, 0);
3762         if (MARK < SP)
3763             sv_setsv(val, *++MARK);
3764         else if (ckWARN(WARN_MISC))
3765             Perl_warner(aTHX_ WARN_MISC, "Odd number of elements in hash assignment");
3766         (void)hv_store_ent(hv,key,val,0);
3767     }
3768     SP = ORIGMARK;
3769     XPUSHs((SV*)hv);
3770     RETURN;
3771 }
3772
3773 PP(pp_splice)
3774 {
3775     dSP; dMARK; dORIGMARK;
3776     register AV *ary = (AV*)*++MARK;
3777     register SV **src;
3778     register SV **dst;
3779     register I32 i;
3780     register I32 offset;
3781     register I32 length;
3782     I32 newlen;
3783     I32 after;
3784     I32 diff;
3785     SV **tmparyval = 0;
3786     MAGIC *mg;
3787
3788     if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
3789         *MARK-- = SvTIED_obj((SV*)ary, mg);
3790         PUSHMARK(MARK);
3791         PUTBACK;
3792         ENTER;
3793         call_method("SPLICE",GIMME_V);
3794         LEAVE;
3795         SPAGAIN;
3796         RETURN;
3797     }
3798
3799     SP++;
3800
3801     if (++MARK < SP) {
3802         offset = i = SvIVx(*MARK);
3803         if (offset < 0)
3804             offset += AvFILLp(ary) + 1;
3805         else
3806             offset -= PL_curcop->cop_arybase;
3807         if (offset < 0)
3808             DIE(aTHX_ PL_no_aelem, i);
3809         if (++MARK < SP) {
3810             length = SvIVx(*MARK++);
3811             if (length < 0) {
3812                 length += AvFILLp(ary) - offset + 1;
3813                 if (length < 0)
3814                     length = 0;
3815             }
3816         }
3817         else
3818             length = AvMAX(ary) + 1;            /* close enough to infinity */
3819     }
3820     else {
3821         offset = 0;
3822         length = AvMAX(ary) + 1;
3823     }
3824     if (offset > AvFILLp(ary) + 1)
3825         offset = AvFILLp(ary) + 1;
3826     after = AvFILLp(ary) + 1 - (offset + length);
3827     if (after < 0) {                            /* not that much array */
3828         length += after;                        /* offset+length now in array */
3829         after = 0;
3830         if (!AvALLOC(ary))
3831             av_extend(ary, 0);
3832     }
3833
3834     /* At this point, MARK .. SP-1 is our new LIST */
3835
3836     newlen = SP - MARK;
3837     diff = newlen - length;
3838     if (newlen && !AvREAL(ary) && AvREIFY(ary))
3839         av_reify(ary);
3840
3841     if (diff < 0) {                             /* shrinking the area */
3842         if (newlen) {
3843             New(451, tmparyval, newlen, SV*);   /* so remember insertion */
3844             Copy(MARK, tmparyval, newlen, SV*);
3845         }
3846
3847         MARK = ORIGMARK + 1;
3848         if (GIMME == G_ARRAY) {                 /* copy return vals to stack */
3849             MEXTEND(MARK, length);
3850             Copy(AvARRAY(ary)+offset, MARK, length, SV*);
3851             if (AvREAL(ary)) {
3852                 EXTEND_MORTAL(length);
3853                 for (i = length, dst = MARK; i; i--) {
3854                     sv_2mortal(*dst);   /* free them eventualy */
3855                     dst++;
3856                 }
3857             }
3858             MARK += length - 1;
3859         }
3860         else {
3861             *MARK = AvARRAY(ary)[offset+length-1];
3862             if (AvREAL(ary)) {
3863                 sv_2mortal(*MARK);
3864                 for (i = length - 1, dst = &AvARRAY(ary)[offset]; i > 0; i--)
3865                     SvREFCNT_dec(*dst++);       /* free them now */
3866             }
3867         }
3868         AvFILLp(ary) += diff;
3869
3870         /* pull up or down? */
3871
3872         if (offset < after) {                   /* easier to pull up */
3873             if (offset) {                       /* esp. if nothing to pull */
3874                 src = &AvARRAY(ary)[offset-1];
3875                 dst = src - diff;               /* diff is negative */
3876                 for (i = offset; i > 0; i--)    /* can't trust Copy */
3877                     *dst-- = *src--;
3878             }
3879             dst = AvARRAY(ary);
3880             SvPVX(ary) = (char*)(AvARRAY(ary) - diff); /* diff is negative */
3881             AvMAX(ary) += diff;
3882         }
3883         else {
3884             if (after) {                        /* anything to pull down? */
3885                 src = AvARRAY(ary) + offset + length;
3886                 dst = src + diff;               /* diff is negative */
3887                 Move(src, dst, after, SV*);
3888             }
3889             dst = &AvARRAY(ary)[AvFILLp(ary)+1];
3890                                                 /* avoid later double free */
3891         }
3892         i = -diff;
3893         while (i)
3894             dst[--i] = &PL_sv_undef;
3895
3896         if (newlen) {
3897             for (src = tmparyval, dst = AvARRAY(ary) + offset;
3898               newlen; newlen--) {
3899                 *dst = NEWSV(46, 0);
3900                 sv_setsv(*dst++, *src++);
3901             }
3902             Safefree(tmparyval);
3903         }
3904     }
3905     else {                                      /* no, expanding (or same) */
3906         if (length) {
3907             New(452, tmparyval, length, SV*);   /* so remember deletion */
3908             Copy(AvARRAY(ary)+offset, tmparyval, length, SV*);
3909         }
3910
3911         if (diff > 0) {                         /* expanding */
3912
3913             /* push up or down? */
3914
3915             if (offset < after && diff <= AvARRAY(ary) - AvALLOC(ary)) {
3916                 if (offset) {
3917                     src = AvARRAY(ary);
3918                     dst = src - diff;
3919                     Move(src, dst, offset, SV*);
3920                 }
3921                 SvPVX(ary) = (char*)(AvARRAY(ary) - diff);/* diff is positive */
3922                 AvMAX(ary) += diff;
3923                 AvFILLp(ary) += diff;
3924             }
3925             else {
3926                 if (AvFILLp(ary) + diff >= AvMAX(ary))  /* oh, well */
3927                     av_extend(ary, AvFILLp(ary) + diff);
3928                 AvFILLp(ary) += diff;
3929
3930                 if (after) {
3931                     dst = AvARRAY(ary) + AvFILLp(ary);
3932                     src = dst - diff;
3933                     for (i = after; i; i--) {
3934                         *dst-- = *src--;
3935                     }
3936                 }
3937             }
3938         }
3939
3940         for (src = MARK, dst = AvARRAY(ary) + offset; newlen; newlen--) {
3941             *dst = NEWSV(46, 0);
3942             sv_setsv(*dst++, *src++);
3943         }
3944         MARK = ORIGMARK + 1;
3945         if (GIMME == G_ARRAY) {                 /* copy return vals to stack */
3946             if (length) {
3947                 Copy(tmparyval, MARK, length, SV*);
3948                 if (AvREAL(ary)) {
3949                     EXTEND_MORTAL(length);
3950                     for (i = length, dst = MARK; i; i--) {
3951                         sv_2mortal(*dst);       /* free them eventualy */
3952                         dst++;
3953                     }
3954                 }
3955                 Safefree(tmparyval);
3956             }
3957             MARK += length - 1;
3958         }
3959         else if (length--) {
3960             *MARK = tmparyval[length];
3961             if (AvREAL(ary)) {
3962                 sv_2mortal(*MARK);
3963                 while (length-- > 0)
3964                     SvREFCNT_dec(tmparyval[length]);
3965             }
3966             Safefree(tmparyval);
3967         }
3968         else
3969             *MARK = &PL_sv_undef;
3970     }
3971     SP = MARK;
3972     RETURN;
3973 }
3974
3975 PP(pp_push)
3976 {
3977     dSP; dMARK; dORIGMARK; dTARGET;
3978     register AV *ary = (AV*)*++MARK;
3979     register SV *sv = &PL_sv_undef;
3980     MAGIC *mg;
3981
3982     if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
3983         *MARK-- = SvTIED_obj((SV*)ary, mg);
3984         PUSHMARK(MARK);
3985         PUTBACK;
3986         ENTER;
3987         call_method("PUSH",G_SCALAR|G_DISCARD);
3988         LEAVE;
3989         SPAGAIN;
3990     }
3991     else {
3992         /* Why no pre-extend of ary here ? */
3993         for (++MARK; MARK <= SP; MARK++) {
3994             sv = NEWSV(51, 0);
3995             if (*MARK)
3996                 sv_setsv(sv, *MARK);
3997             av_push(ary, sv);
3998         }
3999     }
4000     SP = ORIGMARK;
4001     PUSHi( AvFILL(ary) + 1 );
4002     RETURN;
4003 }
4004
4005 PP(pp_pop)
4006 {
4007     dSP;
4008     AV *av = (AV*)POPs;
4009     SV *sv = av_pop(av);
4010     if (AvREAL(av))
4011         (void)sv_2mortal(sv);
4012     PUSHs(sv);
4013     RETURN;
4014 }
4015
4016 PP(pp_shift)
4017 {
4018     dSP;
4019     AV *av = (AV*)POPs;
4020     SV *sv = av_shift(av);
4021     EXTEND(SP, 1);
4022     if (!sv)
4023         RETPUSHUNDEF;
4024     if (AvREAL(av))
4025         (void)sv_2mortal(sv);
4026     PUSHs(sv);
4027     RETURN;
4028 }
4029
4030 PP(pp_unshift)
4031 {
4032     dSP; dMARK; dORIGMARK; dTARGET;
4033     register AV *ary = (AV*)*++MARK;
4034     register SV *sv;
4035     register I32 i = 0;
4036     MAGIC *mg;
4037
4038     if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
4039         *MARK-- = SvTIED_obj((SV*)ary, mg);
4040         PUSHMARK(MARK);
4041         PUTBACK;
4042         ENTER;
4043         call_method("UNSHIFT",G_SCALAR|G_DISCARD);
4044         LEAVE;
4045         SPAGAIN;
4046     }
4047     else {
4048         av_unshift(ary, SP - MARK);
4049         while (MARK < SP) {
4050             sv = NEWSV(27, 0);
4051             sv_setsv(sv, *++MARK);
4052             (void)av_store(ary, i++, sv);
4053         }
4054     }
4055     SP = ORIGMARK;
4056     PUSHi( AvFILL(ary) + 1 );
4057     RETURN;
4058 }
4059
4060 PP(pp_reverse)
4061 {
4062     dSP; dMARK;
4063     register SV *tmp;
4064     SV **oldsp = SP;
4065
4066     if (GIMME == G_ARRAY) {
4067         MARK++;
4068         while (MARK < SP) {
4069             tmp = *MARK;
4070             *MARK++ = *SP;
4071             *SP-- = tmp;
4072         }
4073         /* safe as long as stack cannot get extended in the above */
4074         SP = oldsp;
4075     }
4076     else {
4077         register char *up;
4078         register char *down;
4079         register I32 tmp;
4080         dTARGET;
4081         STRLEN len;
4082
4083         SvUTF8_off(TARG);                               /* decontaminate */
4084         if (SP - MARK > 1)
4085             do_join(TARG, &PL_sv_no, MARK, SP);
4086         else
4087             sv_setsv(TARG, (SP > MARK) ? *SP : DEFSV);
4088         up = SvPV_force(TARG, len);
4089         if (len > 1) {
4090             if (DO_UTF8(TARG)) {        /* first reverse each character */
4091                 U8* s = (U8*)SvPVX(TARG);
4092                 U8* send = (U8*)(s + len);
4093                 while (s < send) {
4094                     if (UTF8_IS_INVARIANT(*s)) {
4095                         s++;
4096                         continue;
4097                     }
4098                     else {
4099                         if (!utf8_to_uvchr(s, 0))
4100                             break;
4101                         up = (char*)s;
4102                         s += UTF8SKIP(s);
4103                         down = (char*)(s - 1);
4104                         /* reverse this character */
4105                         while (down > up) {
4106                             tmp = *up;
4107                             *up++ = *down;
4108                             *down-- = tmp;
4109                         }
4110                     }
4111                 }
4112                 up = SvPVX(TARG);
4113             }
4114             down = SvPVX(TARG) + len - 1;
4115             while (down > up) {
4116                 tmp = *up;
4117                 *up++ = *down;
4118                 *down-- = tmp;
4119             }
4120             (void)SvPOK_only_UTF8(TARG);
4121         }
4122         SP = MARK + 1;
4123         SETTARG;
4124     }
4125     RETURN;
4126 }
4127
4128 PP(pp_split)
4129 {
4130     dSP; dTARG;
4131     AV *ary;
4132     register IV limit = POPi;                   /* note, negative is forever */
4133     SV *sv = POPs;
4134     STRLEN len;
4135     register char *s = SvPV(sv, len);
4136     bool do_utf8 = DO_UTF8(sv);
4137     char *strend = s + len;
4138     register PMOP *pm;
4139     register REGEXP *rx;
4140     register SV *dstr;
4141     register char *m;
4142     I32 iters = 0;
4143     STRLEN slen = do_utf8 ? utf8_length((U8*)s, (U8*)strend) : (strend - s);
4144     I32 maxiters = slen + 10;
4145     I32 i;
4146     char *orig;
4147     I32 origlimit = limit;
4148     I32 realarray = 0;
4149     I32 base;
4150     AV *oldstack = PL_curstack;
4151     I32 gimme = GIMME_V;
4152     I32 oldsave = PL_savestack_ix;
4153     I32 make_mortal = 1;
4154     MAGIC *mg = (MAGIC *) NULL;
4155
4156 #ifdef DEBUGGING
4157     Copy(&LvTARGOFF(POPs), &pm, 1, PMOP*);
4158 #else
4159     pm = (PMOP*)POPs;
4160 #endif
4161     if (!pm || !s)
4162         DIE(aTHX_ "panic: pp_split");
4163     rx = PM_GETRE(pm);
4164
4165     TAINT_IF((pm->op_pmflags & PMf_LOCALE) &&
4166              (pm->op_pmflags & (PMf_WHITE | PMf_SKIPWHITE)));
4167
4168     PL_reg_match_utf8 = do_utf8;
4169
4170     if (pm->op_pmreplroot) {
4171 #ifdef USE_ITHREADS
4172         ary = GvAVn((GV*)PL_curpad[(PADOFFSET)pm->op_pmreplroot]);
4173 #else
4174         ary = GvAVn((GV*)pm->op_pmreplroot);
4175 #endif
4176     }
4177     else if (gimme != G_ARRAY)
4178 #ifdef USE_5005THREADS
4179         ary = (AV*)PL_curpad[0];
4180 #else
4181         ary = GvAVn(PL_defgv);
4182 #endif /* USE_5005THREADS */
4183     else
4184         ary = Nullav;
4185     if (ary && (gimme != G_ARRAY || (pm->op_pmflags & PMf_ONCE))) {
4186         realarray = 1;
4187         PUTBACK;
4188         av_extend(ary,0);
4189         av_clear(ary);
4190         SPAGAIN;
4191         if ((mg = SvTIED_mg((SV*)ary, PERL_MAGIC_tied))) {
4192             PUSHMARK(SP);
4193             XPUSHs(SvTIED_obj((SV*)ary, mg));
4194         }
4195         else {
4196             if (!AvREAL(ary)) {
4197                 AvREAL_on(ary);
4198                 AvREIFY_off(ary);
4199                 for (i = AvFILLp(ary); i >= 0; i--)
4200                     AvARRAY(ary)[i] = &PL_sv_undef;     /* don't free mere refs */
4201             }
4202             /* temporarily switch stacks */
4203             SWITCHSTACK(PL_curstack, ary);
4204             make_mortal = 0;
4205         }
4206     }
4207     base = SP - PL_stack_base;
4208     orig = s;
4209     if (pm->op_pmflags & PMf_SKIPWHITE) {
4210         if (pm->op_pmflags & PMf_LOCALE) {
4211             while (isSPACE_LC(*s))
4212                 s++;
4213         }
4214         else {
4215             while (isSPACE(*s))
4216                 s++;
4217         }
4218     }
4219     if (pm->op_pmflags & (PMf_MULTILINE|PMf_SINGLELINE)) {
4220         SAVEINT(PL_multiline);
4221         PL_multiline = pm->op_pmflags & PMf_MULTILINE;
4222     }
4223
4224     if (!limit)
4225         limit = maxiters + 2;
4226     if (pm->op_pmflags & PMf_WHITE) {
4227         while (--limit) {
4228             m = s;
4229             while (m < strend &&
4230                    !((pm->op_pmflags & PMf_LOCALE)
4231                      ? isSPACE_LC(*m) : isSPACE(*m)))
4232                 ++m;
4233             if (m >= strend)
4234                 break;
4235
4236             dstr = NEWSV(30, m-s);
4237             sv_setpvn(dstr, s, m-s);
4238             if (make_mortal)
4239                 sv_2mortal(dstr);
4240             if (do_utf8)
4241                 (void)SvUTF8_on(dstr);
4242             XPUSHs(dstr);
4243
4244             s = m + 1;
4245             while (s < strend &&
4246                    ((pm->op_pmflags & PMf_LOCALE)
4247                     ? isSPACE_LC(*s) : isSPACE(*s)))
4248                 ++s;
4249         }
4250     }
4251     else if (strEQ("^", rx->precomp)) {
4252         while (--limit) {
4253             /*SUPPRESS 530*/
4254             for (m = s; m < strend && *m != '\n'; m++) ;
4255             m++;
4256             if (m >= strend)
4257                 break;
4258             dstr = NEWSV(30, m-s);
4259             sv_setpvn(dstr, s, m-s);
4260             if (make_mortal)
4261                 sv_2mortal(dstr);
4262             if (do_utf8)
4263                 (void)SvUTF8_on(dstr);
4264             XPUSHs(dstr);
4265             s = m;
4266         }
4267     }
4268     else if (do_utf8 == ((rx->reganch & ROPT_UTF8) != 0) &&
4269              (rx->reganch & RE_USE_INTUIT) && !rx->nparens
4270              && (rx->reganch & ROPT_CHECK_ALL)
4271              && !(rx->reganch & ROPT_ANCH)) {
4272         int tail = (rx->reganch & RE_INTUIT_TAIL);
4273         SV *csv = CALLREG_INTUIT_STRING(aTHX_ rx);
4274
4275         len = rx->minlen;
4276         if (len == 1 && !(rx->reganch & ROPT_UTF8) && !tail) {
4277             STRLEN n_a;
4278             char c = *SvPV(csv, n_a);
4279             while (--limit) {
4280                 /*SUPPRESS 530*/
4281                 for (m = s; m < strend && *m != c; m++) ;
4282                 if (m >= strend)
4283                     break;
4284                 dstr = NEWSV(30, m-s);
4285                 sv_setpvn(dstr, s, m-s);
4286                 if (make_mortal)
4287                     sv_2mortal(dstr);
4288                 if (do_utf8)
4289                     (void)SvUTF8_on(dstr);
4290                 XPUSHs(dstr);
4291                 /* The rx->minlen is in characters but we want to step
4292                  * s ahead by bytes. */
4293                 if (do_utf8)
4294                     s = (char*)utf8_hop((U8*)m, len);
4295                 else
4296                     s = m + len; /* Fake \n at the end */
4297             }
4298         }
4299         else {
4300 #ifndef lint
4301             while (s < strend && --limit &&
4302               (m = fbm_instr((unsigned char*)s, (unsigned char*)strend,
4303                              csv, PL_multiline ? FBMrf_MULTILINE : 0)) )
4304 #endif
4305             {
4306                 dstr = NEWSV(31, m-s);
4307                 sv_setpvn(dstr, s, m-s);
4308                 if (make_mortal)
4309                     sv_2mortal(dstr);
4310                 if (do_utf8)
4311                     (void)SvUTF8_on(dstr);
4312                 XPUSHs(dstr);
4313                 /* The rx->minlen is in characters but we want to step
4314                  * s ahead by bytes. */
4315                 if (do_utf8)
4316                     s = (char*)utf8_hop((U8*)m, len);
4317                 else
4318                     s = m + len; /* Fake \n at the end */
4319             }
4320         }
4321     }
4322     else {
4323         maxiters += slen * rx->nparens;
4324         while (s < strend && --limit
4325 /*             && (!rx->check_substr
4326                    || ((s = CALLREG_INTUIT_START(aTHX_ rx, sv, s, strend,
4327                                                  0, NULL))))
4328 */             && CALLREGEXEC(aTHX_ rx, s, strend, orig,
4329                               1 /* minend */, sv, NULL, 0))
4330         {
4331             TAINT_IF(RX_MATCH_TAINTED(rx));
4332             if (RX_MATCH_COPIED(rx) && rx->subbeg != orig) {
4333                 m = s;
4334                 s = orig;
4335                 orig = rx->subbeg;
4336                 s = orig + (m - s);
4337                 strend = s + (strend - m);
4338             }
4339             m = rx->startp[0] + orig;
4340             dstr = NEWSV(32, m-s);
4341             sv_setpvn(dstr, s, m-s);
4342             if (make_mortal)
4343                 sv_2mortal(dstr);
4344             if (do_utf8)
4345                 (void)SvUTF8_on(dstr);
4346             XPUSHs(dstr);
4347             if (rx->nparens) {
4348                 for (i = 1; i <= rx->nparens; i++) {
4349                     s = rx->startp[i] + orig;
4350                     m = rx->endp[i] + orig;
4351
4352                     /* japhy (07/27/01) -- the (m && s) test doesn't catch
4353                        parens that didn't match -- they should be set to
4354                        undef, not the empty string */
4355                     if (m >= orig && s >= orig) {
4356                         dstr = NEWSV(33, m-s);
4357                         sv_setpvn(dstr, s, m-s);
4358                     }
4359                     else
4360                         dstr = &PL_sv_undef;  /* undef, not "" */
4361                     if (make_mortal)
4362                         sv_2mortal(dstr);
4363                     if (do_utf8)
4364                         (void)SvUTF8_on(dstr);
4365                     XPUSHs(dstr);
4366                 }
4367             }
4368             s = rx->endp[0] + orig;
4369         }
4370     }
4371
4372     LEAVE_SCOPE(oldsave);
4373     iters = (SP - PL_stack_base) - base;
4374     if (iters > maxiters)
4375         DIE(aTHX_ "Split loop");
4376
4377     /* keep field after final delim? */
4378     if (s < strend || (iters && origlimit)) {
4379         STRLEN l = strend - s;
4380         dstr = NEWSV(34, l);
4381         sv_setpvn(dstr, s, l);
4382         if (make_mortal)
4383             sv_2mortal(dstr);
4384         if (do_utf8)
4385             (void)SvUTF8_on(dstr);
4386         XPUSHs(dstr);
4387         iters++;
4388     }
4389     else if (!origlimit) {
4390         while (iters > 0 && (!TOPs || !SvANY(TOPs) || SvCUR(TOPs) == 0))
4391             iters--, SP--;
4392     }
4393
4394     if (realarray) {
4395         if (!mg) {
4396             SWITCHSTACK(ary, oldstack);
4397             if (SvSMAGICAL(ary)) {
4398                 PUTBACK;
4399                 mg_set((SV*)ary);
4400                 SPAGAIN;
4401             }
4402             if (gimme == G_ARRAY) {
4403                 EXTEND(SP, iters);
4404                 Copy(AvARRAY(ary), SP + 1, iters, SV*);
4405                 SP += iters;
4406                 RETURN;
4407             }
4408         }
4409         else {
4410             PUTBACK;
4411             ENTER;
4412             call_method("PUSH",G_SCALAR|G_DISCARD);
4413             LEAVE;
4414             SPAGAIN;
4415             if (gimme == G_ARRAY) {
4416                 /* EXTEND should not be needed - we just popped them */
4417                 EXTEND(SP, iters);
4418                 for (i=0; i < iters; i++) {
4419                     SV **svp = av_fetch(ary, i, FALSE);
4420                     PUSHs((svp) ? *svp : &PL_sv_undef);
4421                 }
4422                 RETURN;
4423             }
4424         }
4425     }
4426     else {
4427         if (gimme == G_ARRAY)
4428             RETURN;
4429     }
4430     if (iters || !pm->op_pmreplroot) {
4431         GETTARGET;
4432         PUSHi(iters);
4433         RETURN;
4434     }
4435     RETPUSHUNDEF;
4436 }
4437
4438 #ifdef USE_5005THREADS
4439 void
4440 Perl_unlock_condpair(pTHX_ void *svv)
4441 {
4442     MAGIC *mg = mg_find((SV*)svv, PERL_MAGIC_mutex);
4443
4444     if (!mg)
4445         Perl_croak(aTHX_ "panic: unlock_condpair unlocking non-mutex");
4446     MUTEX_LOCK(MgMUTEXP(mg));
4447     if (MgOWNER(mg) != thr)
4448         Perl_croak(aTHX_ "panic: unlock_condpair unlocking mutex that we don't own");
4449     MgOWNER(mg) = 0;
4450     COND_SIGNAL(MgOWNERCONDP(mg));
4451     DEBUG_S(PerlIO_printf(Perl_debug_log, "0x%"UVxf": unlock 0x%"UVxf"\n",
4452                           PTR2UV(thr), PTR2UV(svv)));
4453     MUTEX_UNLOCK(MgMUTEXP(mg));
4454 }
4455 #endif /* USE_5005THREADS */
4456
4457 PP(pp_lock)
4458 {
4459     dSP;
4460     dTOPss;
4461     SV *retsv = sv;
4462 #ifdef USE_5005THREADS
4463     sv_lock(sv);
4464 #endif /* USE_5005THREADS */
4465 #ifdef USE_ITHREADS
4466     shared_sv *ssv = Perl_sharedsv_find(aTHX_ sv);
4467     if(ssv)
4468         Perl_sharedsv_lock(aTHX_ ssv);
4469 #endif /* USE_ITHREADS */
4470     if (SvTYPE(retsv) == SVt_PVAV || SvTYPE(retsv) == SVt_PVHV
4471         || SvTYPE(retsv) == SVt_PVCV) {
4472         retsv = refto(retsv);
4473     }
4474     SETs(retsv);
4475     RETURN;
4476 }
4477
4478 PP(pp_threadsv)
4479 {
4480 #ifdef USE_5005THREADS
4481     dSP;
4482     EXTEND(SP, 1);
4483     if (PL_op->op_private & OPpLVAL_INTRO)
4484         PUSHs(*save_threadsv(PL_op->op_targ));
4485     else
4486         PUSHs(THREADSV(PL_op->op_targ));
4487     RETURN;
4488 #else
4489     DIE(aTHX_ "tried to access per-thread data in non-threaded perl");
4490 #endif /* USE_5005THREADS */
4491 }