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