cpan/Scalar-List-Utils/ListUtil.xs

   1 /* Copyright (c) 1997-2000 Graham Barr <gbarr@pobox.com>. All rights reserved.
   2  * This program is free software; you can redistribute it and/or
   3  * modify it under the same terms as Perl itself.
   4  */
   5
   6 #define PERL_NO_GET_CONTEXT /* we want efficiency */
   7 #include <EXTERN.h>
   8 #include <perl.h>
   9 #include <XSUB.h>
  10
  11 #ifdef USE_PPPORT_H
  12 #  define NEED_sv_2pv_flags 1
  13 #  define NEED_newSVpvn_flags 1
  14 #  define NEED_sv_catpvn_flags
  15 #  include "ppport.h"
  16 #endif
  17
  18 /* For uniqnum, define ACTUAL_NVSIZE to be the number *
  19  * of bytes that are actually used to store the NV    */
  20
  21 #if defined(USE_LONG_DOUBLE) && LDBL_MANT_DIG == 64
  22 #  define ACTUAL_NVSIZE 10
  23 #else
  24 #  define ACTUAL_NVSIZE NVSIZE
  25 #endif
  26
  27 /* Detect "DoubleDouble" nvtype */
  28
  29 #if defined(USE_LONG_DOUBLE) && LDBL_MANT_DIG == 106
  30 #  define NV_IS_DOUBLEDOUBLE
  31 #endif
  32
  33 #ifndef PERL_VERSION_DECIMAL
  34 #  define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s)
  35 #endif
  36 #ifndef PERL_DECIMAL_VERSION
  37 #  define PERL_DECIMAL_VERSION \
  38         PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION)
  39 #endif
  40 #ifndef PERL_VERSION_GE
  41 #  define PERL_VERSION_GE(r,v,s) \
  42         (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s))
  43 #endif
  44 #ifndef PERL_VERSION_LE
  45 #  define PERL_VERSION_LE(r,v,s) \
  46         (PERL_DECIMAL_VERSION <= PERL_VERSION_DECIMAL(r,v,s))
  47 #endif
  48
  49 #if PERL_VERSION_GE(5,6,0)
  50 #  include "multicall.h"
  51 #endif
  52
  53 #if !PERL_VERSION_GE(5,23,8)
  54 #  define UNUSED_VAR_newsp PERL_UNUSED_VAR(newsp)
  55 #else
  56 #  define UNUSED_VAR_newsp NOOP
  57 #endif
  58
  59 #ifndef CvISXSUB
  60 #  define CvISXSUB(cv) CvXSUB(cv)
  61 #endif
  62
  63 #ifndef HvNAMELEN_get
  64 #define HvNAMELEN_get(stash) strlen(HvNAME(stash))
  65 #endif
  66
  67 #ifndef HvNAMEUTF8
  68 #define HvNAMEUTF8(stash) 0
  69 #endif
  70
  71 #ifndef GvNAMEUTF8
  72 #ifdef GvNAME_HEK
  73 #define GvNAMEUTF8(gv) HEK_UTF8(GvNAME_HEK(gv))
  74 #else
  75 #define GvNAMEUTF8(gv) 0
  76 #endif
  77 #endif
  78
  79 #ifndef SV_CATUTF8
  80 #define SV_CATUTF8 0
  81 #endif
  82
  83 #ifndef SV_CATBYTES
  84 #define SV_CATBYTES 0
  85 #endif
  86
  87 #ifndef sv_catpvn_flags
  88 #define sv_catpvn_flags(b,n,l,f) sv_catpvn(b,n,l)
  89 #endif
  90
  91 #if !PERL_VERSION_GE(5,8,3)
  92 static NV Perl_ceil(NV nv) {
  93     return -Perl_floor(-nv);
  94 }
  95 #endif
  96
  97 /* Some platforms have strict exports. And before 5.7.3 cxinc (or Perl_cxinc)
  98    was not exported. Therefore platforms like win32, VMS etc have problems
  99    so we redefine it here -- GMB
 100 */
 101 #if !PERL_VERSION_GE(5,7,0)
 102 /* Not in 5.6.1. */
 103 #  ifdef cxinc
 104 #    undef cxinc
 105 #  endif
 106 #  define cxinc() my_cxinc(aTHX)
 107 static I32
 108 my_cxinc(pTHX)
 109 {
 110     cxstack_max = cxstack_max * 3 / 2;
 111     Renew(cxstack, cxstack_max + 1, struct context); /* fencepost bug in older CXINC macros requires +1 here */
 112     return cxstack_ix + 1;
 113 }
 114 #endif
 115
 116 #ifndef sv_copypv
 117 #define sv_copypv(a, b) my_sv_copypv(aTHX_ a, b)
 118 static void
 119 my_sv_copypv(pTHX_ SV *const dsv, SV *const ssv)
 120 {
 121     STRLEN len;
 122     const char * const s = SvPV_const(ssv,len);
 123     sv_setpvn(dsv,s,len);
 124     if(SvUTF8(ssv))
 125         SvUTF8_on(dsv);
 126     else
 127         SvUTF8_off(dsv);
 128 }
 129 #endif
 130
 131 #ifdef SVf_IVisUV
 132 #  define slu_sv_value(sv) (SvIOK(sv)) ? (SvIOK_UV(sv)) ? (NV)(SvUVX(sv)) : (NV)(SvIVX(sv)) : (SvNV(sv))
 133 #else
 134 #  define slu_sv_value(sv) (SvIOK(sv)) ? (NV)(SvIVX(sv)) : (SvNV(sv))
 135 #endif
 136
 137 #if PERL_VERSION < 13 || (PERL_VERSION == 13 && PERL_SUBVERSION < 9)
 138 #  define PERL_HAS_BAD_MULTICALL_REFCOUNT
 139 #endif
 140
 141 #ifndef SvNV_nomg
 142 #  define SvNV_nomg SvNV
 143 #endif
 144
 145 #if PERL_VERSION_GE(5,16,0)
 146 #  define HAVE_UNICODE_PACKAGE_NAMES
 147
 148 #  ifndef sv_sethek
 149 #    define sv_sethek(a, b)  Perl_sv_sethek(aTHX_ a, b)
 150 #  endif
 151
 152 #  ifndef sv_ref
 153 #  define sv_ref(dst, sv, ob) my_sv_ref(aTHX_ dst, sv, ob)
 154 static SV *
 155 my_sv_ref(pTHX_ SV *dst, const SV *sv, int ob)
 156 {
 157   /* cargoculted from perl 5.22's sv.c */
 158   if(!dst)
 159     dst = sv_newmortal();
 160
 161   if(ob && SvOBJECT(sv)) {
 162     if(HvNAME_get(SvSTASH(sv)))
 163       sv_sethek(dst, HvNAME_HEK(SvSTASH(sv)));
 164     else
 165       sv_setpvs(dst, "__ANON__");
 166   }
 167   else {
 168     const char *reftype = sv_reftype(sv, 0);
 169     sv_setpv(dst, reftype);
 170   }
 171
 172   return dst;
 173 }
 174 #  endif
 175 #endif /* HAVE_UNICODE_PACKAGE_NAMES */
 176
 177 enum slu_accum {
 178     ACC_IV,
 179     ACC_NV,
 180     ACC_SV,
 181 };
 182
 183 static enum slu_accum accum_type(SV *sv) {
 184     if(SvAMAGIC(sv))
 185         return ACC_SV;
 186
 187     if(SvIOK(sv) && !SvNOK(sv) && !SvUOK(sv))
 188         return ACC_IV;
 189
 190     return ACC_NV;
 191 }
 192
 193 /* Magic for set_subname */
 194 static MGVTBL subname_vtbl;
 195
 196 static void MY_initrand(pTHX)
 197 {
 198 #if (PERL_VERSION < 9)
 199     struct op dmy_op;
 200     struct op *old_op = PL_op;
 201
 202     /* We call pp_rand here so that Drand01 get initialized if rand()
 203        or srand() has not already been called
 204     */
 205     memzero((char*)(&dmy_op), sizeof(struct op));
 206     /* we let pp_rand() borrow the TARG allocated for this XS sub */
 207     dmy_op.op_targ = PL_op->op_targ;
 208     PL_op = &dmy_op;
 209     (void)*(PL_ppaddr[OP_RAND])(aTHX);
 210     PL_op = old_op;
 211 #else
 212     /* Initialize Drand01 if rand() or srand() has
 213        not already been called
 214     */
 215     if(!PL_srand_called) {
 216         (void)seedDrand01((Rand_seed_t)Perl_seed(aTHX));
 217         PL_srand_called = TRUE;
 218     }
 219 #endif
 220 }
 221
 222 static double MY_callrand(pTHX_ CV *randcv)
 223 {
 224     dSP;
 225     double ret, dummy;
 226
 227     ENTER;
 228     PUSHMARK(SP);
 229     PUTBACK;
 230
 231     call_sv((SV *)randcv, G_SCALAR);
 232
 233     SPAGAIN;
 234
 235     ret = modf(POPn, &dummy);      /* bound to < 1 */
 236     if(ret < 0) ret += 1.0; /* bound to 0 <= ret < 1 */
 237
 238     LEAVE;
 239
 240     return ret;
 241 }
 242
 243 #define sv_to_cv(sv, subname) MY_sv_to_cv(aTHX_ sv, subname);
 244 static CV* MY_sv_to_cv(pTHX_ SV* sv, const char * const subname)
 245 {
 246     GV *gv;
 247     HV *stash;
 248     CV *cv = sv_2cv(sv, &stash, &gv, 0);
 249
 250     if(cv == Nullcv)
 251         croak("Not a subroutine reference");
 252
 253     if(!CvROOT(cv) && !CvXSUB(cv))
 254         croak("Undefined subroutine in %s", subname);
 255
 256     return cv;
 257 }
 258
 259 enum {
 260     ZIP_SHORTEST = 1,
 261     ZIP_LONGEST  = 2,
 262
 263     ZIP_MESH          = 4,
 264     ZIP_MESH_LONGEST  = ZIP_MESH|ZIP_LONGEST,
 265     ZIP_MESH_SHORTEST = ZIP_MESH|ZIP_SHORTEST,
 266 };
 267
 268 MODULE=List::Util       PACKAGE=List::Util
 269
 270 void
 271 min(...)
 272 PROTOTYPE: @
 273 ALIAS:
 274     min = 0
 275     max = 1
 276 CODE:
 277 {
 278     int index;
 279     NV retval = 0.0; /* avoid 'uninit var' warning */
 280     SV *retsv;
 281     int magic;
 282
 283     if(!items)
 284         XSRETURN_UNDEF;
 285
 286     retsv = ST(0);
 287     SvGETMAGIC(retsv);
 288     magic = SvAMAGIC(retsv);
 289     if(!magic)
 290       retval = slu_sv_value(retsv);
 291
 292     for(index = 1 ; index < items ; index++) {
 293         SV *stacksv = ST(index);
 294         SV *tmpsv;
 295         SvGETMAGIC(stacksv);
 296         if((magic || SvAMAGIC(stacksv)) && (tmpsv = amagic_call(retsv, stacksv, gt_amg, 0))) {
 297              if(SvTRUE(tmpsv) ? !ix : ix) {
 298                   retsv = stacksv;
 299                   magic = SvAMAGIC(retsv);
 300                   if(!magic) {
 301                       retval = slu_sv_value(retsv);
 302                   }
 303              }
 304         }
 305         else {
 306             NV val = slu_sv_value(stacksv);
 307             if(magic) {
 308                 retval = slu_sv_value(retsv);
 309                 magic = 0;
 310             }
 311             if(val < retval ? !ix : ix) {
 312                 retsv = stacksv;
 313                 retval = val;
 314             }
 315         }
 316     }
 317     ST(0) = retsv;
 318     XSRETURN(1);
 319 }
 320
 321
 322 void
 323 sum(...)
 324 PROTOTYPE: @
 325 ALIAS:
 326     sum     = 0
 327     sum0    = 1
 328     product = 2
 329 CODE:
 330 {
 331     dXSTARG;
 332     SV *sv;
 333     IV retiv = 0;
 334     NV retnv = 0.0;
 335     SV *retsv = NULL;
 336     int index;
 337     enum slu_accum accum;
 338     int is_product = (ix == 2);
 339     SV *tmpsv;
 340
 341     if(!items)
 342         switch(ix) {
 343             case 0: XSRETURN_UNDEF;
 344             case 1: ST(0) = sv_2mortal(newSViv(0)); XSRETURN(1);
 345             case 2: ST(0) = sv_2mortal(newSViv(1)); XSRETURN(1);
 346         }
 347
 348     sv    = ST(0);
 349     SvGETMAGIC(sv);
 350     switch((accum = accum_type(sv))) {
 351     case ACC_SV:
 352         retsv = TARG;
 353         sv_setsv(retsv, sv);
 354         break;
 355     case ACC_IV:
 356         retiv = SvIV(sv);
 357         break;
 358     case ACC_NV:
 359         retnv = slu_sv_value(sv);
 360         break;
 361     }
 362
 363     for(index = 1 ; index < items ; index++) {
 364         sv = ST(index);
 365         SvGETMAGIC(sv);
 366         if(accum < ACC_SV && SvAMAGIC(sv)){
 367             if(!retsv)
 368                 retsv = TARG;
 369             sv_setnv(retsv, accum == ACC_NV ? retnv : retiv);
 370             accum = ACC_SV;
 371         }
 372         switch(accum) {
 373         case ACC_SV:
 374             tmpsv = amagic_call(retsv, sv,
 375                 is_product ? mult_amg : add_amg,
 376                 SvAMAGIC(retsv) ? AMGf_assign : 0);
 377             if(tmpsv) {
 378                 switch((accum = accum_type(tmpsv))) {
 379                 case ACC_SV:
 380                     retsv = tmpsv;
 381                     break;
 382                 case ACC_IV:
 383                     retiv = SvIV(tmpsv);
 384                     break;
 385                 case ACC_NV:
 386                     retnv = slu_sv_value(tmpsv);
 387                     break;
 388                 }
 389             }
 390             else {
 391                 /* fall back to default */
 392                 accum = ACC_NV;
 393                 is_product ? (retnv = SvNV(retsv) * SvNV(sv))
 394                            : (retnv = SvNV(retsv) + SvNV(sv));
 395             }
 396             break;
 397         case ACC_IV:
 398             if(is_product) {
 399                 /* TODO: Consider if product() should shortcircuit the moment its
 400                  *   accumulator becomes zero
 401                  */
 402                 /* XXX testing flags before running get_magic may
 403                  * cause some valid tied values to fallback to the NV path
 404                  * - DAPM */
 405                 if(!SvNOK(sv) && SvIOK(sv)) {
 406                     IV i = SvIV(sv);
 407                     if (retiv == 0) /* avoid later division by zero */
 408                         break;
 409                     if (retiv < -1) { /* avoid -1 because that causes SIGFPE */
 410                         if (i < 0) {
 411                             if (i >= IV_MAX / retiv) {
 412                                 retiv *= i;
 413                                 break;
 414                             }
 415                         }
 416                         else {
 417                             if (i <= IV_MIN / retiv) {
 418                                 retiv *= i;
 419                                 break;
 420                             }
 421                         }
 422                     }
 423                     else if (retiv > 0) {
 424                         if (i < 0) {
 425                             if (i >= IV_MIN / retiv) {
 426                                 retiv *= i;
 427                                 break;
 428                             }
 429                         }
 430                         else {
 431                             if (i <= IV_MAX / retiv) {
 432                                 retiv *= i;
 433                                 break;
 434                             }
 435                         }
 436                     }
 437                 }
 438                 /* else fallthrough */
 439             }
 440             else {
 441                 /* XXX testing flags before running get_magic may
 442                  * cause some valid tied values to fallback to the NV path
 443                  * - DAPM */
 444                 if(!SvNOK(sv) && SvIOK(sv)) {
 445                     IV i = SvIV(sv);
 446                     if (retiv >= 0 && i >= 0) {
 447                         if (retiv <= IV_MAX - i) {
 448                             retiv += i;
 449                             break;
 450                         }
 451                         /* else fallthrough */
 452                     }
 453                     else if (retiv < 0 && i < 0) {
 454                         if (retiv >= IV_MIN - i) {
 455                             retiv += i;
 456                             break;
 457                         }
 458                         /* else fallthrough */
 459                     }
 460                     else {
 461                         /* mixed signs can't overflow */
 462                         retiv += i;
 463                         break;
 464                     }
 465                 }
 466                 /* else fallthrough */
 467             }
 468
 469             retnv = retiv;
 470             accum = ACC_NV;
 471             /* FALLTHROUGH */
 472         case ACC_NV:
 473             is_product ? (retnv *= slu_sv_value(sv))
 474                        : (retnv += slu_sv_value(sv));
 475             break;
 476         }
 477     }
 478
 479     if(!retsv)
 480         retsv = TARG;
 481
 482     switch(accum) {
 483     case ACC_SV: /* nothing to do */
 484         break;
 485     case ACC_IV:
 486         sv_setiv(retsv, retiv);
 487         break;
 488     case ACC_NV:
 489         sv_setnv(retsv, retnv);
 490         break;
 491     }
 492
 493     ST(0) = retsv;
 494     XSRETURN(1);
 495 }
 496
 497 #define SLU_CMP_LARGER   1
 498 #define SLU_CMP_SMALLER -1
 499
 500 void
 501 minstr(...)
 502 PROTOTYPE: @
 503 ALIAS:
 504     minstr = SLU_CMP_LARGER
 505     maxstr = SLU_CMP_SMALLER
 506 CODE:
 507 {
 508     SV *left;
 509     int index;
 510
 511     if(!items)
 512         XSRETURN_UNDEF;
 513
 514     left = ST(0);
 515 #ifdef OPpLOCALE
 516     if(MAXARG & OPpLOCALE) {
 517         for(index = 1 ; index < items ; index++) {
 518             SV *right = ST(index);
 519             if(sv_cmp_locale(left, right) == ix)
 520                 left = right;
 521         }
 522     }
 523     else {
 524 #endif
 525         for(index = 1 ; index < items ; index++) {
 526             SV *right = ST(index);
 527             if(sv_cmp(left, right) == ix)
 528                 left = right;
 529         }
 530 #ifdef OPpLOCALE
 531     }
 532 #endif
 533     ST(0) = left;
 534     XSRETURN(1);
 535 }
 536
 537
 538
 539
 540 void
 541 reduce(block,...)
 542     SV *block
 543 PROTOTYPE: &@
 544 ALIAS:
 545     reduce     = 0
 546     reductions = 1
 547 CODE:
 548 {
 549     SV *ret = sv_newmortal();
 550     int index;
 551     AV *retvals = NULL;
 552     GV *agv,*bgv;
 553     SV **args = &PL_stack_base[ax];
 554     CV *cv    = sv_to_cv(block, ix ? "reductions" : "reduce");
 555
 556     if(items <= 1) {
 557         if(ix)
 558             XSRETURN(0);
 559         else
 560             XSRETURN_UNDEF;
 561     }
 562
 563     agv = gv_fetchpv("a", GV_ADD, SVt_PV);
 564     bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
 565     SAVESPTR(GvSV(agv));
 566     SAVESPTR(GvSV(bgv));
 567     GvSV(agv) = ret;
 568     SvSetMagicSV(ret, args[1]);
 569
 570     if(ix) {
 571         /* Precreate an AV for return values; -1 for cv, -1 for top index */
 572         retvals = newAV();
 573         av_extend(retvals, items-1-1);
 574
 575         /* so if throw an exception they can be reclaimed */
 576         SAVEFREESV(retvals);
 577
 578         av_push(retvals, newSVsv(ret));
 579     }
 580 #ifdef dMULTICALL
 581     assert(cv);
 582     if(!CvISXSUB(cv)) {
 583         dMULTICALL;
 584         I32 gimme = G_SCALAR;
 585
 586         UNUSED_VAR_newsp;
 587         PUSH_MULTICALL(cv);
 588         for(index = 2 ; index < items ; index++) {
 589             GvSV(bgv) = args[index];
 590             MULTICALL;
 591             SvSetMagicSV(ret, *PL_stack_sp);
 592             if(ix)
 593                 av_push(retvals, newSVsv(ret));
 594         }
 595 #  ifdef PERL_HAS_BAD_MULTICALL_REFCOUNT
 596         if(CvDEPTH(multicall_cv) > 1)
 597             SvREFCNT_inc_simple_void_NN(multicall_cv);
 598 #  endif
 599         POP_MULTICALL;
 600     }
 601     else
 602 #endif
 603     {
 604         for(index = 2 ; index < items ; index++) {
 605             dSP;
 606             GvSV(bgv) = args[index];
 607
 608             PUSHMARK(SP);
 609             call_sv((SV*)cv, G_SCALAR);
 610
 611             SvSetMagicSV(ret, *PL_stack_sp);
 612             if(ix)
 613                 av_push(retvals, newSVsv(ret));
 614         }
 615     }
 616
 617     if(ix) {
 618         int i;
 619         SV **svs = AvARRAY(retvals);
 620         /* steal the SVs from retvals */
 621         for(i = 0; i < items-1; i++) {
 622             ST(i) = sv_2mortal(svs[i]);
 623             svs[i] = NULL;
 624         }
 625
 626         XSRETURN(items-1);
 627     }
 628     else {
 629         ST(0) = ret;
 630         XSRETURN(1);
 631     }
 632 }
 633
 634 void
 635 first(block,...)
 636     SV *block
 637 PROTOTYPE: &@
 638 CODE:
 639 {
 640     int index;
 641     SV **args = &PL_stack_base[ax];
 642     CV *cv    = sv_to_cv(block, "first");
 643
 644     if(items <= 1)
 645         XSRETURN_UNDEF;
 646
 647     SAVESPTR(GvSV(PL_defgv));
 648 #ifdef dMULTICALL
 649     assert(cv);
 650     if(!CvISXSUB(cv)) {
 651         dMULTICALL;
 652         I32 gimme = G_SCALAR;
 653
 654         UNUSED_VAR_newsp;
 655         PUSH_MULTICALL(cv);
 656
 657         for(index = 1 ; index < items ; index++) {
 658             SV *def_sv = GvSV(PL_defgv) = args[index];
 659 #  ifdef SvTEMP_off
 660             SvTEMP_off(def_sv);
 661 #  endif
 662             MULTICALL;
 663             if(SvTRUEx(*PL_stack_sp)) {
 664 #  ifdef PERL_HAS_BAD_MULTICALL_REFCOUNT
 665                 if(CvDEPTH(multicall_cv) > 1)
 666                     SvREFCNT_inc_simple_void_NN(multicall_cv);
 667 #  endif
 668                 POP_MULTICALL;
 669                 ST(0) = ST(index);
 670                 XSRETURN(1);
 671             }
 672         }
 673 #  ifdef PERL_HAS_BAD_MULTICALL_REFCOUNT
 674         if(CvDEPTH(multicall_cv) > 1)
 675             SvREFCNT_inc_simple_void_NN(multicall_cv);
 676 #  endif
 677         POP_MULTICALL;
 678     }
 679     else
 680 #endif
 681     {
 682         for(index = 1 ; index < items ; index++) {
 683             dSP;
 684             GvSV(PL_defgv) = args[index];
 685
 686             PUSHMARK(SP);
 687             call_sv((SV*)cv, G_SCALAR);
 688             if(SvTRUEx(*PL_stack_sp)) {
 689                 ST(0) = ST(index);
 690                 XSRETURN(1);
 691             }
 692         }
 693     }
 694     XSRETURN_UNDEF;
 695 }
 696
 697
 698 void
 699 any(block,...)
 700     SV *block
 701 ALIAS:
 702     none   = 0
 703     all    = 1
 704     any    = 2
 705     notall = 3
 706 PROTOTYPE: &@
 707 PPCODE:
 708 {
 709     int ret_true = !(ix & 2); /* return true at end of loop for none/all; false for any/notall */
 710     int invert   =  (ix & 1); /* invert block test for all/notall */
 711     SV **args = &PL_stack_base[ax];
 712     CV *cv    = sv_to_cv(block,
 713                          ix == 0 ? "none" :
 714                          ix == 1 ? "all" :
 715                          ix == 2 ? "any" :
 716                          ix == 3 ? "notall" :
 717                          "unknown 'any' alias");
 718
 719     SAVESPTR(GvSV(PL_defgv));
 720 #ifdef dMULTICALL
 721     assert(cv);
 722     if(!CvISXSUB(cv)) {
 723         dMULTICALL;
 724         I32 gimme = G_SCALAR;
 725         int index;
 726
 727         UNUSED_VAR_newsp;
 728         PUSH_MULTICALL(cv);
 729         for(index = 1; index < items; index++) {
 730             SV *def_sv = GvSV(PL_defgv) = args[index];
 731 #  ifdef SvTEMP_off
 732             SvTEMP_off(def_sv);
 733 #  endif
 734
 735             MULTICALL;
 736             if(SvTRUEx(*PL_stack_sp) ^ invert) {
 737                 POP_MULTICALL;
 738                 ST(0) = ret_true ? &PL_sv_no : &PL_sv_yes;
 739                 XSRETURN(1);
 740             }
 741         }
 742         POP_MULTICALL;
 743     }
 744     else
 745 #endif
 746     {
 747         int index;
 748         for(index = 1; index < items; index++) {
 749             dSP;
 750             GvSV(PL_defgv) = args[index];
 751
 752             PUSHMARK(SP);
 753             call_sv((SV*)cv, G_SCALAR);
 754             if(SvTRUEx(*PL_stack_sp) ^ invert) {
 755                 ST(0) = ret_true ? &PL_sv_no : &PL_sv_yes;
 756                 XSRETURN(1);
 757             }
 758         }
 759     }
 760
 761     ST(0) = ret_true ? &PL_sv_yes : &PL_sv_no;
 762     XSRETURN(1);
 763 }
 764
 765 void
 766 head(size,...)
 767 PROTOTYPE: $@
 768 ALIAS:
 769     head = 0
 770     tail = 1
 771 PPCODE:
 772 {
 773     int size = 0;
 774     int start = 0;
 775     int end = 0;
 776     int i = 0;
 777
 778     size = SvIV( ST(0) );
 779
 780     if ( ix == 0 ) {
 781         start = 1;
 782         end = start + size;
 783         if ( size < 0 ) {
 784             end += items - 1;
 785         }
 786         if ( end > items ) {
 787             end = items;
 788         }
 789     }
 790     else {
 791         end = items;
 792         if ( size < 0 ) {
 793             start = -size + 1;
 794         }
 795         else {
 796             start = end - size;
 797         }
 798         if ( start < 1 ) {
 799             start = 1;
 800         }
 801     }
 802
 803     if ( end <= start ) {
 804         XSRETURN(0);
 805     }
 806     else {
 807         EXTEND( SP, end - start );
 808         for ( i = start; i < end; i++ ) {
 809             PUSHs( sv_2mortal( newSVsv( ST(i) ) ) );
 810         }
 811         XSRETURN( end - start );
 812     }
 813 }
 814
 815 void
 816 pairs(...)
 817 PROTOTYPE: @
 818 PPCODE:
 819 {
 820     int argi = 0;
 821     int reti = 0;
 822     HV *pairstash = get_hv("List::Util::_Pair::", GV_ADD);
 823
 824     if(items % 2 && ckWARN(WARN_MISC))
 825         warn("Odd number of elements in pairs");
 826
 827     {
 828         for(; argi < items; argi += 2) {
 829             SV *a = ST(argi);
 830             SV *b = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
 831
 832             AV *av = newAV();
 833             av_push(av, newSVsv(a));
 834             av_push(av, newSVsv(b));
 835
 836             ST(reti) = sv_2mortal(newRV_noinc((SV *)av));
 837             sv_bless(ST(reti), pairstash);
 838             reti++;
 839         }
 840     }
 841
 842     XSRETURN(reti);
 843 }
 844
 845 void
 846 unpairs(...)
 847 PROTOTYPE: @
 848 PPCODE:
 849 {
 850     /* Unlike pairs(), we're going to trash the input values on the stack
 851      * almost as soon as we start generating output. So clone them first
 852      */
 853     int i;
 854     SV **args_copy;
 855     Newx(args_copy, items, SV *);
 856     SAVEFREEPV(args_copy);
 857
 858     Copy(&ST(0), args_copy, items, SV *);
 859
 860     for(i = 0; i < items; i++) {
 861         SV *pair = args_copy[i];
 862         AV *pairav;
 863
 864         SvGETMAGIC(pair);
 865
 866         if(SvTYPE(pair) != SVt_RV)
 867             croak("Not a reference at List::Util::unpairs() argument %d", i);
 868         if(SvTYPE(SvRV(pair)) != SVt_PVAV)
 869             croak("Not an ARRAY reference at List::Util::unpairs() argument %d", i);
 870
 871         /* TODO: assert pair is an ARRAY ref */
 872         pairav = (AV *)SvRV(pair);
 873
 874         EXTEND(SP, 2);
 875
 876         if(AvFILL(pairav) >= 0)
 877             mPUSHs(newSVsv(AvARRAY(pairav)[0]));
 878         else
 879             PUSHs(&PL_sv_undef);
 880
 881         if(AvFILL(pairav) >= 1)
 882             mPUSHs(newSVsv(AvARRAY(pairav)[1]));
 883         else
 884             PUSHs(&PL_sv_undef);
 885     }
 886
 887     XSRETURN(items * 2);
 888 }
 889
 890 void
 891 pairkeys(...)
 892 PROTOTYPE: @
 893 PPCODE:
 894 {
 895     int argi = 0;
 896     int reti = 0;
 897
 898     if(items % 2 && ckWARN(WARN_MISC))
 899         warn("Odd number of elements in pairkeys");
 900
 901     {
 902         for(; argi < items; argi += 2) {
 903             SV *a = ST(argi);
 904
 905             ST(reti++) = sv_2mortal(newSVsv(a));
 906         }
 907     }
 908
 909     XSRETURN(reti);
 910 }
 911
 912 void
 913 pairvalues(...)
 914 PROTOTYPE: @
 915 PPCODE:
 916 {
 917     int argi = 0;
 918     int reti = 0;
 919
 920     if(items % 2 && ckWARN(WARN_MISC))
 921         warn("Odd number of elements in pairvalues");
 922
 923     {
 924         for(; argi < items; argi += 2) {
 925             SV *b = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
 926
 927             ST(reti++) = sv_2mortal(newSVsv(b));
 928         }
 929     }
 930
 931     XSRETURN(reti);
 932 }
 933
 934 void
 935 pairfirst(block,...)
 936     SV *block
 937 PROTOTYPE: &@
 938 PPCODE:
 939 {
 940     GV *agv,*bgv;
 941     CV *cv = sv_to_cv(block, "pairfirst");
 942     I32 ret_gimme = GIMME_V;
 943     int argi = 1; /* "shift" the block */
 944
 945     if(!(items % 2) && ckWARN(WARN_MISC))
 946         warn("Odd number of elements in pairfirst");
 947
 948     agv = gv_fetchpv("a", GV_ADD, SVt_PV);
 949     bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
 950     SAVESPTR(GvSV(agv));
 951     SAVESPTR(GvSV(bgv));
 952 #ifdef dMULTICALL
 953     assert(cv);
 954     if(!CvISXSUB(cv)) {
 955         /* Since MULTICALL is about to move it */
 956         SV **stack = PL_stack_base + ax;
 957
 958         dMULTICALL;
 959         I32 gimme = G_SCALAR;
 960
 961         UNUSED_VAR_newsp;
 962         PUSH_MULTICALL(cv);
 963         for(; argi < items; argi += 2) {
 964             SV *a = GvSV(agv) = stack[argi];
 965             SV *b = GvSV(bgv) = argi < items-1 ? stack[argi+1] : &PL_sv_undef;
 966
 967             MULTICALL;
 968
 969             if(!SvTRUEx(*PL_stack_sp))
 970                 continue;
 971
 972             POP_MULTICALL;
 973             if(ret_gimme == G_LIST) {
 974                 ST(0) = sv_mortalcopy(a);
 975                 ST(1) = sv_mortalcopy(b);
 976                 XSRETURN(2);
 977             }
 978             else
 979                 XSRETURN_YES;
 980         }
 981         POP_MULTICALL;
 982         XSRETURN(0);
 983     }
 984     else
 985 #endif
 986     {
 987         for(; argi < items; argi += 2) {
 988             dSP;
 989             SV *a = GvSV(agv) = ST(argi);
 990             SV *b = GvSV(bgv) = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
 991
 992             PUSHMARK(SP);
 993             call_sv((SV*)cv, G_SCALAR);
 994
 995             SPAGAIN;
 996
 997             if(!SvTRUEx(*PL_stack_sp))
 998                 continue;
 999
1000             if(ret_gimme == G_LIST) {
1001                 ST(0) = sv_mortalcopy(a);
1002                 ST(1) = sv_mortalcopy(b);
1003                 XSRETURN(2);
1004             }
1005             else
1006                 XSRETURN_YES;
1007         }
1008     }
1009
1010     XSRETURN(0);
1011 }
1012
1013 void
1014 pairgrep(block,...)
1015     SV *block
1016 PROTOTYPE: &@
1017 PPCODE:
1018 {
1019     GV *agv,*bgv;
1020     CV *cv = sv_to_cv(block, "pairgrep");
1021     I32 ret_gimme = GIMME_V;
1022
1023     /* This function never returns more than it consumed in arguments. So we
1024      * can build the results "live", behind the arguments
1025      */
1026     int argi = 1; /* "shift" the block */
1027     int reti = 0;
1028
1029     if(!(items % 2) && ckWARN(WARN_MISC))
1030         warn("Odd number of elements in pairgrep");
1031
1032     agv = gv_fetchpv("a", GV_ADD, SVt_PV);
1033     bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
1034     SAVESPTR(GvSV(agv));
1035     SAVESPTR(GvSV(bgv));
1036 #ifdef dMULTICALL
1037     assert(cv);
1038     if(!CvISXSUB(cv)) {
1039         /* Since MULTICALL is about to move it */
1040         SV **stack = PL_stack_base + ax;
1041         int i;
1042
1043         dMULTICALL;
1044         I32 gimme = G_SCALAR;
1045
1046         UNUSED_VAR_newsp;
1047         PUSH_MULTICALL(cv);
1048         for(; argi < items; argi += 2) {
1049             SV *a = GvSV(agv) = stack[argi];
1050             SV *b = GvSV(bgv) = argi < items-1 ? stack[argi+1] : &PL_sv_undef;
1051
1052             MULTICALL;
1053
1054             if(SvTRUEx(*PL_stack_sp)) {
1055                 if(ret_gimme == G_LIST) {
1056                     /* We can't mortalise yet or they'd be mortal too early */
1057                     stack[reti++] = newSVsv(a);
1058                     stack[reti++] = newSVsv(b);
1059                 }
1060                 else if(ret_gimme == G_SCALAR)
1061                     reti++;
1062             }
1063         }
1064         POP_MULTICALL;
1065
1066         if(ret_gimme == G_LIST)
1067             for(i = 0; i < reti; i++)
1068                 sv_2mortal(stack[i]);
1069     }
1070     else
1071 #endif
1072     {
1073         for(; argi < items; argi += 2) {
1074             dSP;
1075             SV *a = GvSV(agv) = ST(argi);
1076             SV *b = GvSV(bgv) = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
1077
1078             PUSHMARK(SP);
1079             call_sv((SV*)cv, G_SCALAR);
1080
1081             SPAGAIN;
1082
1083             if(SvTRUEx(*PL_stack_sp)) {
1084                 if(ret_gimme == G_LIST) {
1085                     ST(reti++) = sv_mortalcopy(a);
1086                     ST(reti++) = sv_mortalcopy(b);
1087                 }
1088                 else if(ret_gimme == G_SCALAR)
1089                     reti++;
1090             }
1091         }
1092     }
1093
1094     if(ret_gimme == G_LIST)
1095         XSRETURN(reti);
1096     else if(ret_gimme == G_SCALAR) {
1097         ST(0) = newSViv(reti);
1098         XSRETURN(1);
1099     }
1100 }
1101
1102 void
1103 pairmap(block,...)
1104     SV *block
1105 PROTOTYPE: &@
1106 PPCODE:
1107 {
1108     GV *agv,*bgv;
1109     CV *cv = sv_to_cv(block, "pairmap");
1110     SV **args_copy = NULL;
1111     I32 ret_gimme = GIMME_V;
1112
1113     int argi = 1; /* "shift" the block */
1114     int reti = 0;
1115
1116     if(!(items % 2) && ckWARN(WARN_MISC))
1117         warn("Odd number of elements in pairmap");
1118
1119     agv = gv_fetchpv("a", GV_ADD, SVt_PV);
1120     bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
1121     SAVESPTR(GvSV(agv));
1122     SAVESPTR(GvSV(bgv));
1123 /* This MULTICALL-based code appears to fail on perl 5.10.0 and 5.8.9
1124  * Skip it on those versions (RT#87857)
1125  */
1126 #if defined(dMULTICALL) && (PERL_VERSION_GE(5,10,1) || PERL_VERSION_LE(5,8,8))
1127     assert(cv);
1128     if(!CvISXSUB(cv)) {
1129         /* Since MULTICALL is about to move it */
1130         SV **stack = PL_stack_base + ax;
1131         I32 ret_gimme = GIMME_V;
1132         int i;
1133         AV *spill = NULL; /* accumulates results if too big for stack */
1134
1135         dMULTICALL;
1136         I32 gimme = G_LIST;
1137
1138         UNUSED_VAR_newsp;
1139         PUSH_MULTICALL(cv);
1140         for(; argi < items; argi += 2) {
1141             int count;
1142
1143             GvSV(agv) = stack[argi];
1144             GvSV(bgv) = argi < items-1 ? stack[argi+1]: &PL_sv_undef;
1145
1146             MULTICALL;
1147             count = PL_stack_sp - PL_stack_base;
1148
1149             if (count > 2 || spill) {
1150                 /* We can't return more than 2 results for a given input pair
1151                  * without trashing the remaining arguments on the stack still
1152                  * to be processed, or possibly overrunning the stack end.
1153                  * So, we'll accumulate the results in a temporary buffer
1154                  * instead.
1155                  * We didn't do this initially because in the common case, most
1156                  * code blocks will return only 1 or 2 items so it won't be
1157                  * necessary
1158                  */
1159                 int fill;
1160
1161                 if (!spill) {
1162                     spill = newAV();
1163                     AvREAL_off(spill); /* don't ref count its contents */
1164                     /* can't mortalize here as every nextstate in the code
1165                      * block frees temps */
1166                     SAVEFREESV(spill);
1167                 }
1168
1169                 fill = (int)AvFILL(spill);
1170                 av_extend(spill, fill + count);
1171                 for(i = 0; i < count; i++)
1172                     (void)av_store(spill, ++fill,
1173                                     newSVsv(PL_stack_base[i + 1]));
1174             }
1175             else
1176                 for(i = 0; i < count; i++)
1177                     stack[reti++] = newSVsv(PL_stack_base[i + 1]);
1178         }
1179
1180         if (spill) {
1181             /* the POP_MULTICALL will trigger the SAVEFREESV above;
1182              * keep it alive  it on the temps stack instead */
1183             SvREFCNT_inc_simple_void_NN(spill);
1184             sv_2mortal((SV*)spill);
1185         }
1186
1187         POP_MULTICALL;
1188
1189         if (spill) {
1190             int n = (int)AvFILL(spill) + 1;
1191             SP = &ST(reti - 1);
1192             EXTEND(SP, n);
1193             for (i = 0; i < n; i++)
1194                 *++SP = *av_fetch(spill, i, FALSE);
1195             reti += n;
1196             av_clear(spill);
1197         }
1198
1199         if(ret_gimme == G_LIST)
1200             for(i = 0; i < reti; i++)
1201                 sv_2mortal(ST(i));
1202     }
1203     else
1204 #endif
1205     {
1206         for(; argi < items; argi += 2) {
1207             dSP;
1208             int count;
1209             int i;
1210
1211             GvSV(agv) = args_copy ? args_copy[argi] : ST(argi);
1212             GvSV(bgv) = argi < items-1 ?
1213                 (args_copy ? args_copy[argi+1] : ST(argi+1)) :
1214                 &PL_sv_undef;
1215
1216             PUSHMARK(SP);
1217             count = call_sv((SV*)cv, G_LIST);
1218
1219             SPAGAIN;
1220
1221             if(count > 2 && !args_copy && ret_gimme == G_LIST) {
1222                 int n_args = items - argi;
1223                 Newx(args_copy, n_args, SV *);
1224                 SAVEFREEPV(args_copy);
1225
1226                 Copy(&ST(argi), args_copy, n_args, SV *);
1227
1228                 argi = 0;
1229                 items = n_args;
1230             }
1231
1232             if(ret_gimme == G_LIST)
1233                 for(i = 0; i < count; i++)
1234                     ST(reti++) = sv_mortalcopy(SP[i - count + 1]);
1235             else
1236                 reti += count;
1237
1238             PUTBACK;
1239         }
1240     }
1241
1242     if(ret_gimme == G_LIST)
1243         XSRETURN(reti);
1244
1245     ST(0) = sv_2mortal(newSViv(reti));
1246     XSRETURN(1);
1247 }
1248
1249 void
1250 shuffle(...)
1251 PROTOTYPE: @
1252 CODE:
1253 {
1254     int index;
1255     SV *randsv = get_sv("List::Util::RAND", 0);
1256     CV * const randcv = randsv && SvROK(randsv) && SvTYPE(SvRV(randsv)) == SVt_PVCV ?
1257         (CV *)SvRV(randsv) : NULL;
1258
1259     if(!randcv)
1260         MY_initrand(aTHX);
1261
1262     for (index = items ; index > 1 ; ) {
1263         int swap = (int)(
1264             (randcv ? MY_callrand(aTHX_ randcv) : Drand01()) * (double)(index--)
1265         );
1266         SV *tmp = ST(swap);
1267         ST(swap) = ST(index);
1268         ST(index) = tmp;
1269     }
1270
1271     XSRETURN(items);
1272 }
1273
1274 void
1275 sample(...)
1276 PROTOTYPE: $@
1277 CODE:
1278 {
1279     IV count = items ? SvUV(ST(0)) : 0;
1280     IV reti = 0;
1281     SV *randsv = get_sv("List::Util::RAND", 0);
1282     CV * const randcv = randsv && SvROK(randsv) && SvTYPE(SvRV(randsv)) == SVt_PVCV ?
1283         (CV *)SvRV(randsv) : NULL;
1284
1285     if(!count)
1286         XSRETURN(0);
1287
1288     /* Now we've extracted count from ST(0) the rest of this logic will be a
1289      * lot neater if we move the topmost item into ST(0) so we can just work
1290      * within 0..items-1 */
1291     ST(0) = POPs;
1292     items--;
1293
1294     if(count > items)
1295         count = items;
1296
1297     if(!randcv)
1298         MY_initrand(aTHX);
1299
1300     /* Partition the stack into ST(0)..ST(reti-1) containing the sampled results
1301      * and ST(reti)..ST(items-1) containing the remaining pending candidates
1302      */
1303     while(reti < count) {
1304         int index = (int)(
1305             (randcv ? MY_callrand(aTHX_ randcv) : Drand01()) * (double)(items - reti)
1306         );
1307
1308         SV *selected = ST(reti + index);
1309         /* preserve the element we're about to stomp on by putting it back into
1310          * the pending partition */
1311         ST(reti + index) = ST(reti);
1312
1313         ST(reti) = selected;
1314         reti++;
1315     }
1316
1317     XSRETURN(reti);
1318 }
1319
1320
1321 void
1322 uniq(...)
1323 PROTOTYPE: @
1324 ALIAS:
1325     uniqint = 0
1326     uniqstr = 1
1327     uniq    = 2
1328 CODE:
1329 {
1330     int retcount = 0;
1331     int index;
1332     SV **args = &PL_stack_base[ax];
1333     HV *seen;
1334     int seen_undef = 0;
1335
1336     if(items == 0 || (items == 1 && !SvGAMAGIC(args[0]) && SvOK(args[0]))) {
1337         /* Optimise for the case of the empty list or a defined nonmagic
1338          * singleton. Leave a singleton magical||undef for the regular case */
1339         retcount = items;
1340         goto finish;
1341     }
1342
1343     sv_2mortal((SV *)(seen = newHV()));
1344
1345     for(index = 0 ; index < items ; index++) {
1346         SV *arg = args[index];
1347 #ifdef HV_FETCH_EMPTY_HE
1348         HE *he;
1349 #endif
1350
1351         if(SvGAMAGIC(arg))
1352             /* clone the value so we don't invoke magic again */
1353             arg = sv_mortalcopy(arg);
1354
1355         if(ix == 2 && !SvOK(arg)) {
1356             /* special handling of undef for uniq() */
1357             if(seen_undef)
1358                 continue;
1359
1360             seen_undef++;
1361
1362             if(GIMME_V == G_LIST)
1363                 ST(retcount) = arg;
1364             retcount++;
1365             continue;
1366         }
1367         if(ix == 0) {
1368             /* uniqint */
1369             /* coerce to integer */
1370 #if PERL_VERSION >= 8
1371             /* int_amg only appeared in perl 5.8.0 */
1372             if(SvAMAGIC(arg) && (arg = AMG_CALLun(arg, int)))
1373                 ; /* nothing to do */
1374             else
1375 #endif
1376             if(!SvOK(arg) || SvNOK(arg) || SvPOK(arg))
1377             {
1378                 /* Convert undef, NVs and PVs into a well-behaved int */
1379                 NV nv = SvNV(arg);
1380
1381                 if(nv > (NV)UV_MAX)
1382                     /* Too positive for UV - use NV */
1383                     arg = newSVnv(Perl_floor(nv));
1384                 else if(nv < (NV)IV_MIN)
1385                     /* Too negative for IV - use NV */
1386                     arg = newSVnv(Perl_ceil(nv));
1387                 else if(nv > 0 && (UV)nv > (UV)IV_MAX)
1388                     /* Too positive for IV - use UV */
1389                     arg = newSVuv(nv);
1390                 else
1391                     /* Must now fit into IV */
1392                     arg = newSViv(nv);
1393
1394                 sv_2mortal(arg);
1395             }
1396         }
1397 #ifdef HV_FETCH_EMPTY_HE
1398         he = (HE*) hv_common(seen, arg, NULL, 0, 0, HV_FETCH_LVALUE | HV_FETCH_EMPTY_HE, NULL, 0);
1399         if (HeVAL(he))
1400             continue;
1401
1402         HeVAL(he) = &PL_sv_undef;
1403 #else
1404         if (hv_exists_ent(seen, arg, 0))
1405             continue;
1406
1407         hv_store_ent(seen, arg, &PL_sv_yes, 0);
1408 #endif
1409
1410         if(GIMME_V == G_LIST)
1411             ST(retcount) = SvOK(arg) ? arg : sv_2mortal(newSVpvn("", 0));
1412         retcount++;
1413     }
1414
1415   finish:
1416     if(GIMME_V == G_LIST)
1417         XSRETURN(retcount);
1418     else
1419         ST(0) = sv_2mortal(newSViv(retcount));
1420 }
1421
1422 void
1423 uniqnum(...)
1424 PROTOTYPE: @
1425 CODE:
1426 {
1427     int retcount = 0;
1428     int index;
1429     SV **args = &PL_stack_base[ax];
1430     HV *seen;
1431     /* A temporary buffer for number stringification */
1432     SV *keysv = sv_newmortal();
1433
1434     if(items == 0 || (items == 1 && !SvGAMAGIC(args[0]) && SvOK(args[0]))) {
1435         /* Optimise for the case of the empty list or a defined nonmagic
1436          * singleton. Leave a singleton magical||undef for the regular case */
1437         retcount = items;
1438         goto finish;
1439     }
1440
1441     sv_2mortal((SV *)(seen = newHV()));
1442
1443     for(index = 0 ; index < items ; index++) {
1444         SV *arg = args[index];
1445         NV nv_arg;
1446 #ifdef HV_FETCH_EMPTY_HE
1447         HE* he;
1448 #endif
1449
1450         if(SvGAMAGIC(arg))
1451             /* clone the value so we don't invoke magic again */
1452             arg = sv_mortalcopy(arg);
1453
1454         if(SvOK(arg) && !(SvUOK(arg) || SvIOK(arg) || SvNOK(arg))) {
1455 #if PERL_VERSION >= 8
1456             SvIV(arg); /* sets SVf_IOK/SVf_IsUV if it's an integer */
1457 #else
1458             SvNV(arg); /* SvIV() sets SVf_IOK even on floats on 5.6 */
1459 #endif
1460         }
1461 #if NVSIZE > IVSIZE                          /* $Config{nvsize} > $Config{ivsize} */
1462         /* Avoid altering arg's flags */
1463         if(SvUOK(arg))      nv_arg = (NV)SvUV(arg);
1464         else if(SvIOK(arg)) nv_arg = (NV)SvIV(arg);
1465         else                nv_arg = SvNV(arg);
1466
1467         /* use 0 for all zeros */
1468         if(nv_arg == 0) sv_setpvs(keysv, "0");
1469
1470         /* for NaN, use the platform's normal stringification */
1471         else if (nv_arg != nv_arg) sv_setpvf(keysv, "%" NVgf, nv_arg);
1472 #ifdef NV_IS_DOUBLEDOUBLE
1473         /* If the least significant double is zero, it could be either 0.0     *
1474          * or -0.0. We therefore ignore the least significant double and       *
1475          * assign to keysv the bytes of the most significant double only.      */
1476         else if(nv_arg == (double)nv_arg) {
1477             double double_arg = (double)nv_arg;
1478             sv_setpvn(keysv, (char *) &double_arg, 8);
1479         }
1480 #endif
1481         else {
1482             /* Use the byte structure of the NV.                               *
1483              * ACTUAL_NVSIZE == sizeof(NV) minus the number of bytes           *
1484              * that are allocated but never used. (It is only the 10-byte      *
1485              * extended precision long double that allocates bytes that are    *
1486              * never used. For all other NV types ACTUAL_NVSIZE == sizeof(NV). */
1487             sv_setpvn(keysv, (char *) &nv_arg, ACTUAL_NVSIZE);
1488         }
1489 #else                                    /* $Config{nvsize} == $Config{ivsize} == 8 */
1490         if( SvIOK(arg) || !SvOK(arg) ) {
1491
1492             /* It doesn't matter if SvUOK(arg) is TRUE */
1493             IV iv = SvIV(arg);
1494
1495             /* use "0" for all zeros */
1496             if(iv == 0) sv_setpvs(keysv, "0");
1497
1498             else {
1499                 int uok = SvUOK(arg);
1500                 int sign = ( iv > 0 || uok ) ? 1 : -1;
1501
1502                 /* Set keysv to the bytes of SvNV(arg) if and only if the integer value  *
1503                  * held by arg can be represented exactly as a double - ie if there are  *
1504                  * no more than 51 bits between its least significant set bit and its    *
1505                  * most significant set bit.                                             *
1506                  * The neatest approach I could find was provided by roboticus at:       *
1507                  *     https://www.perlmonks.org/?node_id=11113490                       *
1508                  * First, identify the lowest set bit and assign its value to an IV.     *
1509                  * Note that this value will always be > 0, and always a power of 2.     */
1510                 IV lowest_set = iv & -iv;
1511
1512                 /* Second, shift it left 53 bits to get location of the first bit        *
1513                  * beyond arg's highest "allowed" set bit.                                                    *
1514                  * NOTE: If lowest set bit is initially far enough left, then this left  *
1515                  * shift operation will result in a value of 0, which is fine.           *
1516                  * Then subtract 1 so that all of the ("allowed") bits below the set bit *
1517                  * are 1 && all other ("disallowed") bits are set to 0.                  *
1518                  * (If the value prior to subtraction was 0, then subtracting 1 will set *
1519                  * all bits - which is also fine.)                                       */
1520                 UV valid_bits = (lowest_set << 53) - 1;
1521
1522                 /* The value of arg can be exactly represented by a double unless one    *
1523                  * or more of its "disallowed" bits are set - ie if iv & (~valid_bits)   *
1524                  * is untrue. However, if (iv < 0 && !SvUOK(arg)) we need to multiply iv *
1525                  * by -1 prior to performing that '&' operation - so multiply iv by sign.*/
1526                 if( !((iv * sign) & (~valid_bits)) ) {
1527                     /* Avoid altering arg's flags */
1528                     nv_arg = uok ? (NV)SvUV(arg) : (NV)SvIV(arg);
1529                     sv_setpvn(keysv, (char *) &nv_arg, 8);
1530                 }
1531                 else {
1532                     /* Read in the bytes, rather than the numeric value of the IV/UV as  *
1533                      * this is more efficient, despite having to sv_catpvn an extra byte.*/
1534                     sv_setpvn(keysv, (char *) &iv, 8);
1535                     /* We add an extra byte to distinguish between an IV/UV and an NV.   *
1536                      * We also use that byte to distinguish between a -ve IV and a UV.   */
1537                     if(uok) sv_catpvn(keysv, "U", 1);
1538                     else    sv_catpvn(keysv, "I", 1);
1539                 }
1540             }
1541         }
1542         else {
1543             nv_arg = SvNV(arg);
1544
1545             /* for NaN, use the platform's normal stringification */
1546             if (nv_arg != nv_arg) sv_setpvf(keysv, "%" NVgf, nv_arg);
1547
1548             /* use "0" for all zeros */
1549             else if(nv_arg == 0) sv_setpvs(keysv, "0");
1550             else sv_setpvn(keysv, (char *) &nv_arg, 8);
1551         }
1552 #endif
1553 #ifdef HV_FETCH_EMPTY_HE
1554         he = (HE*) hv_common(seen, NULL, SvPVX(keysv), SvCUR(keysv), 0, HV_FETCH_LVALUE | HV_FETCH_EMPTY_HE, NULL, 0);
1555         if (HeVAL(he))
1556             continue;
1557
1558         HeVAL(he) = &PL_sv_undef;
1559 #else
1560         if(hv_exists(seen, SvPVX(keysv), SvCUR(keysv)))
1561             continue;
1562
1563         hv_store(seen, SvPVX(keysv), SvCUR(keysv), &PL_sv_yes, 0);
1564 #endif
1565
1566         if(GIMME_V == G_LIST)
1567             ST(retcount) = SvOK(arg) ? arg : sv_2mortal(newSViv(0));
1568         retcount++;
1569     }
1570
1571   finish:
1572     if(GIMME_V == G_LIST)
1573         XSRETURN(retcount);
1574     else
1575         ST(0) = sv_2mortal(newSViv(retcount));
1576 }
1577
1578 void
1579 zip(...)
1580 ALIAS:
1581     zip_longest   = ZIP_LONGEST
1582     zip_shortest  = ZIP_SHORTEST
1583     mesh          = ZIP_MESH
1584     mesh_longest  = ZIP_MESH_LONGEST
1585     mesh_shortest = ZIP_MESH_SHORTEST
1586 PPCODE:
1587     Size_t nlists = items; /* number of lists */
1588     AV **lists;         /* inbound lists */
1589     Size_t len = 0;        /* length of longest inbound list = length of result */
1590     Size_t i;
1591     bool is_mesh = (ix & ZIP_MESH);
1592     ix &= ~ZIP_MESH;
1593
1594     if(!nlists)
1595         XSRETURN(0);
1596
1597     Newx(lists, nlists, AV *);
1598     SAVEFREEPV(lists);
1599
1600     /* TODO: This may or maynot work on objects with arrayification overload */
1601     /* Remember to unit test it */
1602
1603     for(i = 0; i < nlists; i++) {
1604         SV *arg = ST(i);
1605         AV *av;
1606
1607         if(!SvROK(arg) || SvTYPE(SvRV(arg)) != SVt_PVAV)
1608             croak("Expected an ARRAY reference to zip");
1609         av = lists[i] = (AV *)SvRV(arg);
1610
1611         if(!i) {
1612             len = av_count(av);
1613             continue;
1614         }
1615
1616         switch(ix) {
1617             case 0: /* zip is alias to zip_longest */
1618             case ZIP_LONGEST:
1619                 if(av_count(av) > len)
1620                     len = av_count(av);
1621                 break;
1622
1623             case ZIP_SHORTEST:
1624                 if(av_count(av) < len)
1625                     len = av_count(av);
1626                 break;
1627         }
1628     }
1629
1630     if(is_mesh) {
1631         SSize_t retcount = (SSize_t)(len * nlists);
1632
1633         EXTEND(SP, retcount);
1634
1635         for(i = 0; i < len; i++) {
1636             Size_t listi;
1637
1638             for(listi = 0; listi < nlists; listi++) {
1639                 SV *item = (i < av_count(lists[listi])) ?
1640                     AvARRAY(lists[listi])[i] :
1641                     &PL_sv_undef;
1642
1643                 mPUSHs(SvREFCNT_inc(item));
1644             }
1645         }
1646
1647         XSRETURN(retcount);
1648     }
1649     else {
1650         EXTEND(SP, (SSize_t)len);
1651
1652         for(i = 0; i < len; i++) {
1653             Size_t listi;
1654             AV *ret = newAV();
1655             av_extend(ret, nlists);
1656
1657             for(listi = 0; listi < nlists; listi++) {
1658                 SV *item = (i < av_count(lists[listi])) ?
1659                     AvARRAY(lists[listi])[i] :
1660                     &PL_sv_undef;
1661
1662                 av_push(ret, SvREFCNT_inc(item));
1663             }
1664
1665             mPUSHs(newRV_noinc((SV *)ret));
1666         }
1667
1668         XSRETURN(len);
1669     }
1670
1671 MODULE=List::Util       PACKAGE=Scalar::Util
1672
1673 void
1674 dualvar(num,str)
1675     SV *num
1676     SV *str
1677 PROTOTYPE: $$
1678 CODE:
1679 {
1680     dXSTARG;
1681
1682     (void)SvUPGRADE(TARG, SVt_PVNV);
1683
1684     sv_copypv(TARG,str);
1685
1686     if(SvNOK(num) || SvPOK(num) || SvMAGICAL(num)) {
1687         SvNV_set(TARG, SvNV(num));
1688         SvNOK_on(TARG);
1689     }
1690 #ifdef SVf_IVisUV
1691     else if(SvUOK(num)) {
1692         SvUV_set(TARG, SvUV(num));
1693         SvIOK_on(TARG);
1694         SvIsUV_on(TARG);
1695     }
1696 #endif
1697     else {
1698         SvIV_set(TARG, SvIV(num));
1699         SvIOK_on(TARG);
1700     }
1701
1702     if(PL_tainting && (SvTAINTED(num) || SvTAINTED(str)))
1703         SvTAINTED_on(TARG);
1704
1705     ST(0) = TARG;
1706     XSRETURN(1);
1707 }
1708
1709 void
1710 isdual(sv)
1711     SV *sv
1712 PROTOTYPE: $
1713 CODE:
1714     if(SvMAGICAL(sv))
1715         mg_get(sv);
1716
1717     ST(0) = boolSV((SvPOK(sv) || SvPOKp(sv)) && (SvNIOK(sv) || SvNIOKp(sv)));
1718     XSRETURN(1);
1719
1720 SV *
1721 blessed(sv)
1722     SV *sv
1723 PROTOTYPE: $
1724 CODE:
1725 {
1726     SvGETMAGIC(sv);
1727
1728     if(!(SvROK(sv) && SvOBJECT(SvRV(sv))))
1729         XSRETURN_UNDEF;
1730 #ifdef HAVE_UNICODE_PACKAGE_NAMES
1731     RETVAL = newSVsv(sv_ref(NULL, SvRV(sv), TRUE));
1732 #else
1733     RETVAL = newSV(0);
1734     sv_setpv(RETVAL, sv_reftype(SvRV(sv), TRUE));
1735 #endif
1736 }
1737 OUTPUT:
1738     RETVAL
1739
1740 char *
1741 reftype(sv)
1742     SV *sv
1743 PROTOTYPE: $
1744 CODE:
1745 {
1746     SvGETMAGIC(sv);
1747     if(!SvROK(sv))
1748         XSRETURN_UNDEF;
1749
1750     RETVAL = (char*)sv_reftype(SvRV(sv),FALSE);
1751 }
1752 OUTPUT:
1753     RETVAL
1754
1755 UV
1756 refaddr(sv)
1757     SV *sv
1758 PROTOTYPE: $
1759 CODE:
1760 {
1761     SvGETMAGIC(sv);
1762     if(!SvROK(sv))
1763         XSRETURN_UNDEF;
1764
1765     RETVAL = PTR2UV(SvRV(sv));
1766 }
1767 OUTPUT:
1768     RETVAL
1769
1770 void
1771 weaken(sv)
1772     SV *sv
1773 PROTOTYPE: $
1774 CODE:
1775     sv_rvweaken(sv);
1776
1777 void
1778 unweaken(sv)
1779     SV *sv
1780 PROTOTYPE: $
1781 INIT:
1782     SV *tsv;
1783 CODE:
1784 #if defined(sv_rvunweaken)
1785     PERL_UNUSED_VAR(tsv);
1786     sv_rvunweaken(sv);
1787 #else
1788     /* This code stolen from core's sv_rvweaken() and modified */
1789     if (!SvOK(sv))
1790         return;
1791     if (!SvROK(sv))
1792         croak("Can't unweaken a nonreference");
1793     else if (!SvWEAKREF(sv)) {
1794         if(ckWARN(WARN_MISC))
1795             warn("Reference is not weak");
1796         return;
1797     }
1798     else if (SvREADONLY(sv)) croak_no_modify();
1799
1800     tsv = SvRV(sv);
1801 #if PERL_VERSION >= 14
1802     SvWEAKREF_off(sv); SvROK_on(sv);
1803     SvREFCNT_inc_NN(tsv);
1804     Perl_sv_del_backref(aTHX_ tsv, sv);
1805 #else
1806     /* Lacking sv_del_backref() the best we can do is clear the old (weak) ref
1807      * then set a new strong one
1808      */
1809     sv_setsv(sv, &PL_sv_undef);
1810     SvRV_set(sv, SvREFCNT_inc_NN(tsv));
1811     SvROK_on(sv);
1812 #endif
1813 #endif
1814
1815 void
1816 isweak(sv)
1817     SV *sv
1818 PROTOTYPE: $
1819 CODE:
1820     ST(0) = boolSV(SvROK(sv) && SvWEAKREF(sv));
1821     XSRETURN(1);
1822
1823 int
1824 readonly(sv)
1825     SV *sv
1826 PROTOTYPE: $
1827 CODE:
1828     SvGETMAGIC(sv);
1829     RETVAL = SvREADONLY(sv);
1830 OUTPUT:
1831     RETVAL
1832
1833 int
1834 tainted(sv)
1835     SV *sv
1836 PROTOTYPE: $
1837 CODE:
1838     SvGETMAGIC(sv);
1839     RETVAL = SvTAINTED(sv);
1840 OUTPUT:
1841     RETVAL
1842
1843 void
1844 isvstring(sv)
1845     SV *sv
1846 PROTOTYPE: $
1847 CODE:
1848 #ifdef SvVOK
1849     SvGETMAGIC(sv);
1850     ST(0) = boolSV(SvVOK(sv));
1851     XSRETURN(1);
1852 #else
1853     croak("vstrings are not implemented in this release of perl");
1854 #endif
1855
1856 SV *
1857 looks_like_number(sv)
1858     SV *sv
1859 PROTOTYPE: $
1860 CODE:
1861     SV *tempsv;
1862     SvGETMAGIC(sv);
1863     if(SvAMAGIC(sv) && (tempsv = AMG_CALLun(sv, numer))) {
1864         sv = tempsv;
1865     }
1866 #if !PERL_VERSION_GE(5,8,5)
1867     if(SvPOK(sv) || SvPOKp(sv)) {
1868         RETVAL = looks_like_number(sv) ? &PL_sv_yes : &PL_sv_no;
1869     }
1870     else {
1871         RETVAL = (SvFLAGS(sv) & (SVf_NOK|SVp_NOK|SVf_IOK|SVp_IOK)) ? &PL_sv_yes : &PL_sv_no;
1872     }
1873 #else
1874     RETVAL = looks_like_number(sv) ? &PL_sv_yes : &PL_sv_no;
1875 #endif
1876 OUTPUT:
1877     RETVAL
1878
1879 void
1880 openhandle(SV *sv)
1881 PROTOTYPE: $
1882 CODE:
1883 {
1884     IO *io = NULL;
1885     SvGETMAGIC(sv);
1886     if(SvROK(sv)){
1887         /* deref first */
1888         sv = SvRV(sv);
1889     }
1890
1891     /* must be GLOB or IO */
1892     if(isGV(sv)){
1893         io = GvIO((GV*)sv);
1894     }
1895     else if(SvTYPE(sv) == SVt_PVIO){
1896         io = (IO*)sv;
1897     }
1898
1899     if(io){
1900         /* real or tied filehandle? */
1901         if(IoIFP(io) || SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)){
1902             XSRETURN(1);
1903         }
1904     }
1905     XSRETURN_UNDEF;
1906 }
1907
1908 MODULE=List::Util       PACKAGE=Sub::Util
1909
1910 void
1911 set_prototype(proto, code)
1912     SV *proto
1913     SV *code
1914 PREINIT:
1915     SV *cv; /* not CV * */
1916 PPCODE:
1917     SvGETMAGIC(code);
1918     if(!SvROK(code))
1919         croak("set_prototype: not a reference");
1920
1921     cv = SvRV(code);
1922     if(SvTYPE(cv) != SVt_PVCV)
1923         croak("set_prototype: not a subroutine reference");
1924
1925     if(SvPOK(proto)) {
1926         /* set the prototype */
1927         sv_copypv(cv, proto);
1928     }
1929     else {
1930         /* delete the prototype */
1931         SvPOK_off(cv);
1932     }
1933
1934     PUSHs(code);
1935     XSRETURN(1);
1936
1937 void
1938 set_subname(name, sub)
1939     SV *name
1940     SV *sub
1941 PREINIT:
1942     CV *cv = NULL;
1943     GV *gv;
1944     HV *stash = CopSTASH(PL_curcop);
1945     const char *s, *end = NULL, *begin = NULL;
1946     MAGIC *mg;
1947     STRLEN namelen;
1948     const char* nameptr = SvPV(name, namelen);
1949     int utf8flag = SvUTF8(name);
1950     int quotes_seen = 0;
1951     bool need_subst = FALSE;
1952 PPCODE:
1953     if (!SvROK(sub) && SvGMAGICAL(sub))
1954         mg_get(sub);
1955     if (SvROK(sub))
1956         cv = (CV *) SvRV(sub);
1957     else if (SvTYPE(sub) == SVt_PVGV)
1958         cv = GvCVu(sub);
1959     else if (!SvOK(sub))
1960         croak(PL_no_usym, "a subroutine");
1961     else if (PL_op->op_private & HINT_STRICT_REFS)
1962         croak("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use",
1963               SvPV_nolen(sub), "a subroutine");
1964     else if ((gv = gv_fetchsv(sub, FALSE, SVt_PVCV)))
1965         cv = GvCVu(gv);
1966     if (!cv)
1967         croak("Undefined subroutine %s", SvPV_nolen(sub));
1968     if (SvTYPE(cv) != SVt_PVCV && SvTYPE(cv) != SVt_PVFM)
1969         croak("Not a subroutine reference");
1970     for (s = nameptr; s <= nameptr + namelen; s++) {
1971         if (s > nameptr && *s == ':' && s[-1] == ':') {
1972             end = s - 1;
1973             begin = ++s;
1974             if (quotes_seen)
1975                 need_subst = TRUE;
1976         }
1977         else if (s > nameptr && *s != '\0' && s[-1] == '\'') {
1978             end = s - 1;
1979             begin = s;
1980             if (quotes_seen++)
1981                 need_subst = TRUE;
1982         }
1983     }
1984     s--;
1985     if (end) {
1986         SV* tmp;
1987         if (need_subst) {
1988             STRLEN length = end - nameptr + quotes_seen - (*end == '\'' ? 1 : 0);
1989             char* left;
1990             int i, j;
1991             tmp = sv_2mortal(newSV(length));
1992             left = SvPVX(tmp);
1993             for (i = 0, j = 0; j < end - nameptr; ++i, ++j) {
1994                 if (nameptr[j] == '\'') {
1995                     left[i] = ':';
1996                     left[++i] = ':';
1997                 }
1998                 else {
1999                     left[i] = nameptr[j];
2000                 }
2001             }
2002             stash = gv_stashpvn(left, length, GV_ADD | utf8flag);
2003         }
2004         else
2005             stash = gv_stashpvn(nameptr, end - nameptr, GV_ADD | utf8flag);
2006         nameptr = begin;
2007         namelen -= begin - nameptr;
2008     }
2009
2010     /* under debugger, provide information about sub location */
2011     if (PL_DBsub && CvGV(cv)) {
2012         HV* DBsub = GvHV(PL_DBsub);
2013         HE* old_data = NULL;
2014
2015         GV* oldgv = CvGV(cv);
2016         HV* oldhv = GvSTASH(oldgv);
2017
2018         if (oldhv) {
2019             SV* old_full_name = sv_2mortal(newSVpvn_flags(HvNAME(oldhv), HvNAMELEN_get(oldhv), HvNAMEUTF8(oldhv) ? SVf_UTF8 : 0));
2020             sv_catpvn(old_full_name, "::", 2);
2021             sv_catpvn_flags(old_full_name, GvNAME(oldgv), GvNAMELEN(oldgv), GvNAMEUTF8(oldgv) ? SV_CATUTF8 : SV_CATBYTES);
2022
2023             old_data = hv_fetch_ent(DBsub, old_full_name, 0, 0);
2024         }
2025
2026         if (old_data && HeVAL(old_data)) {
2027             SV* old_val = HeVAL(old_data);
2028             SV* new_full_name = sv_2mortal(newSVpvn_flags(HvNAME(stash), HvNAMELEN_get(stash), HvNAMEUTF8(stash) ? SVf_UTF8 : 0));
2029             sv_catpvn(new_full_name, "::", 2);
2030             sv_catpvn_flags(new_full_name, nameptr, s - nameptr, utf8flag ? SV_CATUTF8 : SV_CATBYTES);
2031             SvREFCNT_inc(old_val);
2032             if (!hv_store_ent(DBsub, new_full_name, old_val, 0))
2033                 SvREFCNT_dec(old_val);
2034         }
2035     }
2036
2037     gv = (GV *) newSV(0);
2038     gv_init_pvn(gv, stash, nameptr, s - nameptr, GV_ADDMULTI | utf8flag);
2039
2040     /*
2041      * set_subname needs to create a GV to store the name. The CvGV field of a
2042      * CV is not refcounted, so perl wouldn't know to SvREFCNT_dec() this GV if
2043      * it destroys the containing CV. We use a MAGIC with an empty vtable
2044      * simply for the side-effect of using MGf_REFCOUNTED to store the
2045      * actually-counted reference to the GV.
2046      */
2047     mg = SvMAGIC(cv);
2048     while (mg && mg->mg_virtual != &subname_vtbl)
2049         mg = mg->mg_moremagic;
2050     if (!mg) {
2051         Newxz(mg, 1, MAGIC);
2052         mg->mg_moremagic = SvMAGIC(cv);
2053         mg->mg_type = PERL_MAGIC_ext;
2054         mg->mg_virtual = &subname_vtbl;
2055         SvMAGIC_set(cv, mg);
2056     }
2057     if (mg->mg_flags & MGf_REFCOUNTED)
2058         SvREFCNT_dec(mg->mg_obj);
2059     mg->mg_flags |= MGf_REFCOUNTED;
2060     mg->mg_obj = (SV *) gv;
2061     SvRMAGICAL_on(cv);
2062     CvANON_off(cv);
2063 #ifndef CvGV_set
2064     CvGV(cv) = gv;
2065 #else
2066     CvGV_set(cv, gv);
2067 #endif
2068     PUSHs(sub);
2069
2070 void
2071 subname(code)
2072     SV *code
2073 PREINIT:
2074     CV *cv;
2075     GV *gv;
2076     const char *stashname;
2077 PPCODE:
2078     if (!SvROK(code) && SvGMAGICAL(code))
2079         mg_get(code);
2080
2081     if(!SvROK(code) || SvTYPE(cv = (CV *)SvRV(code)) != SVt_PVCV)
2082         croak("Not a subroutine reference");
2083
2084     if(!(gv = CvGV(cv)))
2085         XSRETURN(0);
2086
2087     if(GvSTASH(gv))
2088         stashname = HvNAME(GvSTASH(gv));
2089     else
2090         stashname = "__ANON__";
2091
2092     mPUSHs(newSVpvf("%s::%s", stashname, GvNAME(gv)));
2093     XSRETURN(1);
2094
2095 BOOT:
2096 {
2097     HV *lu_stash = gv_stashpvn("List::Util", 10, TRUE);
2098     GV *rmcgv = *(GV**)hv_fetch(lu_stash, "REAL_MULTICALL", 14, TRUE);
2099     SV *rmcsv;
2100 #if !defined(SvVOK)
2101     HV *su_stash = gv_stashpvn("Scalar::Util", 12, TRUE);
2102     GV *vargv = *(GV**)hv_fetch(su_stash, "EXPORT_FAIL", 11, TRUE);
2103     AV *varav;
2104     if(SvTYPE(vargv) != SVt_PVGV)
2105         gv_init(vargv, su_stash, "Scalar::Util", 12, TRUE);
2106     varav = GvAVn(vargv);
2107 #endif
2108     if(SvTYPE(rmcgv) != SVt_PVGV)
2109         gv_init(rmcgv, lu_stash, "List::Util", 10, TRUE);
2110     rmcsv = GvSVn(rmcgv);
2111 #ifndef SvVOK
2112     av_push(varav, newSVpv("isvstring",9));
2113 #endif
2114 #ifdef REAL_MULTICALL
2115     sv_setsv(rmcsv, &PL_sv_yes);
2116 #else
2117     sv_setsv(rmcsv, &PL_sv_no);
2118 #endif
2119 }