This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Scalar-List-Utils 1.45 from CPAN
[perl5.git] / 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 #define PERL_NO_GET_CONTEXT /* we want efficiency */
6 #include <EXTERN.h>
7 #include <perl.h>
8 #include <XSUB.h>
9
10 #define NEED_sv_2pv_flags 1
11 #include "ppport.h"
12
13 #if PERL_BCDVERSION >= 0x5006000
14 #  include "multicall.h"
15 #endif
16
17 #if PERL_BCDVERSION < 0x5023008
18 #  define UNUSED_VAR_newsp PERL_UNUSED_VAR(newsp)
19 #else
20 #  define UNUSED_VAR_newsp NOOP
21 #endif
22
23 #ifndef CvISXSUB
24 #  define CvISXSUB(cv) CvXSUB(cv)
25 #endif
26
27 /* Some platforms have strict exports. And before 5.7.3 cxinc (or Perl_cxinc)
28    was not exported. Therefore platforms like win32, VMS etc have problems
29    so we redefine it here -- GMB
30 */
31 #if PERL_BCDVERSION < 0x5007000
32 /* Not in 5.6.1. */
33 #  ifdef cxinc
34 #    undef cxinc
35 #  endif
36 #  define cxinc() my_cxinc(aTHX)
37 static I32
38 my_cxinc(pTHX)
39 {
40     cxstack_max = cxstack_max * 3 / 2;
41     Renew(cxstack, cxstack_max + 1, struct context); /* fencepost bug in older CXINC macros requires +1 here */
42     return cxstack_ix + 1;
43 }
44 #endif
45
46 #ifndef sv_copypv
47 #define sv_copypv(a, b) my_sv_copypv(aTHX_ a, b)
48 static void
49 my_sv_copypv(pTHX_ SV *const dsv, SV *const ssv)
50 {
51     STRLEN len;
52     const char * const s = SvPV_const(ssv,len);
53     sv_setpvn(dsv,s,len);
54     if(SvUTF8(ssv))
55         SvUTF8_on(dsv);
56     else
57         SvUTF8_off(dsv);
58 }
59 #endif
60
61 #ifdef SVf_IVisUV
62 #  define slu_sv_value(sv) (SvIOK(sv)) ? (SvIOK_UV(sv)) ? (NV)(SvUVX(sv)) : (NV)(SvIVX(sv)) : (SvNV(sv))
63 #else
64 #  define slu_sv_value(sv) (SvIOK(sv)) ? (NV)(SvIVX(sv)) : (SvNV(sv))
65 #endif
66
67 #if PERL_VERSION < 13 || (PERL_VERSION == 13 && PERL_SUBVERSION < 9)
68 #  define PERL_HAS_BAD_MULTICALL_REFCOUNT
69 #endif
70
71 #if PERL_VERSION < 14
72 #  define croak_no_modify() croak("%s", PL_no_modify)
73 #endif
74
75 #ifndef SvNV_nomg
76 #  define SvNV_nomg SvNV
77 #endif
78
79 enum slu_accum {
80     ACC_IV,
81     ACC_NV,
82     ACC_SV,
83 };
84
85 static enum slu_accum accum_type(SV *sv) {
86     if(SvAMAGIC(sv))
87         return ACC_SV;
88
89     if(SvIOK(sv) && !SvNOK(sv) && !SvUOK(sv))
90         return ACC_IV;
91
92     return ACC_NV;
93 }
94
95 /* Magic for set_subname */
96 static MGVTBL subname_vtbl;
97
98 MODULE=List::Util       PACKAGE=List::Util
99
100 void
101 min(...)
102 PROTOTYPE: @
103 ALIAS:
104     min = 0
105     max = 1
106 CODE:
107 {
108     int index;
109     NV retval = 0.0; /* avoid 'uninit var' warning */
110     SV *retsv;
111     int magic;
112
113     if(!items)
114         XSRETURN_UNDEF;
115
116     retsv = ST(0);
117     magic = SvAMAGIC(retsv);
118     if(!magic)
119       retval = slu_sv_value(retsv);
120
121     for(index = 1 ; index < items ; index++) {
122         SV *stacksv = ST(index);
123         SV *tmpsv;
124         if((magic || SvAMAGIC(stacksv)) && (tmpsv = amagic_call(retsv, stacksv, gt_amg, 0))) {
125              if(SvTRUE(tmpsv) ? !ix : ix) {
126                   retsv = stacksv;
127                   magic = SvAMAGIC(retsv);
128                   if(!magic) {
129                       retval = slu_sv_value(retsv);
130                   }
131              }
132         }
133         else {
134             NV val = slu_sv_value(stacksv);
135             if(magic) {
136                 retval = slu_sv_value(retsv);
137                 magic = 0;
138             }
139             if(val < retval ? !ix : ix) {
140                 retsv = stacksv;
141                 retval = val;
142             }
143         }
144     }
145     ST(0) = retsv;
146     XSRETURN(1);
147 }
148
149
150 void
151 sum(...)
152 PROTOTYPE: @
153 ALIAS:
154     sum     = 0
155     sum0    = 1
156     product = 2
157 CODE:
158 {
159     dXSTARG;
160     SV *sv;
161     IV retiv = 0;
162     NV retnv = 0.0;
163     SV *retsv = NULL;
164     int index;
165     enum slu_accum accum;
166     int is_product = (ix == 2);
167     SV *tmpsv;
168
169     if(!items)
170         switch(ix) {
171             case 0: XSRETURN_UNDEF;
172             case 1: ST(0) = newSViv(0); XSRETURN(1);
173             case 2: ST(0) = newSViv(1); XSRETURN(1);
174         }
175
176     sv    = ST(0);
177     switch((accum = accum_type(sv))) {
178     case ACC_SV:
179         retsv = TARG;
180         sv_setsv(retsv, sv);
181         break;
182     case ACC_IV:
183         retiv = SvIV(sv);
184         break;
185     case ACC_NV:
186         retnv = slu_sv_value(sv);
187         break;
188     }
189
190     for(index = 1 ; index < items ; index++) {
191         sv = ST(index);
192         if(accum < ACC_SV && SvAMAGIC(sv)){
193             if(!retsv)
194                 retsv = TARG;
195             sv_setnv(retsv, accum == ACC_NV ? retnv : retiv);
196             accum = ACC_SV;
197         }
198         switch(accum) {
199         case ACC_SV:
200             tmpsv = amagic_call(retsv, sv,
201                 is_product ? mult_amg : add_amg,
202                 SvAMAGIC(retsv) ? AMGf_assign : 0);
203             if(tmpsv) {
204                 switch((accum = accum_type(tmpsv))) {
205                 case ACC_SV:
206                     retsv = tmpsv;
207                     break;
208                 case ACC_IV:
209                     retiv = SvIV(tmpsv);
210                     break;
211                 case ACC_NV:
212                     retnv = slu_sv_value(tmpsv);
213                     break;
214                 }
215             }
216             else {
217                 /* fall back to default */
218                 accum = ACC_NV;
219                 is_product ? (retnv = SvNV(retsv) * SvNV(sv))
220                            : (retnv = SvNV(retsv) + SvNV(sv));
221             }
222             break;
223         case ACC_IV:
224             if(is_product) {
225                 /* TODO: Consider if product() should shortcircuit the moment its
226                  *   accumulator becomes zero
227                  */
228                 /* XXX testing flags before running get_magic may
229                  * cause some valid tied values to fallback to the NV path
230                  * - DAPM */
231                 if(!SvNOK(sv) && SvIOK(sv)) {
232                     IV i = SvIV(sv);
233                     if (retiv == 0) /* avoid later division by zero */
234                         break;
235                     if (retiv < 0) {
236                         if (i < 0) {
237                             if (i >= IV_MAX / retiv) {
238                                 retiv *= i;
239                                 break;
240                             }
241                         }
242                         else {
243                             if (i <= IV_MIN / retiv) {
244                                 retiv *= i;
245                                 break;
246                             }
247                         }
248                     }
249                     else {
250                         if (i < 0) {
251                             if (i >= IV_MIN / retiv) {
252                                 retiv *= i;
253                                 break;
254                             }
255                         }
256                         else {
257                             if (i <= IV_MAX / retiv) {
258                                 retiv *= i;
259                                 break;
260                             }
261                         }
262                     }
263                 }
264                 /* else fallthrough */
265             }
266             else {
267                 /* XXX testing flags before running get_magic may
268                  * cause some valid tied values to fallback to the NV path
269                  * - DAPM */
270                 if(!SvNOK(sv) && SvIOK(sv)) {
271                     IV i = SvIV(sv);
272                     if (retiv >= 0 && i >= 0) {
273                         if (retiv <= IV_MAX - i) {
274                             retiv += i;
275                             break;
276                         }
277                         /* else fallthrough */
278                     }
279                     else if (retiv < 0 && i < 0) {
280                         if (retiv >= IV_MIN - i) {
281                             retiv += i;
282                             break;
283                         }
284                         /* else fallthrough */
285                     }
286                     else {
287                         /* mixed signs can't overflow */
288                         retiv += i;
289                         break;
290                     }
291                 }
292                 /* else fallthrough */
293             }
294
295             /* fallthrough to NV now */
296             retnv = retiv;
297             accum = ACC_NV;
298         case ACC_NV:
299             is_product ? (retnv *= slu_sv_value(sv))
300                        : (retnv += slu_sv_value(sv));
301             break;
302         }
303     }
304
305     if(!retsv)
306         retsv = TARG;
307
308     switch(accum) {
309     case ACC_SV: /* nothing to do */
310         break;
311     case ACC_IV:
312         sv_setiv(retsv, retiv);
313         break;
314     case ACC_NV:
315         sv_setnv(retsv, retnv);
316         break;
317     }
318
319     ST(0) = retsv;
320     XSRETURN(1);
321 }
322
323 #define SLU_CMP_LARGER   1
324 #define SLU_CMP_SMALLER -1
325
326 void
327 minstr(...)
328 PROTOTYPE: @
329 ALIAS:
330     minstr = SLU_CMP_LARGER
331     maxstr = SLU_CMP_SMALLER
332 CODE:
333 {
334     SV *left;
335     int index;
336
337     if(!items)
338         XSRETURN_UNDEF;
339
340     left = ST(0);
341 #ifdef OPpLOCALE
342     if(MAXARG & OPpLOCALE) {
343         for(index = 1 ; index < items ; index++) {
344             SV *right = ST(index);
345             if(sv_cmp_locale(left, right) == ix)
346                 left = right;
347         }
348     }
349     else {
350 #endif
351         for(index = 1 ; index < items ; index++) {
352             SV *right = ST(index);
353             if(sv_cmp(left, right) == ix)
354                 left = right;
355         }
356 #ifdef OPpLOCALE
357     }
358 #endif
359     ST(0) = left;
360     XSRETURN(1);
361 }
362
363
364
365
366 void
367 reduce(block,...)
368     SV *block
369 PROTOTYPE: &@
370 CODE:
371 {
372     SV *ret = sv_newmortal();
373     int index;
374     GV *agv,*bgv,*gv;
375     HV *stash;
376     SV **args = &PL_stack_base[ax];
377     CV *cv    = sv_2cv(block, &stash, &gv, 0);
378
379     if(cv == Nullcv)
380         croak("Not a subroutine reference");
381
382     if(items <= 1)
383         XSRETURN_UNDEF;
384
385     agv = gv_fetchpv("a", GV_ADD, SVt_PV);
386     bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
387     SAVESPTR(GvSV(agv));
388     SAVESPTR(GvSV(bgv));
389     GvSV(agv) = ret;
390     SvSetMagicSV(ret, args[1]);
391 #ifdef dMULTICALL
392     if(!CvISXSUB(cv)) {
393         dMULTICALL;
394         I32 gimme = G_SCALAR;
395
396         UNUSED_VAR_newsp;
397         PUSH_MULTICALL(cv);
398         for(index = 2 ; index < items ; index++) {
399             GvSV(bgv) = args[index];
400             MULTICALL;
401             SvSetMagicSV(ret, *PL_stack_sp);
402         }
403 #  ifdef PERL_HAS_BAD_MULTICALL_REFCOUNT
404         if(CvDEPTH(multicall_cv) > 1)
405             SvREFCNT_inc_simple_void_NN(multicall_cv);
406 #  endif
407         POP_MULTICALL;
408     }
409     else
410 #endif
411     {
412         for(index = 2 ; index < items ; index++) {
413             dSP;
414             GvSV(bgv) = args[index];
415
416             PUSHMARK(SP);
417             call_sv((SV*)cv, G_SCALAR);
418
419             SvSetMagicSV(ret, *PL_stack_sp);
420         }
421     }
422
423     ST(0) = ret;
424     XSRETURN(1);
425 }
426
427 void
428 first(block,...)
429     SV *block
430 PROTOTYPE: &@
431 CODE:
432 {
433     int index;
434     GV *gv;
435     HV *stash;
436     SV **args = &PL_stack_base[ax];
437     CV *cv    = sv_2cv(block, &stash, &gv, 0);
438
439     if(cv == Nullcv)
440         croak("Not a subroutine reference");
441
442     if(items <= 1)
443         XSRETURN_UNDEF;
444
445     SAVESPTR(GvSV(PL_defgv));
446 #ifdef dMULTICALL
447     if(!CvISXSUB(cv)) {
448         dMULTICALL;
449         I32 gimme = G_SCALAR;
450
451         UNUSED_VAR_newsp;
452         PUSH_MULTICALL(cv);
453
454         for(index = 1 ; index < items ; index++) {
455             SV *def_sv = GvSV(PL_defgv) = args[index];
456 #  ifdef SvTEMP_off
457             SvTEMP_off(def_sv);
458 #  endif
459             MULTICALL;
460             if(SvTRUEx(*PL_stack_sp)) {
461 #  ifdef PERL_HAS_BAD_MULTICALL_REFCOUNT
462                 if(CvDEPTH(multicall_cv) > 1)
463                     SvREFCNT_inc_simple_void_NN(multicall_cv);
464 #  endif
465                 POP_MULTICALL;
466                 ST(0) = ST(index);
467                 XSRETURN(1);
468             }
469         }
470 #  ifdef PERL_HAS_BAD_MULTICALL_REFCOUNT
471         if(CvDEPTH(multicall_cv) > 1)
472             SvREFCNT_inc_simple_void_NN(multicall_cv);
473 #  endif
474         POP_MULTICALL;
475     }
476     else
477 #endif
478     {
479         for(index = 1 ; index < items ; index++) {
480             dSP;
481             GvSV(PL_defgv) = args[index];
482
483             PUSHMARK(SP);
484             call_sv((SV*)cv, G_SCALAR);
485             if(SvTRUEx(*PL_stack_sp)) {
486                 ST(0) = ST(index);
487                 XSRETURN(1);
488             }
489         }
490     }
491     XSRETURN_UNDEF;
492 }
493
494
495 void
496 any(block,...)
497     SV *block
498 ALIAS:
499     none   = 0
500     all    = 1
501     any    = 2
502     notall = 3
503 PROTOTYPE: &@
504 PPCODE:
505 {
506     int ret_true = !(ix & 2); /* return true at end of loop for none/all; false for any/notall */
507     int invert   =  (ix & 1); /* invert block test for all/notall */
508     GV *gv;
509     HV *stash;
510     SV **args = &PL_stack_base[ax];
511     CV *cv    = sv_2cv(block, &stash, &gv, 0);
512
513     if(cv == Nullcv)
514         croak("Not a subroutine reference");
515
516     SAVESPTR(GvSV(PL_defgv));
517 #ifdef dMULTICALL
518     if(!CvISXSUB(cv)) {
519         dMULTICALL;
520         I32 gimme = G_SCALAR;
521         int index;
522
523         UNUSED_VAR_newsp;
524         PUSH_MULTICALL(cv);
525         for(index = 1; index < items; index++) {
526             SV *def_sv = GvSV(PL_defgv) = args[index];
527 #  ifdef SvTEMP_off
528             SvTEMP_off(def_sv);
529 #  endif
530
531             MULTICALL;
532             if(SvTRUEx(*PL_stack_sp) ^ invert) {
533                 POP_MULTICALL;
534                 ST(0) = ret_true ? &PL_sv_no : &PL_sv_yes;
535                 XSRETURN(1);
536             }
537         }
538         POP_MULTICALL;
539     }
540     else
541 #endif
542     {
543         int index;
544         for(index = 1; index < items; index++) {
545             dSP;
546             GvSV(PL_defgv) = args[index];
547
548             PUSHMARK(SP);
549             call_sv((SV*)cv, G_SCALAR);
550             if(SvTRUEx(*PL_stack_sp) ^ invert) {
551                 ST(0) = ret_true ? &PL_sv_no : &PL_sv_yes;
552                 XSRETURN(1);
553             }
554         }
555     }
556
557     ST(0) = ret_true ? &PL_sv_yes : &PL_sv_no;
558     XSRETURN(1);
559 }
560
561 void
562 pairs(...)
563 PROTOTYPE: @
564 PPCODE:
565 {
566     int argi = 0;
567     int reti = 0;
568     HV *pairstash = get_hv("List::Util::_Pair::", GV_ADD);
569
570     if(items % 2 && ckWARN(WARN_MISC))
571         warn("Odd number of elements in pairs");
572
573     {
574         for(; argi < items; argi += 2) {
575             SV *a = ST(argi);
576             SV *b = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
577
578             AV *av = newAV();
579             av_push(av, newSVsv(a));
580             av_push(av, newSVsv(b));
581
582             ST(reti) = sv_2mortal(newRV_noinc((SV *)av));
583             sv_bless(ST(reti), pairstash);
584             reti++;
585         }
586     }
587
588     XSRETURN(reti);
589 }
590
591 void
592 unpairs(...)
593 PROTOTYPE: @
594 PPCODE:
595 {
596     /* Unlike pairs(), we're going to trash the input values on the stack
597      * almost as soon as we start generating output. So clone them first
598      */
599     int i;
600     SV **args_copy;
601     Newx(args_copy, items, SV *);
602     SAVEFREEPV(args_copy);
603
604     Copy(&ST(0), args_copy, items, SV *);
605
606     for(i = 0; i < items; i++) {
607         SV *pair = args_copy[i];
608         AV *pairav;
609
610         SvGETMAGIC(pair);
611
612         if(SvTYPE(pair) != SVt_RV)
613             croak("Not a reference at List::Util::unpack() argument %d", i);
614         if(SvTYPE(SvRV(pair)) != SVt_PVAV)
615             croak("Not an ARRAY reference at List::Util::unpack() argument %d", i);
616
617         /* TODO: assert pair is an ARRAY ref */
618         pairav = (AV *)SvRV(pair);
619
620         EXTEND(SP, 2);
621
622         if(AvFILL(pairav) >= 0)
623             mPUSHs(newSVsv(AvARRAY(pairav)[0]));
624         else
625             PUSHs(&PL_sv_undef);
626
627         if(AvFILL(pairav) >= 1)
628             mPUSHs(newSVsv(AvARRAY(pairav)[1]));
629         else
630             PUSHs(&PL_sv_undef);
631     }
632
633     XSRETURN(items * 2);
634 }
635
636 void
637 pairkeys(...)
638 PROTOTYPE: @
639 PPCODE:
640 {
641     int argi = 0;
642     int reti = 0;
643
644     if(items % 2 && ckWARN(WARN_MISC))
645         warn("Odd number of elements in pairkeys");
646
647     {
648         for(; argi < items; argi += 2) {
649             SV *a = ST(argi);
650
651             ST(reti++) = sv_2mortal(newSVsv(a));
652         }
653     }
654
655     XSRETURN(reti);
656 }
657
658 void
659 pairvalues(...)
660 PROTOTYPE: @
661 PPCODE:
662 {
663     int argi = 0;
664     int reti = 0;
665
666     if(items % 2 && ckWARN(WARN_MISC))
667         warn("Odd number of elements in pairvalues");
668
669     {
670         for(; argi < items; argi += 2) {
671             SV *b = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
672
673             ST(reti++) = sv_2mortal(newSVsv(b));
674         }
675     }
676
677     XSRETURN(reti);
678 }
679
680 void
681 pairfirst(block,...)
682     SV *block
683 PROTOTYPE: &@
684 PPCODE:
685 {
686     GV *agv,*bgv,*gv;
687     HV *stash;
688     CV *cv    = sv_2cv(block, &stash, &gv, 0);
689     I32 ret_gimme = GIMME_V;
690     int argi = 1; /* "shift" the block */
691
692     if(!(items % 2) && ckWARN(WARN_MISC))
693         warn("Odd number of elements in pairfirst");
694
695     agv = gv_fetchpv("a", GV_ADD, SVt_PV);
696     bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
697     SAVESPTR(GvSV(agv));
698     SAVESPTR(GvSV(bgv));
699 #ifdef dMULTICALL
700     if(!CvISXSUB(cv)) {
701         /* Since MULTICALL is about to move it */
702         SV **stack = PL_stack_base + ax;
703
704         dMULTICALL;
705         I32 gimme = G_SCALAR;
706
707         UNUSED_VAR_newsp;
708         PUSH_MULTICALL(cv);
709         for(; argi < items; argi += 2) {
710             SV *a = GvSV(agv) = stack[argi];
711             SV *b = GvSV(bgv) = argi < items-1 ? stack[argi+1] : &PL_sv_undef;
712
713             MULTICALL;
714
715             if(!SvTRUEx(*PL_stack_sp))
716                 continue;
717
718             POP_MULTICALL;
719             if(ret_gimme == G_ARRAY) {
720                 ST(0) = sv_mortalcopy(a);
721                 ST(1) = sv_mortalcopy(b);
722                 XSRETURN(2);
723             }
724             else
725                 XSRETURN_YES;
726         }
727         POP_MULTICALL;
728         XSRETURN(0);
729     }
730     else
731 #endif
732     {
733         for(; argi < items; argi += 2) {
734             dSP;
735             SV *a = GvSV(agv) = ST(argi);
736             SV *b = GvSV(bgv) = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
737
738             PUSHMARK(SP);
739             call_sv((SV*)cv, G_SCALAR);
740
741             SPAGAIN;
742
743             if(!SvTRUEx(*PL_stack_sp))
744                 continue;
745
746             if(ret_gimme == G_ARRAY) {
747                 ST(0) = sv_mortalcopy(a);
748                 ST(1) = sv_mortalcopy(b);
749                 XSRETURN(2);
750             }
751             else
752                 XSRETURN_YES;
753         }
754     }
755
756     XSRETURN(0);
757 }
758
759 void
760 pairgrep(block,...)
761     SV *block
762 PROTOTYPE: &@
763 PPCODE:
764 {
765     GV *agv,*bgv,*gv;
766     HV *stash;
767     CV *cv    = sv_2cv(block, &stash, &gv, 0);
768     I32 ret_gimme = GIMME_V;
769
770     /* This function never returns more than it consumed in arguments. So we
771      * can build the results "live", behind the arguments
772      */
773     int argi = 1; /* "shift" the block */
774     int reti = 0;
775
776     if(!(items % 2) && ckWARN(WARN_MISC))
777         warn("Odd number of elements in pairgrep");
778
779     agv = gv_fetchpv("a", GV_ADD, SVt_PV);
780     bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
781     SAVESPTR(GvSV(agv));
782     SAVESPTR(GvSV(bgv));
783 #ifdef dMULTICALL
784     if(!CvISXSUB(cv)) {
785         /* Since MULTICALL is about to move it */
786         SV **stack = PL_stack_base + ax;
787         int i;
788
789         dMULTICALL;
790         I32 gimme = G_SCALAR;
791
792         UNUSED_VAR_newsp;
793         PUSH_MULTICALL(cv);
794         for(; argi < items; argi += 2) {
795             SV *a = GvSV(agv) = stack[argi];
796             SV *b = GvSV(bgv) = argi < items-1 ? stack[argi+1] : &PL_sv_undef;
797
798             MULTICALL;
799
800             if(SvTRUEx(*PL_stack_sp)) {
801                 if(ret_gimme == G_ARRAY) {
802                     /* We can't mortalise yet or they'd be mortal too early */
803                     stack[reti++] = newSVsv(a);
804                     stack[reti++] = newSVsv(b);
805                 }
806                 else if(ret_gimme == G_SCALAR)
807                     reti++;
808             }
809         }
810         POP_MULTICALL;
811
812         if(ret_gimme == G_ARRAY)
813             for(i = 0; i < reti; i++)
814                 sv_2mortal(stack[i]);
815     }
816     else
817 #endif
818     {
819         for(; argi < items; argi += 2) {
820             dSP;
821             SV *a = GvSV(agv) = ST(argi);
822             SV *b = GvSV(bgv) = argi < items-1 ? ST(argi+1) : &PL_sv_undef;
823
824             PUSHMARK(SP);
825             call_sv((SV*)cv, G_SCALAR);
826
827             SPAGAIN;
828
829             if(SvTRUEx(*PL_stack_sp)) {
830                 if(ret_gimme == G_ARRAY) {
831                     ST(reti++) = sv_mortalcopy(a);
832                     ST(reti++) = sv_mortalcopy(b);
833                 }
834                 else if(ret_gimme == G_SCALAR)
835                     reti++;
836             }
837         }
838     }
839
840     if(ret_gimme == G_ARRAY)
841         XSRETURN(reti);
842     else if(ret_gimme == G_SCALAR) {
843         ST(0) = newSViv(reti);
844         XSRETURN(1);
845     }
846 }
847
848 void
849 pairmap(block,...)
850     SV *block
851 PROTOTYPE: &@
852 PPCODE:
853 {
854     GV *agv,*bgv,*gv;
855     HV *stash;
856     CV *cv    = sv_2cv(block, &stash, &gv, 0);
857     SV **args_copy = NULL;
858     I32 ret_gimme = GIMME_V;
859
860     int argi = 1; /* "shift" the block */
861     int reti = 0;
862
863     if(!(items % 2) && ckWARN(WARN_MISC))
864         warn("Odd number of elements in pairmap");
865
866     agv = gv_fetchpv("a", GV_ADD, SVt_PV);
867     bgv = gv_fetchpv("b", GV_ADD, SVt_PV);
868     SAVESPTR(GvSV(agv));
869     SAVESPTR(GvSV(bgv));
870 /* This MULTICALL-based code appears to fail on perl 5.10.0 and 5.8.9
871  * Skip it on those versions (RT#87857)
872  */
873 #if defined(dMULTICALL) && (PERL_BCDVERSION > 0x5010000 || PERL_BCDVERSION < 0x5008009)
874     if(!CvISXSUB(cv)) {
875         /* Since MULTICALL is about to move it */
876         SV **stack = PL_stack_base + ax;
877         I32 ret_gimme = GIMME_V;
878         int i;
879
880         dMULTICALL;
881         I32 gimme = G_ARRAY;
882
883         UNUSED_VAR_newsp;
884         PUSH_MULTICALL(cv);
885         for(; argi < items; argi += 2) {
886             int count;
887
888             GvSV(agv) = args_copy ? args_copy[argi] : stack[argi];
889             GvSV(bgv) = argi < items-1 ?
890                 (args_copy ? args_copy[argi+1] : stack[argi+1]) :
891                 &PL_sv_undef;
892
893             MULTICALL;
894             count = PL_stack_sp - PL_stack_base;
895
896             if(count > 2 && !args_copy) {
897                 /* We can't return more than 2 results for a given input pair
898                  * without trashing the remaining argmuents on the stack still
899                  * to be processed. So, we'll copy them out to a temporary
900                  * buffer and work from there instead.
901                  * We didn't do this initially because in the common case, most
902                  * code blocks will return only 1 or 2 items so it won't be
903                  * necessary
904                  */
905                 int n_args = items - argi;
906                 Newx(args_copy, n_args, SV *);
907                 SAVEFREEPV(args_copy);
908
909                 Copy(stack + argi, args_copy, n_args, SV *);
910
911                 argi = 0;
912                 items = n_args;
913             }
914
915             for(i = 0; i < count; i++)
916                 stack[reti++] = newSVsv(PL_stack_sp[i - count + 1]);
917         }
918         POP_MULTICALL;
919
920         if(ret_gimme == G_ARRAY)
921             for(i = 0; i < reti; i++)
922                 sv_2mortal(stack[i]);
923     }
924     else
925 #endif
926     {
927         for(; argi < items; argi += 2) {
928             dSP;
929             int count;
930             int i;
931
932             GvSV(agv) = args_copy ? args_copy[argi] : ST(argi);
933             GvSV(bgv) = argi < items-1 ?
934                 (args_copy ? args_copy[argi+1] : ST(argi+1)) :
935                 &PL_sv_undef;
936
937             PUSHMARK(SP);
938             count = call_sv((SV*)cv, G_ARRAY);
939
940             SPAGAIN;
941
942             if(count > 2 && !args_copy && ret_gimme == G_ARRAY) {
943                 int n_args = items - argi;
944                 Newx(args_copy, n_args, SV *);
945                 SAVEFREEPV(args_copy);
946
947                 Copy(&ST(argi), args_copy, n_args, SV *);
948
949                 argi = 0;
950                 items = n_args;
951             }
952
953             if(ret_gimme == G_ARRAY)
954                 for(i = 0; i < count; i++)
955                     ST(reti++) = sv_mortalcopy(SP[i - count + 1]);
956             else
957                 reti += count;
958
959             PUTBACK;
960         }
961     }
962
963     if(ret_gimme == G_ARRAY)
964         XSRETURN(reti);
965
966     ST(0) = sv_2mortal(newSViv(reti));
967     XSRETURN(1);
968 }
969
970 void
971 shuffle(...)
972 PROTOTYPE: @
973 CODE:
974 {
975     int index;
976 #if (PERL_VERSION < 9)
977     struct op dmy_op;
978     struct op *old_op = PL_op;
979
980     /* We call pp_rand here so that Drand01 get initialized if rand()
981        or srand() has not already been called
982     */
983     memzero((char*)(&dmy_op), sizeof(struct op));
984     /* we let pp_rand() borrow the TARG allocated for this XS sub */
985     dmy_op.op_targ = PL_op->op_targ;
986     PL_op = &dmy_op;
987     (void)*(PL_ppaddr[OP_RAND])(aTHX);
988     PL_op = old_op;
989 #else
990     /* Initialize Drand01 if rand() or srand() has
991        not already been called
992     */
993     if(!PL_srand_called) {
994         (void)seedDrand01((Rand_seed_t)Perl_seed(aTHX));
995         PL_srand_called = TRUE;
996     }
997 #endif
998
999     for (index = items ; index > 1 ; ) {
1000         int swap = (int)(Drand01() * (double)(index--));
1001         SV *tmp = ST(swap);
1002         ST(swap) = ST(index);
1003         ST(index) = tmp;
1004     }
1005
1006     XSRETURN(items);
1007 }
1008
1009
1010 void
1011 uniq(...)
1012 PROTOTYPE: @
1013 ALIAS:
1014     uniqnum = 0
1015     uniqstr = 1
1016     uniq    = 2
1017 CODE:
1018 {
1019     int retcount = 0;
1020     int index;
1021     SV **args = &PL_stack_base[ax];
1022     HV *seen;
1023
1024     if(items == 0 || (items == 1 && !SvGAMAGIC(args[0]) && SvOK(args[0]))) {
1025         /* Optimise for the case of the empty list or a defined nonmagic
1026          * singleton. Leave a singleton magical||undef for the regular case */
1027         retcount = items;
1028         goto finish;
1029     }
1030
1031     sv_2mortal((SV *)(seen = newHV()));
1032
1033     if(ix == 0) {
1034         /* uniqnum */
1035         /* A temporary buffer for number stringification */
1036         SV *keysv = sv_newmortal();
1037
1038         for(index = 0 ; index < items ; index++) {
1039             SV *arg = args[index];
1040
1041             if(SvGAMAGIC(arg))
1042                 /* clone the value so we don't invoke magic again */
1043                 arg = sv_mortalcopy(arg);
1044
1045             if(SvUOK(arg))
1046                 sv_setpvf(keysv, "%"UVuf, SvUV(arg));
1047             else if(SvIOK(arg))
1048                 sv_setpvf(keysv, "%"IVdf, SvIV(arg));
1049             else
1050                 sv_setpvf(keysv, "%"NVgf, SvNV(arg));
1051 #ifdef HV_FETCH_EMPTY_HE
1052             HE* he = hv_common(seen, NULL, SvPVX(keysv), SvCUR(keysv), 0, HV_FETCH_LVALUE | HV_FETCH_EMPTY_HE, NULL, 0);
1053             if (HeVAL(he))
1054                 continue;
1055
1056             HeVAL(he) = &PL_sv_undef;
1057 #else
1058             if(hv_exists(seen, SvPVX(keysv), SvCUR(keysv)))
1059                 continue;
1060
1061             hv_store(seen, SvPVX(keysv), SvCUR(keysv), &PL_sv_undef, 0);
1062 #endif
1063
1064             if(GIMME_V == G_ARRAY)
1065                 ST(retcount) = SvOK(arg) ? arg : sv_2mortal(newSViv(0));
1066             retcount++;
1067         }
1068     }
1069     else {
1070         /* uniqstr or uniq */
1071         int seen_undef = 0;
1072
1073         for(index = 0 ; index < items ; index++) {
1074             SV *arg = args[index];
1075
1076             if(SvGAMAGIC(arg))
1077                 /* clone the value so we don't invoke magic again */
1078                 arg = sv_mortalcopy(arg);
1079
1080             if(ix == 2 && !SvOK(arg)) {
1081                 /* special handling of undef for uniq() */
1082                 if(seen_undef)
1083                     continue;
1084
1085                 seen_undef++;
1086
1087                 if(GIMME_V == G_ARRAY)
1088                     ST(retcount) = arg;
1089                 retcount++;
1090                 continue;
1091             }
1092 #ifdef HV_FETCH_EMPTY_HE
1093             HE* he = hv_common(seen, arg, NULL, 0, 0, HV_FETCH_LVALUE | HV_FETCH_EMPTY_HE, NULL, 0);
1094             if (HeVAL(he))
1095                 continue;
1096
1097             HeVAL(he) = &PL_sv_undef;
1098 #else
1099             if (hv_exists_ent(seen, arg, 0))
1100                 continue;
1101
1102             hv_store_ent(seen, arg, &PL_sv_undef, 0);
1103 #endif
1104
1105             if(GIMME_V == G_ARRAY)
1106                 ST(retcount) = SvOK(arg) ? arg : sv_2mortal(newSVpvn("", 0));
1107             retcount++;
1108         }
1109     }
1110
1111   finish:
1112     if(GIMME_V == G_ARRAY)
1113         XSRETURN(retcount);
1114     else
1115         ST(0) = sv_2mortal(newSViv(retcount));
1116 }
1117
1118 MODULE=List::Util       PACKAGE=Scalar::Util
1119
1120 void
1121 dualvar(num,str)
1122     SV *num
1123     SV *str
1124 PROTOTYPE: $$
1125 CODE:
1126 {
1127     dXSTARG;
1128
1129     (void)SvUPGRADE(TARG, SVt_PVNV);
1130
1131     sv_copypv(TARG,str);
1132
1133     if(SvNOK(num) || SvPOK(num) || SvMAGICAL(num)) {
1134         SvNV_set(TARG, SvNV(num));
1135         SvNOK_on(TARG);
1136     }
1137 #ifdef SVf_IVisUV
1138     else if(SvUOK(num)) {
1139         SvUV_set(TARG, SvUV(num));
1140         SvIOK_on(TARG);
1141         SvIsUV_on(TARG);
1142     }
1143 #endif
1144     else {
1145         SvIV_set(TARG, SvIV(num));
1146         SvIOK_on(TARG);
1147     }
1148
1149     if(PL_tainting && (SvTAINTED(num) || SvTAINTED(str)))
1150         SvTAINTED_on(TARG);
1151
1152     ST(0) = TARG;
1153     XSRETURN(1);
1154 }
1155
1156 void
1157 isdual(sv)
1158     SV *sv
1159 PROTOTYPE: $
1160 CODE:
1161     if(SvMAGICAL(sv))
1162         mg_get(sv);
1163
1164     ST(0) = boolSV((SvPOK(sv) || SvPOKp(sv)) && (SvNIOK(sv) || SvNIOKp(sv)));
1165     XSRETURN(1);
1166
1167 char *
1168 blessed(sv)
1169     SV *sv
1170 PROTOTYPE: $
1171 CODE:
1172 {
1173     SvGETMAGIC(sv);
1174
1175     if(!(SvROK(sv) && SvOBJECT(SvRV(sv))))
1176         XSRETURN_UNDEF;
1177
1178     RETVAL = (char*)sv_reftype(SvRV(sv),TRUE);
1179 }
1180 OUTPUT:
1181     RETVAL
1182
1183 char *
1184 reftype(sv)
1185     SV *sv
1186 PROTOTYPE: $
1187 CODE:
1188 {
1189     SvGETMAGIC(sv);
1190     if(!SvROK(sv))
1191         XSRETURN_UNDEF;
1192
1193     RETVAL = (char*)sv_reftype(SvRV(sv),FALSE);
1194 }
1195 OUTPUT:
1196     RETVAL
1197
1198 UV
1199 refaddr(sv)
1200     SV *sv
1201 PROTOTYPE: $
1202 CODE:
1203 {
1204     SvGETMAGIC(sv);
1205     if(!SvROK(sv))
1206         XSRETURN_UNDEF;
1207
1208     RETVAL = PTR2UV(SvRV(sv));
1209 }
1210 OUTPUT:
1211     RETVAL
1212
1213 void
1214 weaken(sv)
1215     SV *sv
1216 PROTOTYPE: $
1217 CODE:
1218 #ifdef SvWEAKREF
1219     sv_rvweaken(sv);
1220 #else
1221     croak("weak references are not implemented in this release of perl");
1222 #endif
1223
1224 void
1225 unweaken(sv)
1226     SV *sv
1227 PROTOTYPE: $
1228 INIT:
1229     SV *tsv;
1230 CODE:
1231 #ifdef SvWEAKREF
1232     /* This code stolen from core's sv_rvweaken() and modified */
1233     if (!SvOK(sv))
1234         return;
1235     if (!SvROK(sv))
1236         croak("Can't unweaken a nonreference");
1237     else if (!SvWEAKREF(sv)) {
1238         if(ckWARN(WARN_MISC))
1239             warn("Reference is not weak");
1240         return;
1241     }
1242     else if (SvREADONLY(sv)) croak_no_modify();
1243
1244     tsv = SvRV(sv);
1245 #if PERL_VERSION >= 14
1246     SvWEAKREF_off(sv); SvROK_on(sv);
1247     SvREFCNT_inc_NN(tsv);
1248     Perl_sv_del_backref(aTHX_ tsv, sv);
1249 #else
1250     /* Lacking sv_del_backref() the best we can do is clear the old (weak) ref
1251      * then set a new strong one
1252      */
1253     sv_setsv(sv, &PL_sv_undef);
1254     SvRV_set(sv, SvREFCNT_inc_NN(tsv));
1255     SvROK_on(sv);
1256 #endif
1257 #else
1258     croak("weak references are not implemented in this release of perl");
1259 #endif
1260
1261 void
1262 isweak(sv)
1263     SV *sv
1264 PROTOTYPE: $
1265 CODE:
1266 #ifdef SvWEAKREF
1267     ST(0) = boolSV(SvROK(sv) && SvWEAKREF(sv));
1268     XSRETURN(1);
1269 #else
1270     croak("weak references are not implemented in this release of perl");
1271 #endif
1272
1273 int
1274 readonly(sv)
1275     SV *sv
1276 PROTOTYPE: $
1277 CODE:
1278     SvGETMAGIC(sv);
1279     RETVAL = SvREADONLY(sv);
1280 OUTPUT:
1281     RETVAL
1282
1283 int
1284 tainted(sv)
1285     SV *sv
1286 PROTOTYPE: $
1287 CODE:
1288     SvGETMAGIC(sv);
1289     RETVAL = SvTAINTED(sv);
1290 OUTPUT:
1291     RETVAL
1292
1293 void
1294 isvstring(sv)
1295     SV *sv
1296 PROTOTYPE: $
1297 CODE:
1298 #ifdef SvVOK
1299     SvGETMAGIC(sv);
1300     ST(0) = boolSV(SvVOK(sv));
1301     XSRETURN(1);
1302 #else
1303     croak("vstrings are not implemented in this release of perl");
1304 #endif
1305
1306 SV *
1307 looks_like_number(sv)
1308     SV *sv
1309 PROTOTYPE: $
1310 CODE:
1311     SV *tempsv;
1312     SvGETMAGIC(sv);
1313     if(SvAMAGIC(sv) && (tempsv = AMG_CALLun(sv, numer))) {
1314         sv = tempsv;
1315     }
1316 #if PERL_BCDVERSION < 0x5008005
1317     if(SvPOK(sv) || SvPOKp(sv)) {
1318         RETVAL = looks_like_number(sv) ? &PL_sv_yes : &PL_sv_no;
1319     }
1320     else {
1321         RETVAL = (SvFLAGS(sv) & (SVf_NOK|SVp_NOK|SVf_IOK|SVp_IOK)) ? &PL_sv_yes : &PL_sv_no;
1322     }
1323 #else
1324     RETVAL = looks_like_number(sv) ? &PL_sv_yes : &PL_sv_no;
1325 #endif
1326 OUTPUT:
1327     RETVAL
1328
1329 void
1330 openhandle(SV *sv)
1331 PROTOTYPE: $
1332 CODE:
1333 {
1334     IO *io = NULL;
1335     SvGETMAGIC(sv);
1336     if(SvROK(sv)){
1337         /* deref first */
1338         sv = SvRV(sv);
1339     }
1340
1341     /* must be GLOB or IO */
1342     if(isGV(sv)){
1343         io = GvIO((GV*)sv);
1344     }
1345     else if(SvTYPE(sv) == SVt_PVIO){
1346         io = (IO*)sv;
1347     }
1348
1349     if(io){
1350         /* real or tied filehandle? */
1351         if(IoIFP(io) || SvTIED_mg((SV*)io, PERL_MAGIC_tiedscalar)){
1352             XSRETURN(1);
1353         }
1354     }
1355     XSRETURN_UNDEF;
1356 }
1357
1358 MODULE=List::Util       PACKAGE=Sub::Util
1359
1360 void
1361 set_prototype(proto, code)
1362     SV *proto
1363     SV *code
1364 PREINIT:
1365     SV *cv; /* not CV * */
1366 PPCODE:
1367     SvGETMAGIC(code);
1368     if(!SvROK(code))
1369         croak("set_prototype: not a reference");
1370
1371     cv = SvRV(code);
1372     if(SvTYPE(cv) != SVt_PVCV)
1373         croak("set_prototype: not a subroutine reference");
1374
1375     if(SvPOK(proto)) {
1376         /* set the prototype */
1377         sv_copypv(cv, proto);
1378     }
1379     else {
1380         /* delete the prototype */
1381         SvPOK_off(cv);
1382     }
1383
1384     PUSHs(code);
1385     XSRETURN(1);
1386
1387 void
1388 set_subname(name, sub)
1389     char *name
1390     SV *sub
1391 PREINIT:
1392     CV *cv = NULL;
1393     GV *gv;
1394     HV *stash = CopSTASH(PL_curcop);
1395     char *s, *end = NULL;
1396     MAGIC *mg;
1397 PPCODE:
1398     if (!SvROK(sub) && SvGMAGICAL(sub))
1399         mg_get(sub);
1400     if (SvROK(sub))
1401         cv = (CV *) SvRV(sub);
1402     else if (SvTYPE(sub) == SVt_PVGV)
1403         cv = GvCVu(sub);
1404     else if (!SvOK(sub))
1405         croak(PL_no_usym, "a subroutine");
1406     else if (PL_op->op_private & HINT_STRICT_REFS)
1407         croak("Can't use string (\"%.32s\") as %s ref while \"strict refs\" in use",
1408               SvPV_nolen(sub), "a subroutine");
1409     else if ((gv = gv_fetchpv(SvPV_nolen(sub), FALSE, SVt_PVCV)))
1410         cv = GvCVu(gv);
1411     if (!cv)
1412         croak("Undefined subroutine %s", SvPV_nolen(sub));
1413     if (SvTYPE(cv) != SVt_PVCV && SvTYPE(cv) != SVt_PVFM)
1414         croak("Not a subroutine reference");
1415     for (s = name; *s++; ) {
1416         if (*s == ':' && s[-1] == ':')
1417             end = ++s;
1418         else if (*s && s[-1] == '\'')
1419             end = s;
1420     }
1421     s--;
1422     if (end) {
1423         char *namepv = savepvn(name, end - name);
1424         stash = GvHV(gv_fetchpv(namepv, TRUE, SVt_PVHV));
1425         Safefree(namepv);
1426         name = end;
1427     }
1428
1429     /* under debugger, provide information about sub location */
1430     if (PL_DBsub && CvGV(cv)) {
1431         HV *hv = GvHV(PL_DBsub);
1432
1433         char *new_pkg = HvNAME(stash);
1434
1435         char *old_name = GvNAME( CvGV(cv) );
1436         char *old_pkg = HvNAME( GvSTASH(CvGV(cv)) );
1437
1438         int old_len = strlen(old_name) + strlen(old_pkg);
1439         int new_len = strlen(name) + strlen(new_pkg);
1440
1441         SV **old_data;
1442         char *full_name;
1443
1444         Newxz(full_name, (old_len > new_len ? old_len : new_len) + 3, char);
1445
1446         strcat(full_name, old_pkg);
1447         strcat(full_name, "::");
1448         strcat(full_name, old_name);
1449
1450         old_data = hv_fetch(hv, full_name, strlen(full_name), 0);
1451
1452         if (old_data) {
1453             strcpy(full_name, new_pkg);
1454             strcat(full_name, "::");
1455             strcat(full_name, name);
1456
1457             SvREFCNT_inc(*old_data);
1458             if (!hv_store(hv, full_name, strlen(full_name), *old_data, 0))
1459                 SvREFCNT_dec(*old_data);
1460         }
1461         Safefree(full_name);
1462     }
1463
1464     gv = (GV *) newSV(0);
1465     gv_init(gv, stash, name, s - name, TRUE);
1466
1467     /*
1468      * set_subname needs to create a GV to store the name. The CvGV field of a
1469      * CV is not refcounted, so perl wouldn't know to SvREFCNT_dec() this GV if
1470      * it destroys the containing CV. We use a MAGIC with an empty vtable
1471      * simply for the side-effect of using MGf_REFCOUNTED to store the
1472      * actually-counted reference to the GV.
1473      */
1474     mg = SvMAGIC(cv);
1475     while (mg && mg->mg_virtual != &subname_vtbl)
1476         mg = mg->mg_moremagic;
1477     if (!mg) {
1478         Newxz(mg, 1, MAGIC);
1479         mg->mg_moremagic = SvMAGIC(cv);
1480         mg->mg_type = PERL_MAGIC_ext;
1481         mg->mg_virtual = &subname_vtbl;
1482         SvMAGIC_set(cv, mg);
1483     }
1484     if (mg->mg_flags & MGf_REFCOUNTED)
1485         SvREFCNT_dec(mg->mg_obj);
1486     mg->mg_flags |= MGf_REFCOUNTED;
1487     mg->mg_obj = (SV *) gv;
1488     SvRMAGICAL_on(cv);
1489     CvANON_off(cv);
1490 #ifndef CvGV_set
1491     CvGV(cv) = gv;
1492 #else
1493     CvGV_set(cv, gv);
1494 #endif
1495     PUSHs(sub);
1496
1497 void
1498 subname(code)
1499     SV *code
1500 PREINIT:
1501     CV *cv;
1502     GV *gv;
1503 PPCODE:
1504     if (!SvROK(code) && SvGMAGICAL(code))
1505         mg_get(code);
1506
1507     if(!SvROK(code) || SvTYPE(cv = (CV *)SvRV(code)) != SVt_PVCV)
1508         croak("Not a subroutine reference");
1509
1510     if(!(gv = CvGV(cv)))
1511         XSRETURN(0);
1512
1513     mPUSHs(newSVpvf("%s::%s", HvNAME(GvSTASH(gv)), GvNAME(gv)));
1514     XSRETURN(1);
1515
1516 BOOT:
1517 {
1518     HV *lu_stash = gv_stashpvn("List::Util", 10, TRUE);
1519     GV *rmcgv = *(GV**)hv_fetch(lu_stash, "REAL_MULTICALL", 14, TRUE);
1520     SV *rmcsv;
1521 #if !defined(SvWEAKREF) || !defined(SvVOK)
1522     HV *su_stash = gv_stashpvn("Scalar::Util", 12, TRUE);
1523     GV *vargv = *(GV**)hv_fetch(su_stash, "EXPORT_FAIL", 11, TRUE);
1524     AV *varav;
1525     if(SvTYPE(vargv) != SVt_PVGV)
1526         gv_init(vargv, su_stash, "Scalar::Util", 12, TRUE);
1527     varav = GvAVn(vargv);
1528 #endif
1529     if(SvTYPE(rmcgv) != SVt_PVGV)
1530         gv_init(rmcgv, lu_stash, "List::Util", 10, TRUE);
1531     rmcsv = GvSVn(rmcgv);
1532 #ifndef SvWEAKREF
1533     av_push(varav, newSVpv("weaken",6));
1534     av_push(varav, newSVpv("isweak",6));
1535 #endif
1536 #ifndef SvVOK
1537     av_push(varav, newSVpv("isvstring",9));
1538 #endif
1539 #ifdef REAL_MULTICALL
1540     sv_setsv(rmcsv, &PL_sv_yes);
1541 #else
1542     sv_setsv(rmcsv, &PL_sv_no);
1543 #endif
1544 }