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