Beefy Boxes and Bandwidth Generously Provided by pair Networks
Problems? Is your data what you think it is?
 
PerlMonks  

comment on

( #3333=superdoc: print w/replies, xml ) Need Help??

List::MoreUtils::XS fails almost exactly the same way in 5.32.0 as 5.30.3. Just the hex code is different:

5.30.3: 0xc100000, needed 0xc180000 5.32.0: 0xe100000, needed 0xe180000

Here's the 5.32.0 XS.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 Lic +ense, * Version 2.0 (the "License"); you may not use this file except in co +mpliance * 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 imp +lied. * 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 itsel +f, * 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(s +v)) : (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(r +ight)); } 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(rig +ht)); } 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_iterat +or, __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->avs[i] = (AV*)SvRV(ST(i)); + \ SvREFCNT_inc(args->avs[i]); + \ } + \ + \ 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_base[ax]; \ PUSH_MULTICALL(mc_cv); \ SAVESPTR(GvSV(PL_defgv)); \ \ for(i = 1 ; i < items ; ++i) { \ GvSV(PL_defgv) = LMUFECPY(args[i]); \ 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_base[ax]; \ PUSH_MULTICALL(mc_cv); \ SAVESPTR(GvSV(PL_defgv)); \ \ for(i = items-1; i > 0; --i) { \ GvSV(PL_defgv) = LMUFECPY(args[i]); \ MULTICALL; \ on_item; \ } \ POP_MULTICALL; \ } #define REDUCE_WITH(init) \ dMULTICALL; \ dMULTICALLSVCV; \ SV *rc, **args = &PL_stack_base[ax]; \ 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(args[i]); \ 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(args[i]); \ if(SvOK(args[i])) { \ HE *he; \ SvSetSV_nosteal(tmp, args[i]); \ he = hv_fetch_ent(hv, tmp, 0, 0); \ if (NULL == he) { \ args[count++] = args[i]; \ 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++) { \ args[count++] = args[i]; \ } \ } #define COUNT_ARGS_MAX \ do { \ for (i = 0; i < items; i++) { \ SvGETMAGIC(args[i]); \ if(SvOK(args[i])) { \ HE *he; \ SvSetSV_nosteal(tmp, args[i]); \ he = hv_fetch_ent(hv, tmp, 0, 0); \ if (NULL == he) { \ args[count++] = args[i]; \ 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++) { \ args[count++] = args[i]; \ } \ } \ 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 reser +ved. * * 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 copyrigh +t * notice, this list of conditions and the following disclaimer in +the * documentation and/or other materials provided with the distribut +ion. * 3. Neither the name of the University nor the names of its contribu +tors * may be used to endorse or promote products derived from this sof +tware * 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, T +HE * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR +PURPOSE * ARE DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE L +IABLE * FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQ +UENTIAL * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE G +OODS * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTIO +N) * HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, + STRICT * LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN A +NY 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 Sor +t 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/c +pp/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/c +pp/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__un +used__) # define XS_INTERNAL(name) STATIC void name(pTHX_ CV* cv __attrib +ute__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, para +ms); 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), p +arams); } } #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 per +ls, * so we define a portable version of newXSproto() */ #ifdef newXS_flags #define newXSproto_portable(name, c_impl, file, proto) newXS_flags(nam +e, c_impl, file, proto, 0) #else #define newXSproto_portable(name, c_impl, file, proto) (PL_Sv=(SV*)new +XS(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 -Wmi +ssing-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->avs[i]); 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 -Wmi +ssing-prototypes */ XS_EUPXS(XS_List__MoreUtils__XS_na_DESTROY) { dVAR; dXSARGS; if (items != 1) croak_xs_usage(cv, "sv"); { SV * sv = ST(0) ;

In reply to Re^6: XS.c: loadable library and perl binaries are mismatched (got handshake key 0xc100000, needed 0xc180000) by rgren925
in thread XS.c: loadable library and perl binaries are mismatched (got handshake key 0xc100000, needed 0xc180000) by rgren925

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Are you posting in the right place? Check out Where do I post X? to know for sure.
  • Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
    <code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
  • Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
  • Want more info? How to link or or How to display code and escape characters are good places to start.
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 examining the Monastery: (6)
As of 2021-10-25 11:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My first memorable Perl project was:







    Results (89 votes). Check out past polls.

    Notices?