Beefy Boxes and Bandwidth Generously Provided by pair Networks
There's more than one way to do things
 
PerlMonks  

syphilis's scratchpad

by syphilis (Bishop)
on Dec 03, 2006 at 10:20 UTC ( #587490=scratchpad: print w/replies, xml ) Need Help??

<c> /* * This file was generated automatically by ExtUtils::ParseXS version 3.40 from the * contents of XS.xs. Do not edit this file, edit XS.xs instead. * * ANY CHANGES MADE HERE WILL BE LOST! * */ #line 1 "XS.xs" /** * List::MoreUtils::XS * Copyright 2004 - 2010 by by Tassilo von Parseval * Copyright 2013 - 2017 by Jens Rehsack * * All code added with 0.417 or later is licensed under the Apache License, * Version 2.0 (the "License"); you may not use this file except in compliance * with the License. You may obtain a copy of the License at * * http://www.apache.org/licenses/LICENSE-2.0 * * Unless required by applicable law or agreed to in writing, software * distributed under the License is distributed on an "AS IS" BASIS, * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. * See the License for the specific language governing permissions and * limitations under the License. * * All code until 0.416 is licensed under the same terms as Perl itself, * either Perl version 5.8.4 or, at your option, any later version of * Perl 5 you may have available. */ #include "LMUconfig.h" #ifdef HAVE_TIME_H # include <time.h> #endif #ifdef HAVE_SYS_TIME_H # include <sys/time.h> #endif #define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "multicall.h" #define NEED_gv_fetchpvn_flags #include "ppport.h" #ifndef MAX # define MAX(a,b) ((a)>(b)?(a):(b)) #endif #ifndef MIN # define MIN(a,b) (((a)<(b))?(a):(b)) #endif #ifndef aTHX # define aTHX # define pTHX #endif #ifndef croak_xs_usage # ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE # define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params) # endif static void S_croak_xs_usage(pTHX_ const CV *const cv, const char *const params) { const GV *const gv = CvGV(cv); PERL_ARGS_ASSERT_CROAK_XS_USAGE; if (gv) { const char *const gvname = GvNAME(gv); const HV *const stash = GvSTASH(gv); const char *const hvname = stash ? HvNAME(stash) : NULL; if (hvname) Perl_croak_nocontext("Usage: %s::%s(%s)", hvname, gvname, params); else Perl_croak_nocontext("Usage: %s(%s)", gvname, params); } else { /* Pants. I don't think that it should be possible to get here. */ Perl_croak_nocontext("Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params); } } # define croak_xs_usage(a,b) S_croak_xs_usage(aTHX_ a,b) #endif #ifdef SVf_IVisUV # define slu_sv_value(sv) (SvIOK(sv)) ? (SvIOK_UV(sv)) ? (NV)(SvUVX(sv)) : (NV)(SvIVX(sv)) : (SvNV(sv)) #else # define slu_sv_value(sv) (SvIOK(sv)) ? (NV)(SvIVX(sv)) : (SvNV(sv)) #endif /* * Perl < 5.18 had some kind of different SvIV_please_nomg */ #if PERL_VERSION_LE(5,18,0) #undef SvIV_please_nomg # define SvIV_please_nomg(sv) \ (!SvIOKp(sv) && (SvNOK(sv) || SvPOK(sv)) \ ? (SvIV_nomg(sv), SvIOK(sv)) \ : SvIOK(sv)) #endif #ifndef MUTABLE_GV # define MUTABLE_GV(a) (GV *)(a) #endif #if !defined(HAS_BUILTIN_EXPECT) && defined(HAVE_BUILTIN_EXPECT) # ifdef LIKELY # undef LIKELY # endif # ifdef UNLIKELY # undef UNLIKELY # endif # define LIKELY(x) __builtin_expect(!!(x), 1) # define UNLIKELY(x) __builtin_expect(!!(x), 0) #endif #ifndef LIKELY # define LIKELY(x) (x) #endif #ifndef UNLIKELY # define UNLIKELY(x) (x) #endif #ifndef GV_NOTQUAL # define GV_NOTQUAL 0 #endif #ifdef _MSC_VER # define inline __inline #endif #ifndef HAVE_SIZE_T # if SIZEOF_PTR == SIZEOF_LONG_LONG typedef unsigned long long size_t; # elif SIZEOF_PTR == SIZEOF_LONG typedef unsigned long size_t; # elif SIZEOF_PTR == SIZEOF_INT typedef unsigned int size_t; # else # error "Can't determine type for size_t" # endif #endif #ifndef HAVE_SSIZE_T # if SIZEOF_PTR == SIZEOF_LONG_LONG typedef signed long long ssize_t; # elif SIZEOF_PTR == SIZEOF_LONG typedef signed long ssize_t; # elif SIZEOF_PTR == SIZEOF_INT typedef signed int ssize_t; # else # error "Can't determine type for ssize_t" # endif #endif /* compare left and right SVs. Returns: * -1: < * 0: == * 1: > * 2: left or right was a NaN */ static I32 LMUncmp(pTHX_ SV* left, SV * right) { /* Fortunately it seems NaN isn't IOK */ if(SvAMAGIC(left) || SvAMAGIC(right)) return SvIVX(amagic_call(left, right, ncmp_amg, 0)); if (SvIV_please_nomg(right) && SvIV_please_nomg(left)) { if (!SvUOK(left)) { const IV leftiv = SvIVX(left); if (!SvUOK(right)) { /* ## IV <=> IV ## */ const IV rightiv = SvIVX(right); return (leftiv > rightiv) - (leftiv < rightiv); } /* ## IV <=> UV ## */ if (leftiv < 0) /* As (b) is a UV, it's >=0, so it must be < */ return -1; return ((UV)leftiv > SvUVX(right)) - ((UV)leftiv < SvUVX(right)); } if (SvUOK(right)) { /* ## UV <=> UV ## */ const UV leftuv = SvUVX(left); const UV rightuv = SvUVX(right); return (leftuv > rightuv) - (leftuv < rightuv); } /* ## UV <=> IV ## */ if (SvIVX(right) < 0) /* As (a) is a UV, it's >=0, so it cannot be < */ return 1; return (SvUVX(left) > SvUVX(right)) - (SvUVX(left) < SvUVX(right)); } else { #ifdef SvNV_nomg NV const rnv = SvNV_nomg(right); NV const lnv = SvNV_nomg(left); #else NV const rnv = slu_sv_value(right); NV const lnv = slu_sv_value(left); #endif #if defined(NAN_COMPARE_BROKEN) && defined(Perl_isnan) if (Perl_isnan(lnv) || Perl_isnan(rnv)) return 2; return (lnv > rnv) - (lnv < rnv); #else if (lnv < rnv) return -1; if (lnv > rnv) return 1; if (lnv == rnv) return 0; return 2; #endif } } #define ncmp(left,right) LMUncmp(aTHX_ left,right) #define FUNC_NAME GvNAME(GvEGV(ST(items))) /* shameless stolen from PadWalker */ #ifndef PadARRAY typedef AV PADNAMELIST; typedef SV PADNAME; # if PERL_VERSION_LE(5,8,0) typedef AV PADLIST; typedef AV PAD; # endif # define PadlistARRAY(pl) ((PAD **)AvARRAY(pl)) # define PadlistMAX(pl) av_len(pl) # define PadlistNAMES(pl) (*PadlistARRAY(pl)) # define PadnamelistARRAY(pnl) ((PADNAME **)AvARRAY(pnl)) # define PadnamelistMAX(pnl) av_len(pnl) # define PadARRAY AvARRAY # define PadnameIsOUR(pn) !!(SvFLAGS(pn) & SVpad_OUR) # define PadnameOURSTASH(pn) SvOURSTASH(pn) # define PadnameOUTER(pn) !!SvFAKE(pn) # define PadnamePV(pn) (SvPOKp(pn) ? SvPVX(pn) : NULL) #endif static int in_pad (pTHX_ SV *code) { GV *gv; HV *stash; CV *cv = sv_2cv(code, &stash, &gv, 0); PADLIST *pad_list = (CvPADLIST(cv)); PADNAMELIST *pad_namelist = PadlistNAMES(pad_list); int i; for (i=PadnamelistMAX(pad_namelist); i>=0; --i) { PADNAME* name_sv = PadnamelistARRAY(pad_namelist)i; if (name_sv) { char *name_str = PadnamePV(name_sv); if (name_str) { /* perl < 5.6.0 does not yet have our */ # ifdef SVpad_OUR if(PadnameIsOUR(name_sv)) continue; # endif #if PERL_VERSION_LT(5,21,7) if (!SvOK(name_sv)) continue; #endif if (strEQ(name_str, "$a") || strEQ(name_str, "$b")) return 1; } } } return 0; } #define WARN_OFF \ SV *oldwarn = PL_curcop->cop_warnings; \ PL_curcop->cop_warnings = pWARN_NONE; #define WARN_ON \ PL_curcop->cop_warnings = oldwarn; #define EACH_ARRAY_BODY \ int i; \ arrayeach_args * args; \ HV *stash = gv_stashpv("List::MoreUtils::XS_ea", TRUE); \ CV *closure = newXS(NULL, XS_List__MoreUtils__XS__array_iterator, __FILE__); \ \ /* prototype */ \ sv_setpv((SV*)closure, ";$"); \ \ New(0, args, 1, arrayeach_args); \ New(0, args->avs, items, AV*); \ args->navs = items; \ args->curidx = 0; \ \ for (i = 0; i < items; i++) { \ if(UNLIKELY(!arraylike(ST(i)))) \ croak_xs_usage(cv, "\\@;\\@\\@..."); \ args->avsi = (AV*)SvRV(ST(i)); \ SvREFCNT_inc(args->avsi); \ } \ \ CvXSUBANY(closure).any_ptr = args; \ RETVAL = newRV_noinc((SV*)closure); \ \ /* in order to allow proper cleanup in DESTROY-handler */ \ sv_bless(RETVAL, stash) #define LMUFECPY(a) (a) #define dMULTICALLSVCV \ HV *stash; \ GV *gv; \ I32 gimme = G_SCALAR; \ CV *mc_cv = sv_2cv(code, &stash, &gv, 0) #define FOR_EACH(on_item) \ if(!codelike(code)) \ croak_xs_usage(cv, "code, ..."); \ \ if (items > 1) { \ dMULTICALL; \ dMULTICALLSVCV; \ int i; \ SV **args = &PL_stack_baseax; \ PUSH_MULTICALL(mc_cv); \ SAVESPTR(GvSV(PL_defgv)); \ \ for(i = 1 ; i < items ; ++i) { \ GvSV(PL_defgv) = LMUFECPY(argsi); \ MULTICALL; \ on_item; \ } \ POP_MULTICALL; \ } #define TRUE_JUNCTION \ FOR_EACH(if (SvTRUE(*PL_stack_sp)) ON_TRUE) \ else ON_EMPTY; #define FALSE_JUNCTION \ FOR_EACH(if (!SvTRUE(*PL_stack_sp)) ON_FALSE) \ else ON_EMPTY; #define ROF_EACH(on_item) \ if(!codelike(code)) \ croak_xs_usage(cv, "code, ..."); \ \ if (items > 1) { \ dMULTICALL; \ dMULTICALLSVCV; \ int i; \ SV **args = &PL_stack_baseax; \ PUSH_MULTICALL(mc_cv); \ SAVESPTR(GvSV(PL_defgv)); \ \ for(i = items-1; i > 0; --i) { \ GvSV(PL_defgv) = LMUFECPY(argsi); \ MULTICALL; \ on_item; \ } \ POP_MULTICALL; \ } #define REDUCE_WITH(init) \ dMULTICALL; \ dMULTICALLSVCV; \ SV *rc, **args = &PL_stack_baseax; \ IV i; \ \ if(!codelike(code)) \ croak_xs_usage(cv, "code, list, list"); \ \ if (in_pad(aTHX_ code)) { \ croak("Can't use lexical $a or $b in pairwise code block"); \ } \ \ rc = (init); \ sv_2mortal(newRV_noinc(rc)); \ \ PUSH_MULTICALL(mc_cv); \ SAVESPTR(GvSV(PL_defgv)); \ \ /* Following code is stolen on request of */ \ /* Zefram from pp_sort.c of perl core 16ada23 */ \ /* I have no idea why it's necessary and there */\ /* is no reasonable documentation regarding */ \ /* deal with localized $a/$b/$_ */ \ SAVEGENERICSV(PL_firstgv); \ SAVEGENERICSV(PL_secondgv); \ PL_firstgv = MUTABLE_GV(SvREFCNT_inc( \ gv_fetchpvs("a", GV_ADD|GV_NOTQUAL, SVt_PV) \ )); \ PL_secondgv = MUTABLE_GV(SvREFCNT_inc( \ gv_fetchpvs("b", GV_ADD|GV_NOTQUAL, SVt_PV) \ )); \ save_gp(PL_firstgv, 0); save_gp(PL_secondgv, 0); \ GvINTRO_off(PL_firstgv); \ GvINTRO_off(PL_secondgv); \ SAVEGENERICSV(GvSV(PL_firstgv)); \ SvREFCNT_inc(GvSV(PL_firstgv)); \ SAVEGENERICSV(GvSV(PL_secondgv)); \ SvREFCNT_inc(GvSV(PL_secondgv)); \ \ for (i = 1; i < items; ++i) \ { \ SV *olda, *oldb; \ sv_setiv(GvSV(PL_defgv), i-1); \ \ olda = GvSV(PL_firstgv); \ oldb = GvSV(PL_secondgv); \ GvSV(PL_firstgv) = SvREFCNT_inc_simple_NN(rc); \ GvSV(PL_secondgv) = SvREFCNT_inc_simple_NN(argsi); \ SvREFCNT_dec(olda); \ SvREFCNT_dec(oldb); \ MULTICALL; \ \ SvSetMagicSV(rc, *PL_stack_sp); \ } \ \ POP_MULTICALL; \ \ EXTEND(SP, 1); \ ST(0) = sv_2mortal(newSVsv(rc)); \ XSRETURN(1) #define COUNT_ARGS \ for (i = 0; i < items; i++) { \ SvGETMAGIC(argsi); \ if(SvOK(argsi)) { \ HE *he; \ SvSetSV_nosteal(tmp, argsi); \ he = hv_fetch_ent(hv, tmp, 0, 0); \ if (NULL == he) { \ argscount++ = argsi; \ hv_store_ent(hv, tmp, newSViv(1), 0); \ } \ else { \ SV *v = HeVAL(he); \ IV how_many = SvIVX(v); \ sv_setiv(v, ++how_many); \ } \ } \ else if(0 == seen_undef++) { \ argscount++ = argsi; \ } \ } #define COUNT_ARGS_MAX \ do { \ for (i = 0; i < items; i++) { \ SvGETMAGIC(argsi); \ if(SvOK(argsi)) { \ HE *he; \ SvSetSV_nosteal(tmp, argsi); \ he = hv_fetch_ent(hv, tmp, 0, 0); \ if (NULL == he) { \ argscount++ = argsi; \ hv_store_ent(hv, tmp, newSViv(1), 0); \ } \ else { \ SV *v = HeVAL(he); \ IV how_many = SvIVX(v); \ if(UNLIKELY(max < ++how_many)) \ max = how_many; \ sv_setiv(v, how_many); \ } \ } \ else if(0 == seen_undef++) { \ argscount++ = argsi; \ } \ } \ if(UNLIKELY(max < seen_undef)) max = seen_undef; \ } while(0) /* need this one for array_each() */ typedef struct { AV **avs; /* arrays over which to iterate in parallel */ int navs; /* number of arrays */ int curidx; /* the current index of the iterator */ } arrayeach_args; /* used for natatime */ typedef struct { SV **svs; int nsvs; int curidx; int natatime; } natatime_args; static void insert_after (pTHX_ int idx, SV *what, AV *av) { int i, len; av_extend(av, (len = av_len(av) + 1)); for (i = len; i > idx+1; i--) { SV **sv = av_fetch(av, i-1, FALSE); SvREFCNT_inc(*sv); av_store(av, i, *sv); } if (!av_store(av, idx+1, what)) SvREFCNT_dec(what); } static int is_like(pTHX_ SV *sv, const char *like) { int likely = 0; if( sv_isobject( sv ) ) { dSP; int count; ENTER; SAVETMPS; PUSHMARK(SP); XPUSHs( sv_2mortal( newSVsv( sv ) ) ); XPUSHs( sv_2mortal( newSVpv( like, strlen(like) ) ) ); PUTBACK; if( ( count = call_pv("overload::Method", G_SCALAR) ) ) { I32 ax; SPAGAIN; SP -= count; ax = (SP - PL_stack_base) + 1; if( SvTRUE(ST(0)) ) ++likely; } FREETMPS; LEAVE; } return likely; } static int is_array(SV *sv) { return SvROK(sv) && ( SVt_PVAV == SvTYPE(SvRV(sv) ) ); } static int LMUcodelike(pTHX_ SV *code) { SvGETMAGIC(code); return SvROK(code) && ( ( SVt_PVCV == SvTYPE(SvRV(code)) ) || ( is_like(aTHX_ code, "&{}" ) ) ); } #define codelike(code) LMUcodelike(aTHX_ code) static int LMUarraylike(pTHX_ SV *array) { SvGETMAGIC(array); return is_array(array) || is_like(aTHX_ array, "@{}" ); } #define arraylike(array) LMUarraylike(aTHX_ array) static void LMUav2flat(pTHX_ AV *tgt, AV *args) { I32 k = 0, j = av_len(args) + 1; av_extend(tgt, AvFILLp(tgt) + j); while( --j >= 0 ) { SV *sv = *av_fetch(args, k++, FALSE); if(arraylike(sv)) { AV *av = (AV *)SvRV(sv); LMUav2flat(aTHX_ tgt, av); } else { // av_push(tgt, newSVsv(sv)); av_push(tgt, SvREFCNT_inc(sv)); } } } /*- * Copyright (c) 1992, 1993 * The Regents of the University of California. All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. Neither the name of the University nor the names of its contributors * may be used to endorse or promote products derived from this software * without specific prior written permission. * * THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY * OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF * SUCH DAMAGE. */ /* * FreeBSD's Qsort routine from Bentley & McIlroy's "Engineering a Sort Function". * Modified for using Perl Sub (no XSUB) via MULTICALL and all values are SV ** */ static inline void swapfunc(SV **a, SV **b, size_t n) { SV **pa = a; SV **pb = b; while(n-- > 0) { SV *t = *pa; *pa++ = *pb; *pb++ = t; } } #define swap(a, b) \ do { \ SV *t = *(a); \ *(a) = *(b); \ *(b) = t; \ } while(0) #define vecswap(a, b, n) \ if ((n) > 0) swapfunc(a, b, n) #if HAVE_FEATURE_STATEMENT_EXPRESSION # define CMP(x, y) ({ \ GvSV(PL_firstgv) = *(x); \ GvSV(PL_secondgv) = *(y); \ MULTICALL; \ SvIV(*PL_stack_sp); \ }) #else static inline int _cmpsvs(pTHX_ SV *x, SV *y, OP *multicall_cop ) { GvSV(PL_firstgv) = x; GvSV(PL_secondgv) = y; MULTICALL; return SvIV(*PL_stack_sp); } # define CMP(x, y) _cmpsvs(aTHX_ *(x), *(y), multicall_cop) #endif #define MED3(a, b, c) ( \ CMP(a, b) < 0 ? \ (CMP(b, c) < 0 ? b : (CMP(a, c) < 0 ? c : a )) \ :(CMP(b, c) > 0 ? b : (CMP(a, c) < 0 ? a : c )) \ ) static void bsd_qsort_r(pTHX_ SV **ary, size_t nelem, OP *multicall_cop) { SV **pa, **pb, **pc, **pd, **pl, **pm, **pn; size_t d1, d2; int cmp_result, swap_cnt = 0; loop: if (nelem < 7) { for (pm = ary + 1; pm < ary + nelem; ++pm) for (pl = pm; pl > ary && CMP(pl - 1, pl) > 0; pl -= 1) swap(pl, pl - 1); return; } pm = ary + (nelem / 2); if (nelem > 7) { pl = ary; pn = ary + (nelem - 1); if (nelem > 40) { size_t d = (nelem / 8); pl = MED3(pl, pl + d, pl + 2 * d); pm = MED3(pm - d, pm, pm + d); pn = MED3(pn - 2 * d, pn - d, pn); } pm = MED3(pl, pm, pn); } swap(ary, pm); pa = pb = ary + 1; pc = pd = ary + (nelem - 1); for (;;) { while (pb <= pc && (cmp_result = CMP(pb, ary)) <= 0) { if (cmp_result == 0) { swap_cnt = 1; swap(pa, pb); pa += 1; } pb += 1; } while (pb <= pc && (cmp_result = CMP(pc, ary)) >= 0) { if (cmp_result == 0) { swap_cnt = 1; swap(pc, pd); pd -= 1; } pc -= 1; } if (pb > pc) break; swap(pb, pc); swap_cnt = 1; pb += 1; pc -= 1; } if (swap_cnt == 0) { /* Switch to insertion sort */ for (pm = ary + 1; pm < ary + nelem; pm += 1) for (pl = pm; pl > ary && CMP(pl - 1, pl) > 0; pl -= 1) swap(pl, pl - 1); return; } pn = ary + nelem; d1 = MIN(pa - ary, pb - pa); vecswap(ary, pb - d1, d1); d1 = MIN(pd - pc, pn - pd - 1); vecswap(pb, pn - d1, d1); d1 = pb - pa; d2 = pd - pc; if (d1 <= d2) { /* Recurse on left partition, then iterate on right partition */ if (d1 > 1) bsd_qsort_r(aTHX_ ary, d1, multicall_cop); if (d2 > 1) { /* Iterate rather than recurse to save stack space */ /* qsort(pn - d2, d2, multicall_cop); */ ary = pn - d2; nelem = d2; goto loop; } } else { /* Recurse on right partition, then iterate on left partition */ if (d2 > 1) bsd_qsort_r(aTHX_ pn - d2, d2, multicall_cop); if (d1 > 1) { /* Iterate rather than recurse to save stack space */ /* qsort(ary, d1, multicall_cop); */ nelem = d1; goto loop; } } } /* lower_bound algorithm from STL - see http://en.cppreference.com/w/cpp/algorithm/lower_bound */ #define LOWER_BOUND(at) \ while (count > 0) { \ ssize_t step = count / 2; \ ssize_t it = first + step; \ \ GvSV(PL_defgv) = at; \ MULTICALL; \ cmprc = SvIV(*PL_stack_sp); \ if (cmprc < 0) { \ first = ++it; \ count -= step + 1; \ } \ else \ count = step; \ } #define LOWER_BOUND_QUICK(at) \ while (count > 0) { \ ssize_t step = count / 2; \ ssize_t it = first + step; \ \ GvSV(PL_defgv) = at; \ MULTICALL; \ cmprc = SvIV(*PL_stack_sp); \ if(UNLIKELY(0 == cmprc)) { \ first = it; \ break; \ } \ if (cmprc < 0) { \ first = ++it; \ count -= step + 1; \ } \ else \ count = step; \ } /* upper_bound algorithm from STL - see http://en.cppreference.com/w/cpp/algorithm/upper_bound */ #define UPPER_BOUND(at) \ while (count > 0) { \ ssize_t step = count / 2; \ ssize_t it = first + step; \ \ GvSV(PL_defgv) = at; \ MULTICALL; \ cmprc = SvIV(*PL_stack_sp); \ if (cmprc <= 0) { \ first = ++it; \ count -= step + 1; \ } \ else \ count = step; \ } #line 872 "XS.c" #ifndef PERL_UNUSED_VAR # define PERL_UNUSED_VAR(var) if (0) var = var #endif #ifndef dVAR # define dVAR dNOOP #endif /* This stuff is not part of the API! You have been warned. */ #ifndef PERL_VERSION_DECIMAL # define PERL_VERSION_DECIMAL(r,v,s) (r*1000000 + v*1000 + s) #endif #ifndef PERL_DECIMAL_VERSION # define PERL_DECIMAL_VERSION \ PERL_VERSION_DECIMAL(PERL_REVISION,PERL_VERSION,PERL_SUBVERSION) #endif #ifndef PERL_VERSION_GE # define PERL_VERSION_GE(r,v,s) \ (PERL_DECIMAL_VERSION >= PERL_VERSION_DECIMAL(r,v,s)) #endif #ifndef PERL_VERSION_LE # define PERL_VERSION_LE(r,v,s) \ (PERL_DECIMAL_VERSION <= PERL_VERSION_DECIMAL(r,v,s)) #endif /* XS_INTERNAL is the explicit static-linkage variant of the default * XS macro. * * XS_EXTERNAL is the same as XS_INTERNAL except it does not include * "STATIC", ie. it exports XSUB symbols. You probably don't want that * for anything but the BOOT XSUB. * * See XSUB.h in core! */ /* TODO: This might be compatible further back than 5.10.0. */ #if PERL_VERSION_GE(5, 10, 0) && PERL_VERSION_LE(5, 15, 1) # undef XS_EXTERNAL # undef XS_INTERNAL # if defined(__CYGWIN__) && defined(USE_DYNAMIC_LOADING) # define XS_EXTERNAL(name) __declspec(dllexport) XSPROTO(name) # define XS_INTERNAL(name) STATIC XSPROTO(name) # endif # if defined(__SYMBIAN32__) # define XS_EXTERNAL(name) EXPORT_C XSPROTO(name) # define XS_INTERNAL(name) EXPORT_C STATIC XSPROTO(name) # endif # ifndef XS_EXTERNAL # if defined(HASATTRIBUTE_UNUSED) && !defined(__cplusplus) # define XS_EXTERNAL(name) void name(pTHX_ CV* cv __attribute__unused__) # define XS_INTERNAL(name) STATIC void name(pTHX_ CV* cv __attribute__unused__) # else # ifdef __cplusplus # define XS_EXTERNAL(name) extern "C" XSPROTO(name) # define XS_INTERNAL(name) static XSPROTO(name) # else # define XS_EXTERNAL(name) XSPROTO(name) # define XS_INTERNAL(name) STATIC XSPROTO(name) # endif # endif # endif #endif /* perl >= 5.10.0 && perl <= 5.15.1 */ /* The XS_EXTERNAL macro is used for functions that must not be static * like the boot XSUB of a module. If perl didn't have an XS_EXTERNAL * macro defined, the best we can do is assume XS is the same. * Dito for XS_INTERNAL. */ #ifndef XS_EXTERNAL # define XS_EXTERNAL(name) XS(name) #endif #ifndef XS_INTERNAL # define XS_INTERNAL(name) XS(name) #endif /* Now, finally, after all this mess, we want an ExtUtils::ParseXS * internal macro that we're free to redefine for varying linkage due * to the EXPORT_XSUB_SYMBOLS XS keyword. This is internal, use * XS_EXTERNAL(name) or XS_INTERNAL(name) in your code if you need to! */ #undef XS_EUPXS #if defined(PERL_EUPXS_ALWAYS_EXPORT) # define XS_EUPXS(name) XS_EXTERNAL(name) #else /* default to internal */ # define XS_EUPXS(name) XS_INTERNAL(name) #endif #ifndef PERL_ARGS_ASSERT_CROAK_XS_USAGE #define PERL_ARGS_ASSERT_CROAK_XS_USAGE assert(cv); assert(params) /* prototype to pass -Wmissing-prototypes */ STATIC void S_croak_xs_usage(const CV *const cv, const char *const params); STATIC void S_croak_xs_usage(const CV *const cv, const char *const params) { const GV *const gv = CvGV(cv); PERL_ARGS_ASSERT_CROAK_XS_USAGE; if (gv) { const char *const gvname = GvNAME(gv); const HV *const stash = GvSTASH(gv); const char *const hvname = stash ? HvNAME(stash) : NULL; if (hvname) Perl_croak_nocontext("Usage: %s::%s(%s)", hvname, gvname, params); else Perl_croak_nocontext("Usage: %s(%s)", gvname, params); } else { /* Pants. I don't think that it should be possible to get here. */ Perl_croak_nocontext("Usage: CODE(0x%" UVxf ")(%s)", PTR2UV(cv), params); } } #undef PERL_ARGS_ASSERT_CROAK_XS_USAGE #define croak_xs_usage S_croak_xs_usage #endif /* NOTE: the prototype of newXSproto() is different in versions of perls, * so we define a portable version of newXSproto() */ #ifdef newXS_flags #define newXSproto_portable(name, c_impl, file, proto) newXS_flags(name, c_impl, file, proto, 0) #else #define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)newXS(name, c_impl, file), sv_setpv(PL_Sv, proto), (CV*)PL_Sv) #endif /* !defined(newXS_flags) */ #if PERL_VERSION_LE(5, 21, 5) # define newXS_deffile(a,b) Perl_newXS(aTHX_ a,b,file) #else # define newXS_deffile(a,b) Perl_newXS_deffile(aTHX_ a,b) #endif #line 1016 "XS.c" XS_EUPXS(XS_List__MoreUtils__XS_ea_DESTROY); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_ea_DESTROY) { dVAR; dXSARGS; if (items != 1) croak_xs_usage(cv, "sv"); { SV * sv = ST(0) ; #line 868 "XS.xs" { int i; CV *code = (CV*)SvRV(sv); arrayeach_args *args = (arrayeach_args *)(CvXSUBANY(code).any_ptr); if (args) { for (i = 0; i < args->navs; ++i) SvREFCNT_dec(args->avsi); Safefree(args->avs); Safefree(args); CvXSUBANY(code).any_ptr = NULL; } } #line 1042 "XS.c" } XSRETURN_EMPTY; } XS_EUPXS(XS_List__MoreUtils__XS_na_DESTROY); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_na_DESTROY) { dVAR; dXSARGS; if (items != 1) croak_xs_usage(cv, "sv"); { SV * sv = ST(0) ; #line 890 "XS.xs" { int i; CV *code = (CV*)SvRV(sv); natatime_args *args = (natatime_args *)(CvXSUBANY(code).any_ptr); if (args) { for (i = 0; i < args->nsvs; ++i) SvREFCNT_dec(args->svsi); Safefree(args->svs); Safefree(args); CvXSUBANY(code).any_ptr = NULL; } } #line 1072 "XS.c" } XSRETURN_EMPTY; } XS_EUPXS(XS_List__MoreUtils__XS_any); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_any) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; #line 912 "XS.xs" { #define ON_TRUE { POP_MULTICALL; XSRETURN_YES; } #define ON_EMPTY XSRETURN_NO TRUE_JUNCTION; XSRETURN_NO; #undef ON_EMPTY #undef ON_TRUE } #line 1096 "XS.c" } XSRETURN_EMPTY; } XS_EUPXS(XS_List__MoreUtils__XS_all); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_all) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; #line 926 "XS.xs" { #define ON_FALSE { POP_MULTICALL; XSRETURN_NO; } #define ON_EMPTY XSRETURN_YES FALSE_JUNCTION; XSRETURN_YES; #undef ON_EMPTY #undef ON_FALSE } #line 1120 "XS.c" } XSRETURN_EMPTY; } XS_EUPXS(XS_List__MoreUtils__XS_none); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_none) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; #line 941 "XS.xs" { #define ON_TRUE { POP_MULTICALL; XSRETURN_NO; } #define ON_EMPTY XSRETURN_YES TRUE_JUNCTION; XSRETURN_YES; #undef ON_EMPTY #undef ON_TRUE } #line 1144 "XS.c" } XSRETURN_EMPTY; } XS_EUPXS(XS_List__MoreUtils__XS_notall); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_notall) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; #line 955 "XS.xs" { #define ON_FALSE { POP_MULTICALL; XSRETURN_YES; } #define ON_EMPTY XSRETURN_NO FALSE_JUNCTION; XSRETURN_NO; #undef ON_EMPTY #undef ON_FALSE } #line 1168 "XS.c" } XSRETURN_EMPTY; } XS_EUPXS(XS_List__MoreUtils__XS_one); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_one) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; #line 969 "XS.xs" { int found = 0; #define ON_TRUE { if (found++) { POP_MULTICALL; XSRETURN_NO; }; } #define ON_EMPTY XSRETURN_NO TRUE_JUNCTION; if (found) XSRETURN_YES; XSRETURN_NO; #undef ON_EMPTY #undef ON_TRUE } #line 1195 "XS.c" } XSRETURN_EMPTY; } XS_EUPXS(XS_List__MoreUtils__XS_any_u); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_any_u) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; #line 986 "XS.xs" { #define ON_TRUE { POP_MULTICALL; XSRETURN_YES; } #define ON_EMPTY XSRETURN_UNDEF TRUE_JUNCTION; XSRETURN_NO; #undef ON_EMPTY #undef ON_TRUE } #line 1219 "XS.c" } XSRETURN_EMPTY; } XS_EUPXS(XS_List__MoreUtils__XS_all_u); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_all_u) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; #line 1000 "XS.xs" { #define ON_FALSE { POP_MULTICALL; XSRETURN_NO; } #define ON_EMPTY XSRETURN_UNDEF FALSE_JUNCTION; XSRETURN_YES; #undef ON_EMPTY #undef ON_FALSE } #line 1243 "XS.c" } XSRETURN_EMPTY; } XS_EUPXS(XS_List__MoreUtils__XS_none_u); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_none_u) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; #line 1015 "XS.xs" { #define ON_TRUE { POP_MULTICALL; XSRETURN_NO; } #define ON_EMPTY XSRETURN_UNDEF TRUE_JUNCTION; XSRETURN_YES; #undef ON_EMPTY #undef ON_TRUE } #line 1267 "XS.c" } XSRETURN_EMPTY; } XS_EUPXS(XS_List__MoreUtils__XS_notall_u); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_notall_u) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; #line 1029 "XS.xs" { #define ON_FALSE { POP_MULTICALL; XSRETURN_YES; } #define ON_EMPTY XSRETURN_UNDEF FALSE_JUNCTION; XSRETURN_NO; #undef ON_EMPTY #undef ON_FALSE } #line 1291 "XS.c" } XSRETURN_EMPTY; } XS_EUPXS(XS_List__MoreUtils__XS_one_u); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_one_u) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; #line 1043 "XS.xs" { int found = 0; #define ON_TRUE { if (found++) { POP_MULTICALL; XSRETURN_NO; }; } #define ON_EMPTY XSRETURN_UNDEF TRUE_JUNCTION; if (found) XSRETURN_YES; XSRETURN_NO; #undef ON_EMPTY #undef ON_TRUE } #line 1318 "XS.c" } XSRETURN_EMPTY; } XS_EUPXS(XS_List__MoreUtils__XS_reduce_u); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_reduce_u) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; #line 1060 "XS.xs" { REDUCE_WITH(newSVsv(&PL_sv_undef)); } #line 1337 "XS.c" } XSRETURN_EMPTY; } XS_EUPXS(XS_List__MoreUtils__XS_reduce_0); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_reduce_0) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; #line 1069 "XS.xs" { REDUCE_WITH(newSViv(0)); } #line 1356 "XS.c" } XSRETURN_EMPTY; } XS_EUPXS(XS_List__MoreUtils__XS_reduce_1); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_reduce_1) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; #line 1078 "XS.xs" { REDUCE_WITH(newSViv(1)); } #line 1375 "XS.c" } XSRETURN_EMPTY; } XS_EUPXS(XS_List__MoreUtils__XS_true); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_true) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; int RETVAL; dXSTARG; #line 1087 "XS.xs" { I32 count = 0; FOR_EACH(if (SvTRUE(*PL_stack_sp)) count++); RETVAL = count; } #line 1398 "XS.c" XSprePUSH; PUSHi((IV)RETVAL); } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_false); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_false) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; int RETVAL; dXSTARG; #line 1100 "XS.xs" { I32 count = 0; FOR_EACH(if (!SvTRUE(*PL_stack_sp)) count++); RETVAL = count; } #line 1422 "XS.c" XSprePUSH; PUSHi((IV)RETVAL); } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_firstidx); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_firstidx) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; int RETVAL; dXSTARG; #line 1113 "XS.xs" { RETVAL = -1; FOR_EACH(if (SvTRUE(*PL_stack_sp)) { RETVAL = i-1; break; }); } #line 1445 "XS.c" XSprePUSH; PUSHi((IV)RETVAL); } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_firstval); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_firstval) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; SV * RETVAL; #line 1125 "XS.xs" { RETVAL = &PL_sv_undef; FOR_EACH(if (SvTRUE(*PL_stack_sp)) { SvREFCNT_inc(RETVAL = argsi); break; }); } #line 1467 "XS.c" RETVAL = sv_2mortal(RETVAL); ST(0) = RETVAL; } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_firstres); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_firstres) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; SV * RETVAL; #line 1137 "XS.xs" { RETVAL = &PL_sv_undef; FOR_EACH(if (SvTRUE(*PL_stack_sp)) { SvREFCNT_inc(RETVAL = *PL_stack_sp); break; }); } #line 1490 "XS.c" RETVAL = sv_2mortal(RETVAL); ST(0) = RETVAL; } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_onlyidx); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_onlyidx) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; int RETVAL; dXSTARG; #line 1149 "XS.xs" { int found = 0; RETVAL = -1; FOR_EACH(if (SvTRUE(*PL_stack_sp)) { if (found++) {RETVAL = -1; break;} RETVAL = i-1; }); } #line 1515 "XS.c" XSprePUSH; PUSHi((IV)RETVAL); } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_onlyval); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_onlyval) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; SV * RETVAL; #line 1162 "XS.xs" { int found = 0; RETVAL = &PL_sv_undef; FOR_EACH(if (SvTRUE(*PL_stack_sp)) { if (found++) {SvREFCNT_dec(RETVAL); RETVAL = &PL_sv_undef; break;} SvREFCNT_inc(RETVAL = argsi); }); } #line 1538 "XS.c" RETVAL = sv_2mortal(RETVAL); ST(0) = RETVAL; } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_onlyres); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_onlyres) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; SV * RETVAL; #line 1175 "XS.xs" { int found = 0; RETVAL = &PL_sv_undef; FOR_EACH(if (SvTRUE(*PL_stack_sp)) { if (found++) {SvREFCNT_dec(RETVAL); RETVAL = &PL_sv_undef; break;}SvREFCNT_inc(RETVAL = *PL_stack_sp); }); } #line 1562 "XS.c" RETVAL = sv_2mortal(RETVAL); ST(0) = RETVAL; } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_lastidx); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_lastidx) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; int RETVAL; dXSTARG; #line 1188 "XS.xs" { RETVAL = -1; ROF_EACH(if (SvTRUE(*PL_stack_sp)){RETVAL = i-1;break;}) } #line 1586 "XS.c" XSprePUSH; PUSHi((IV)RETVAL); } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_lastval); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_lastval) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; SV * RETVAL; #line 1200 "XS.xs" { RETVAL = &PL_sv_undef; ROF_EACH(if (SvTRUE(*PL_stack_sp)) { /* see comment in indexes() */ SvREFCNT_inc(RETVAL = argsi); break; }); } #line 1608 "XS.c" RETVAL = sv_2mortal(RETVAL); ST(0) = RETVAL; } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_lastres); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_lastres) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; SV * RETVAL; #line 1212 "XS.xs" { RETVAL = &PL_sv_undef; ROF_EACH(if (SvTRUE(*PL_stack_sp)) { SvREFCNT_inc(RETVAL = *PL_stack_sp); break; }); } #line 1631 "XS.c" RETVAL = sv_2mortal(RETVAL); ST(0) = RETVAL; } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_insert_after); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_insert_after) { dVAR; dXSARGS; if (items != 3) croak_xs_usage(cv, "code, val, avref"); { SV * code = ST(0) ; SV * val = ST(1) ; SV * avref = ST(2) ; int RETVAL; dXSTARG; #line 1226 "XS.xs" { dMULTICALL; dMULTICALLSVCV; int i; int len; AV *av; if(!codelike(code)) croak_xs_usage(cv, "code, val, \\@area_of_operation"); if(!arraylike(avref)) croak_xs_usage(cv, "code, val, \\@area_of_operation"); av = (AV*)SvRV(avref); len = av_len(av); RETVAL = 0; PUSH_MULTICALL(mc_cv); SAVESPTR(GvSV(PL_defgv)); for (i = 0; i <= len ; ++i) { GvSV(PL_defgv) = *av_fetch(av, i, FALSE); MULTICALL; if (SvTRUE(*PL_stack_sp)) { RETVAL = 1; break; } } POP_MULTICALL; if (RETVAL) { SvREFCNT_inc(val); insert_after(aTHX_ i, val, av); } } #line 1693 "XS.c" XSprePUSH; PUSHi((IV)RETVAL); } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_insert_after_string); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_insert_after_string) { dVAR; dXSARGS; if (items != 3) croak_xs_usage(cv, "string, val, avref"); { SV * string = ST(0) ; SV * val = ST(1) ; SV * avref = ST(2) ; int RETVAL; dXSTARG; #line 1274 "XS.xs" { int i, len; AV *av; RETVAL = 0; if(!arraylike(avref)) croak_xs_usage(cv, "string, val, \\@area_of_operation"); av = (AV*)SvRV(avref); len = av_len(av); for (i = 0; i <= len ; i++) { SV **sv = av_fetch(av, i, FALSE); if((SvFLAGS(*sv) & (SVf_OK & ~SVf_ROK)) && (0 == sv_cmp_locale(string, *sv))) { RETVAL = 1; break; } } if (RETVAL) { SvREFCNT_inc(val); insert_after(aTHX_ i, val, av); } } #line 1743 "XS.c" XSprePUSH; PUSHi((IV)RETVAL); } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_apply); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_apply) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; #line 1309 "XS.xs" { if(!codelike(code)) croak_xs_usage(cv, "code, ..."); if (items > 1) { dMULTICALL; dMULTICALLSVCV; int i; SV **args = &PL_stack_baseax; AV *rc = newAV(); sv_2mortal(newRV_noinc((SV*)rc)); av_extend(rc, items-1); PUSH_MULTICALL(mc_cv); SAVESPTR(GvSV(PL_defgv)); for(i = 1 ; i < items ; ++i) { av_push(rc, newSVsv(argsi)); GvSV(PL_defgv) = AvARRAY(rc)AvFILLp(rc); MULTICALL; } POP_MULTICALL; for(i = items - 1; i > 0; --i) { ST(i-1) = sv_2mortal(AvARRAY(rc)i-1); AvARRAY(rc)i-1 = NULL; } AvFILLp(rc) = -1; } XSRETURN(items-1); } #line 1795 "XS.c" } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_after); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_after) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; #line 1350 "XS.xs" { int k = items, j; FOR_EACH(if (SvTRUE(*PL_stack_sp)) {k=i; break;}); for (j = k + 1; j < items; ++j) ST(j-k-1) = ST(j); j = items-k-1; XSRETURN(j > 0 ? j : 0); } #line 1820 "XS.c" } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_after_incl); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_after_incl) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; #line 1365 "XS.xs" { int k = items, j; FOR_EACH(if (SvTRUE(*PL_stack_sp)) {k=i; break;}); for (j = k; j < items; j++) ST(j-k) = ST(j); XSRETURN(items-k); } #line 1844 "XS.c" } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_before); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_before) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; #line 1379 "XS.xs" { int k = items - 1; FOR_EACH(if (SvTRUE(*PL_stack_sp)) {k=i-1; break;}; argsi-1 = argsi;); XSRETURN(k); } #line 1866 "XS.c" } XSRETURN_EMPTY; } XS_EUPXS(XS_List__MoreUtils__XS_before_incl); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_before_incl) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; #line 1391 "XS.xs" { int k = items - 1; FOR_EACH(argsi-1 = argsi; if (SvTRUE(*PL_stack_sp)) {k=i; break;}); XSRETURN(k); } #line 1888 "XS.c" } XSRETURN_EMPTY; } XS_EUPXS(XS_List__MoreUtils__XS_indexes); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_indexes) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "code, ..."); { SV * code = ST(0) ; #line 1403 "XS.xs" { if(!codelike(code)) croak_xs_usage(cv, "code, ..."); if (items > 1) { dMULTICALL; dMULTICALLSVCV; int i; SV **args = &PL_stack_baseax; AV *rc = newAV(); sv_2mortal(newRV_noinc((SV*)rc)); av_extend(rc, items-1); PUSH_MULTICALL(mc_cv); SAVESPTR(GvSV(PL_defgv)); for(i = 1 ; i < items ; ++i) { GvSV(PL_defgv) = argsi; MULTICALL; if (SvTRUE(*PL_stack_sp)) av_push(rc, newSViv(i-1)); } POP_MULTICALL; for(i = av_len(rc); i >= 0; --i) { ST(i) = sv_2mortal(AvARRAY(rc)i); AvARRAY(rc)i = NULL; } i = AvFILLp(rc) + 1; AvFILLp(rc) = -1; XSRETURN(i); } XSRETURN_EMPTY; } #line 1944 "XS.c" } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS__array_iterator); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS__array_iterator) { dVAR; dXSARGS; if (items < 0 || items > 1) croak_xs_usage(cv, "method = \"\""); { const char * method; if (items < 1) method = ""; else { method = (const char *)SvPV_nolen(ST(0)) ; } #line 1449 "XS.xs" { int i; int exhausted = 1; /* 'cv' is the hidden argument with which XS_List__MoreUtils__array_iterator (this XSUB) * is called. The closure_arg struct is stored in this CV. */ arrayeach_args *args = (arrayeach_args *)(CvXSUBANY(cv).any_ptr); if (strEQ(method, "index")) { EXTEND(SP, 1); ST(0) = args->curidx > 0 ? sv_2mortal(newSViv(args->curidx-1)) : &PL_sv_undef; XSRETURN(1); } EXTEND(SP, args->navs); for (i = 0; i < args->navs; i++) { AV *av = args->avsi; if (args->curidx <= av_len(av)) { ST(i) = sv_2mortal(newSVsv(*av_fetch(av, args->curidx, FALSE))); exhausted = 0; continue; } ST(i) = &PL_sv_undef; } if (exhausted) XSRETURN_EMPTY; args->curidx++; XSRETURN(args->navs); } #line 2002 "XS.c" } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_each_array); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_each_array) { dVAR; dXSARGS; PERL_UNUSED_VAR(cv); /* -W */ PERL_UNUSED_VAR(items); /* -W */ { SV * RETVAL; #line 1490 "XS.xs" { EACH_ARRAY_BODY; } #line 2020 "XS.c" RETVAL = sv_2mortal(RETVAL); ST(0) = RETVAL; } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_each_arrayref); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_each_arrayref) { dVAR; dXSARGS; PERL_UNUSED_VAR(cv); /* -W */ PERL_UNUSED_VAR(items); /* -W */ { SV * RETVAL; #line 1499 "XS.xs" { EACH_ARRAY_BODY; } #line 2040 "XS.c" RETVAL = sv_2mortal(RETVAL); ST(0) = RETVAL; } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_pairwise); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_pairwise) { dVAR; dXSARGS; if (items != 3) croak_xs_usage(cv, "code, list1, list2"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV * code = ST(0) ; AV * list1; AV * list2; STMT_START { SV* const xsub_tmp_sv = ST(1); SvGETMAGIC(xsub_tmp_sv); if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVAV){ list1 = (AV*)SvRV(xsub_tmp_sv); } else{ Perl_croak_nocontext("%s: %s is not an ARRAY reference", "List::MoreUtils::XS::pairwise", "list1"); } } STMT_END ; STMT_START { SV* const xsub_tmp_sv = ST(2); SvGETMAGIC(xsub_tmp_sv); if (SvROK(xsub_tmp_sv) && SvTYPE(SvRV(xsub_tmp_sv)) == SVt_PVAV){ list2 = (AV*)SvRV(xsub_tmp_sv); } else{ Perl_croak_nocontext("%s: %s is not an ARRAY reference", "List::MoreUtils::XS::pairwise", "list2"); } } STMT_END ; #line 1512 "XS.xs" { dMULTICALL; dMULTICALLSVCV; int i, maxitems; AV *rc = newAV(); sv_2mortal(newRV_noinc((SV*)rc)); if(!codelike(code)) croak_xs_usage(cv, "code, list, list"); if (in_pad(aTHX_ code)) { croak("Can't use lexical $a or $b in pairwise code block"); } /* deref AV's for convenience and * get maximum items */ maxitems = MAX(av_len(list1),av_len(list2))+1; av_extend(rc, maxitems); gimme = G_ARRAY; PUSH_MULTICALL(mc_cv); if (!PL_firstgv || !PL_secondgv) { SAVESPTR(PL_firstgv); SAVESPTR(PL_secondgv); PL_firstgv = gv_fetchpv("a", TRUE, SVt_PV); PL_secondgv = gv_fetchpv("b", TRUE, SVt_PV); } for (i = 0; i < maxitems; ++i) { SV **j; SV **svp = av_fetch(list1, i, FALSE); GvSV(PL_firstgv) = svp ? *svp : &PL_sv_undef; svp = av_fetch(list2, i, FALSE); GvSV(PL_secondgv) = svp ? *svp : &PL_sv_undef; MULTICALL; for (j = PL_stack_base+1; j <= PL_stack_sp; ++j) av_push(rc, newSVsv(*j)); } POP_MULTICALL; SPAGAIN; EXTEND(SP, AvFILLp(rc) + 1); for(i = AvFILLp(rc); i >= 0; --i) { ST(i) = sv_2mortal(AvARRAY(rc)i); AvARRAY(rc)i = NULL; } i = AvFILLp(rc) + 1; AvFILLp(rc) = -1; XSRETURN(i); } #line 2149 "XS.c" PUTBACK; return; } } XS_EUPXS(XS_List__MoreUtils__XS__natatime_iterator); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS__natatime_iterator) { dVAR; dXSARGS; if (items != 0) croak_xs_usage(cv, ""); { #line 1576 "XS.xs" { int i, nret; /* 'cv' is the hidden argument with which XS_List__MoreUtils__array_iterator (this XSUB) * is called. The closure_arg struct is stored in this CV. */ natatime_args *args = (natatime_args*)CvXSUBANY(cv).any_ptr; nret = args->natatime; EXTEND(SP, nret); for (i = 0; i < args->natatime; i++) if (args->curidx < args->nsvs) ST(i) = sv_2mortal(newSVsv(args->svsargs->curidx++)); else XSRETURN(i); XSRETURN(nret); } #line 2183 "XS.c" } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_natatime); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_natatime) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "n, ..."); { int n = (int)SvIV(ST(0)) ; SV * RETVAL; #line 1601 "XS.xs" { int i; natatime_args *args; HV *stash = gv_stashpv("List::MoreUtils::XS_na", TRUE); CV *closure = newXS(NULL, XS_List__MoreUtils__XS__natatime_iterator, __FILE__); /* must NOT set prototype on iterator: * otherwise one cannot write: &$it */ /* !! sv_setpv((SV*)closure, ""); !! */ New(0, args, 1, natatime_args); New(0, args->svs, items-1, SV*); args->nsvs = items-1; args->curidx = 0; args->natatime = n; for (i = 1; i < items; i++) SvREFCNT_inc(args->svsi-1 = ST(i)); CvXSUBANY(closure).any_ptr = args; RETVAL = newRV_noinc((SV*)closure); /* in order to allow proper cleanup in DESTROY-handler */ sv_bless(RETVAL, stash); } #line 2226 "XS.c" RETVAL = sv_2mortal(RETVAL); ST(0) = RETVAL; } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_arrayify); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_arrayify) { dVAR; dXSARGS; PERL_UNUSED_VAR(cv); /* -W */ PERL_UNUSED_VAR(items); /* -W */ { #line 1633 "XS.xs" { I32 i; AV *rc = newAV(); AV *args = av_make(items, &PL_stack_baseax); sv_2mortal(newRV_noinc((SV *)rc)); sv_2mortal(newRV_noinc((SV *)args)); LMUav2flat(aTHX_ rc, args); i = AvFILLp(rc); EXTEND(SP, i+1); for(; i >= 0; --i) { ST(i) = sv_2mortal(AvARRAY(rc)i); AvARRAY(rc)i = NULL; } i = AvFILLp(rc) + 1; AvFILLp(rc) = -1; XSRETURN(i); } #line 2264 "XS.c" } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_mesh); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_mesh) { dVAR; dXSARGS; PERL_UNUSED_VAR(cv); /* -W */ PERL_UNUSED_VAR(items); /* -W */ { #line 1660 "XS.xs" { int i, j, maxidx = -1; AV **avs; New(0, avs, items, AV*); for (i = 0; i < items; i++) { if(!arraylike(ST(i))) croak_xs_usage(cv, "\\@\\@;\\@..."); avsi = (AV*)SvRV(ST(i)); if (av_len(avsi) > maxidx) maxidx = av_len(avsi); } EXTEND(SP, items * (maxidx + 1)); for (i = 0; i <= maxidx; i++) for (j = 0; j < items; j++) { SV **svp = av_fetch(avsj, i, FALSE); ST(i*items + j) = svp ? sv_2mortal(newSVsv(*svp)) : &PL_sv_undef; } Safefree(avs); XSRETURN(items * (maxidx + 1)); } #line 2304 "XS.c" } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_zip6); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_zip6) { dVAR; dXSARGS; PERL_UNUSED_VAR(cv); /* -W */ PERL_UNUSED_VAR(items); /* -W */ { #line 1691 "XS.xs" { int i, j, maxidx = -1; AV **src; New(0, src, items, AV*); for (i = 0; i < items; i++) { if(!arraylike(ST(i))) croak_xs_usage(cv, "\\@\\@;\\@..."); srci = (AV*)SvRV(ST(i)); if (av_len(srci) > maxidx) maxidx = av_len(srci); } EXTEND(SP, maxidx + 1); for (i = 0; i <= maxidx; i++) { AV *av; ST(i) = sv_2mortal(newRV_noinc((SV *)(av = newAV()))); for (j = 0; j < items; j++) { SV **svp = av_fetch(srcj, i, FALSE); av_push(av, newSVsv( svp ? *svp : &PL_sv_undef )); } } Safefree(src); XSRETURN(maxidx + 1); } #line 2349 "XS.c" } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_listcmp); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_listcmp) { dVAR; dXSARGS; PERL_UNUSED_VAR(cv); /* -W */ PERL_UNUSED_VAR(items); /* -W */ { #line 1727 "XS.xs" { I32 i; SV *tmp = sv_newmortal(); HV *rc = newHV(); SV *ret = sv_2mortal (newRV_noinc((SV *)rc)); HV *distinct = newHV(); sv_2mortal(newRV_noinc((SV*)distinct)); for (i = 0; i < items; i++) { AV *av; I32 j; if(!arraylike(ST(i))) croak_xs_usage(cv, "\\@\\@;\\@..."); av = (AV*)SvRV(ST(i)); hv_clear(distinct); for(j = 0; j <= av_len(av); ++j) { SV **sv = av_fetch(av, j, FALSE); AV *store; if(NULL == sv) continue; SvGETMAGIC(*sv); if(SvOK(*sv)) { SvSetSV_nosteal(tmp, *sv); if(hv_exists_ent(distinct, tmp, 0)) continue; hv_store_ent(distinct, tmp, &PL_sv_yes, 0); if(hv_exists_ent(rc, *sv, 0)) { HE *he = hv_fetch_ent(rc, *sv, 1, 0); store = (AV*)SvRV(HeVAL(he)); av_push(store, newSViv(i)); } else { store = newAV(); av_push(store, newSViv(i)); hv_store_ent(rc, tmp, newRV_noinc((SV *)store), 0); } } } } i = HvUSEDKEYS(rc); EXTEND(SP, i * 2); i = 0; hv_iterinit(rc); for(;;) { HE *he = hv_iternext(rc); SV *key, *val; if(NULL == he) break; if(UNLIKELY(( NULL == (key = HeSVKEY_force(he)) ) || ( NULL == (val = HeVAL(he)) ))) continue; ST(i++) = key; ST(i++) = val; } XSRETURN(i); } #line 2436 "XS.c" } XSRETURN(1); } XS_EUPXS(XS_List__MoreUtils__XS_uniq); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_uniq) { dVAR; dXSARGS; PERL_UNUSED_VAR(cv); /* -W */ PERL_UNUSED_VAR(items); /* -W */ { #line 1805 "XS.xs" { I32 i; IV count = 0, seen_undef = 0; HV *hv = newHV(); SV **args = &PL_stack_baseax; SV *tmp = sv_newmortal(); sv_2mortal(newRV_noinc((SV*)hv)); /* don't build return list in scalar context */ if (GIMME_V == G_SCALAR) { for (i = 0; i < items; i++) { SvGETMAGIC(argsi); if(SvOK(argsi)) { sv_setsv_nomg(tmp, argsi); if (!hv_exists_ent(hv, tmp, 0)) { ++count; hv_store_ent(hv, tmp, &PL_sv_yes, 0); } } else if(0 == seen_undef++) ++count; } ST(0) = sv_2mortal(newSVuv(count)); XSRETURN(1); } /* list context: populate SP with mortal copies */ for (i = 0; i < items; i++) { SvGETMAGIC(argsi); if(SvOK(argsi)) { SvSetSV_nosteal(tmp, argsi); if (!hv_e
Log In?
Username:
Password:

What's my password?
Create A New User
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others contemplating the Monastery: (3)
As of 2020-08-07 22:05 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    Which rocket would you take to Mars?










    Results (50 votes). Check out past polls.

    Notices?