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