Beefy Boxes and Bandwidth Generously Provided by pair Networks
Clear questions and runnable code
get the best and fastest answer
 
PerlMonks  

syphilis's scratchpad

by syphilis (Archbishop)
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
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others having an uproarious good time at the Monastery: (7)
As of 2022-06-27 14:04 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My most frequent journeys are powered by:









    Results (88 votes). Check out past polls.

    Notices?