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