pp.c

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