/* * This file was generated automatically by ExtUtils::ParseXS version 2.10 from the * contents of Util.xs. Do not edit this file, edit Util.xs instead. * * ANY CHANGES MADE HERE WILL BE LOST! * */ #line 1 "Util.xs" /* Copyright (c) 1997-2000 Graham Barr . All rights reserved. * This program is free software; you can redistribute it and/or * modify it under the same terms as Perl itself. */ #include #include #include #ifndef PERL_VERSION # include # if !(defined(PERL_VERSION) || (SUBVERSION > 0 && defined(PATCHLEVEL))) # include # endif # define PERL_REVISION 5 # define PERL_VERSION PATCHLEVEL # define PERL_SUBVERSION SUBVERSION #endif #ifndef aTHX # define aTHX # define pTHX #endif /* Some platforms have strict exports. And before 5.7.3 cxinc (or Perl_cxinc) was not exported. Therefore platforms like win32, VMS etc have problems so we redefine it here -- GMB */ #if PERL_VERSION < 7 /* Not in 5.6.1. */ # define SvUOK(sv) SvIOK_UV(sv) # ifdef cxinc # undef cxinc # endif # define cxinc() my_cxinc(aTHX) static I32 my_cxinc(pTHX) { cxstack_max = cxstack_max * 3 / 2; Renew(cxstack, cxstack_max + 1, struct context); /* XXX should fix CXINC macro */ return cxstack_ix + 1; } #endif #if PERL_VERSION < 6 # define NV double #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 #ifndef Drand01 # define Drand01() ((rand() & 0x7FFF) / (double) ((unsigned long)1 << 15)) #endif #if PERL_VERSION < 5 # ifndef gv_stashpvn # define gv_stashpvn(n,l,c) gv_stashpv(n,c) # endif # ifndef SvTAINTED static bool sv_tainted(SV *sv) { if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv)) { MAGIC *mg = mg_find(sv, 't'); if (mg && ((mg->mg_len & 1) || (mg->mg_len & 2) && mg->mg_obj == sv)) return TRUE; } return FALSE; } # define SvTAINTED_on(sv) sv_magic((sv), Nullsv, 't', Nullch, 0) # define SvTAINTED(sv) (SvMAGICAL(sv) && sv_tainted(sv)) # endif # define PL_defgv defgv # define PL_op op # define PL_curpad curpad # define CALLRUNOPS runops # define PL_curpm curpm # define PL_sv_undef sv_undef # define PERL_CONTEXT struct context #endif #if (PERL_VERSION < 5) || (PERL_VERSION == 5 && PERL_SUBVERSION <50) # ifndef PL_tainting # define PL_tainting tainting # endif # ifndef PL_stack_base # define PL_stack_base stack_base # endif # ifndef PL_stack_sp # define PL_stack_sp stack_sp # endif # ifndef PL_ppaddr # define PL_ppaddr ppaddr # endif #endif #ifndef PTR2UV # define PTR2UV(ptr) (UV)(ptr) #endif #ifndef SvUV_set # define SvUV_set(sv, val) (((XPVUV*)SvANY(sv))->xuv_uv = (val)) #endif #ifndef PERL_UNUSED_DECL # ifdef HASATTRIBUTE # if (defined(__GNUC__) && defined(__cplusplus)) || defined(__INTEL_COMPILER) # define PERL_UNUSED_DECL # else # define PERL_UNUSED_DECL __attribute__((unused)) # endif # else # define PERL_UNUSED_DECL # endif #endif #ifndef dNOOP #define dNOOP extern int Perl___notused PERL_UNUSED_DECL #endif #ifndef dVAR #define dVAR dNOOP #endif #ifndef PERL_UNUSED_VAR # define PERL_UNUSED_VAR(var) if (0) var = var #endif #line 144 "Util.c" XS(XS_List__Util_min); /* prototype to pass -Wmissing-prototypes */ XS(XS_List__Util_min) 10 { 10 dXSARGS; 10 dXSI32; 10 PERL_UNUSED_VAR(cv); /* -W */ { #line 139 "Util.xs" { int index; NV retval; SV *retsv; if(!items) { XSRETURN_UNDEF; } retsv = ST(0); retval = slu_sv_value(retsv); for(index = 1 ; index < items ; index++) { SV *stacksv = ST(index); NV val = slu_sv_value(stacksv); if(val < retval ? !ix : ix) { retsv = stacksv; retval = val; } } ST(0) = retsv; XSRETURN(1); } #line 174 "Util.c" } 10 XSRETURN(1); } XS(XS_List__Util_sum); /* prototype to pass -Wmissing-prototypes */ XS(XS_List__Util_sum) 6 { 6 dXSARGS; 6 PERL_UNUSED_VAR(cv); /* -W */ { 6 NV RETVAL; 6 dXSTARG; #line 166 "Util.xs" { SV *sv; int index; if(!items) { XSRETURN_UNDEF; } sv = ST(0); RETVAL = slu_sv_value(sv); for(index = 1 ; index < items ; index++) { sv = ST(index); RETVAL += slu_sv_value(sv); } } #line 202 "Util.c" 5 XSprePUSH; PUSHn((NV)RETVAL); } 5 XSRETURN(1); } XS(XS_List__Util_minstr); /* prototype to pass -Wmissing-prototypes */ XS(XS_List__Util_minstr) 8 { 8 dXSARGS; 8 dXSI32; 8 PERL_UNUSED_VAR(cv); /* -W */ { #line 190 "Util.xs" { SV *left; int index; if(!items) { XSRETURN_UNDEF; } /* sv_cmp & sv_cmp_locale return 1,0,-1 for gt,eq,lt so we set ix to the value we are looking for xsubpp does not allow -ve values, so we start with 0,2 and subtract 1 */ ix -= 1; left = ST(0); #ifdef OPpLOCALE if(MAXARG & OPpLOCALE) { for(index = 1 ; index < items ; index++) { SV *right = ST(index); if(sv_cmp_locale(left, right) == ix) left = right; } } else { #endif for(index = 1 ; index < items ; index++) { SV *right = ST(index); if(sv_cmp(left, right) == ix) left = right; } #ifdef OPpLOCALE } #endif ST(0) = left; XSRETURN(1); } #line 251 "Util.c" } 8 XSRETURN(1); } XS(XS_List__Util_reduce); /* prototype to pass -Wmissing-prototypes */ XS(XS_List__Util_reduce) 13 { 13 dXSARGS; 13 if (items < 1) ###### Perl_croak(aTHX_ "Usage: List::Util::reduce(block, ...)"); 13 PERL_UNUSED_VAR(cv); /* -W */ { 13 SV * block = ST(0); #line 232 "Util.xs" { dVAR; SV *ret = sv_newmortal(); int index; GV *agv,*bgv,*gv; HV *stash; CV *cv; OP *reducecop; PERL_CONTEXT *cx; SV** newsp; I32 gimme = G_SCALAR; U8 hasargs = 0; bool oldcatch = CATCH_GET; if(items <= 1) { XSRETURN_UNDEF; } agv = gv_fetchpv("a", TRUE, SVt_PV); bgv = gv_fetchpv("b", TRUE, SVt_PV); SAVESPTR(GvSV(agv)); SAVESPTR(GvSV(bgv)); GvSV(agv) = ret; cv = sv_2cv(block, &stash, &gv, 0); reducecop = CvSTART(cv); SAVESPTR(CvROOT(cv)->op_ppaddr); CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL]; #ifdef PAD_SET_CUR PAD_SET_CUR(CvPADLIST(cv),1); #else SAVESPTR(PL_curpad); PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]); #endif SAVETMPS; SAVESPTR(PL_op); SvSetSV(ret, ST(1)); CATCH_SET(TRUE); PUSHBLOCK(cx, CXt_SUB, SP); PUSHSUB(cx); for(index = 2 ; index < items ; index++) { GvSV(bgv) = ST(index); PL_op = reducecop; CALLRUNOPS(aTHX); SvSetSV(ret, *PL_stack_sp); } ST(0) = ret; POPBLOCK(cx,PL_curpm); CATCH_SET(oldcatch); XSRETURN(1); } #line 316 "Util.c" } 12 XSRETURN(1); } XS(XS_List__Util_first); /* prototype to pass -Wmissing-prototypes */ XS(XS_List__Util_first) 8 { 8 dXSARGS; 8 if (items < 1) ###### Perl_croak(aTHX_ "Usage: List::Util::first(block, ...)"); 8 PERL_UNUSED_VAR(cv); /* -W */ { 8 SV * block = ST(0); #line 287 "Util.xs" { dVAR; int index; GV *gv; HV *stash; CV *cv; OP *reducecop; PERL_CONTEXT *cx; SV** newsp; I32 gimme = G_SCALAR; U8 hasargs = 0; bool oldcatch = CATCH_GET; if(items <= 1) { XSRETURN_UNDEF; } SAVESPTR(GvSV(PL_defgv)); cv = sv_2cv(block, &stash, &gv, 0); reducecop = CvSTART(cv); SAVESPTR(CvROOT(cv)->op_ppaddr); CvROOT(cv)->op_ppaddr = PL_ppaddr[OP_NULL]; #ifdef PAD_SET_CUR PAD_SET_CUR(CvPADLIST(cv),1); #else SAVESPTR(PL_curpad); PL_curpad = AvARRAY((AV*)AvARRAY(CvPADLIST(cv))[1]); #endif SAVETMPS; SAVESPTR(PL_op); CATCH_SET(TRUE); PUSHBLOCK(cx, CXt_SUB, SP); PUSHSUB(cx); for(index = 1 ; index < items ; index++) { GvSV(PL_defgv) = ST(index); PL_op = reducecop; CALLRUNOPS(aTHX); if (SvTRUE(*PL_stack_sp)) { ST(0) = ST(index); POPBLOCK(cx,PL_curpm); CATCH_SET(oldcatch); XSRETURN(1); } } POPBLOCK(cx,PL_curpm); CATCH_SET(oldcatch); XSRETURN_UNDEF; } #line 380 "Util.c" } 7 XSRETURN(1); } XS(XS_List__Util_shuffle); /* prototype to pass -Wmissing-prototypes */ XS(XS_List__Util_shuffle) 3 { 3 dXSARGS; 3 PERL_UNUSED_VAR(cv); /* -W */ { #line 340 "Util.xs" { dVAR; int index; struct op dmy_op; struct op *old_op = PL_op; /* We call pp_rand here so that Drand01 get initialized if rand() or srand() has not already been called */ memzero((char*)(&dmy_op), sizeof(struct op)); /* we let pp_rand() borrow the TARG allocated for this XS sub */ dmy_op.op_targ = PL_op->op_targ; PL_op = &dmy_op; (void)*(PL_ppaddr[OP_RAND])(aTHX); PL_op = old_op; for (index = items ; index > 1 ; ) { int swap = (int)(Drand01() * (double)(index--)); SV *tmp = ST(swap); ST(swap) = ST(index); ST(index) = tmp; } XSRETURN(items); } #line 416 "Util.c" } XSRETURN(1); } XS(XS_Scalar__Util_dualvar); /* prototype to pass -Wmissing-prototypes */ XS(XS_Scalar__Util_dualvar) 11 { 11 dXSARGS; 11 if (items != 2) ###### Perl_croak(aTHX_ "Usage: Scalar::Util::dualvar(num, str)"); 11 PERL_UNUSED_VAR(cv); /* -W */ { 11 SV * num = ST(0); 11 SV * str = ST(1); #line 373 "Util.xs" { STRLEN len; char *ptr = SvPV(str,len); ST(0) = sv_newmortal(); (void)SvUPGRADE(ST(0),SVt_PVNV); sv_setpvn(ST(0),ptr,len); if(SvNOK(num) || SvPOK(num) || SvMAGICAL(num)) { SvNV_set(ST(0), SvNV(num)); SvNOK_on(ST(0)); } #ifdef SVf_IVisUV else if (SvUOK(num)) { SvUV_set(ST(0), SvUV(num)); SvIOK_on(ST(0)); SvIsUV_on(ST(0)); } #endif else { SvIV_set(ST(0), SvIV(num)); SvIOK_on(ST(0)); } if(PL_tainting && (SvTAINTED(num) || SvTAINTED(str))) SvTAINTED_on(ST(0)); XSRETURN(1); } #line 458 "Util.c" } XSRETURN(1); } XS(XS_Scalar__Util_blessed); /* prototype to pass -Wmissing-prototypes */ XS(XS_Scalar__Util_blessed) 766 { 766 dXSARGS; 766 if (items != 1) ###### Perl_croak(aTHX_ "Usage: Scalar::Util::blessed(sv)"); 766 PERL_UNUSED_VAR(cv); /* -W */ { 766 SV * sv = ST(0); 766 char * RETVAL; 766 dXSTARG; #line 404 "Util.xs" { if (SvMAGICAL(sv)) mg_get(sv); if(!sv_isobject(sv)) { XSRETURN_UNDEF; } RETVAL = sv_reftype(SvRV(sv),TRUE); } #line 484 "Util.c" 136 sv_setpv(TARG, RETVAL); XSprePUSH; PUSHTARG; } 136 XSRETURN(1); } XS(XS_Scalar__Util_reftype); /* prototype to pass -Wmissing-prototypes */ XS(XS_Scalar__Util_reftype) 342 { 342 dXSARGS; 342 if (items != 1) ###### Perl_croak(aTHX_ "Usage: Scalar::Util::reftype(sv)"); 342 PERL_UNUSED_VAR(cv); /* -W */ { 342 SV * sv = ST(0); 342 char * RETVAL; 342 dXSTARG; #line 420 "Util.xs" { if (SvMAGICAL(sv)) mg_get(sv); if(!SvROK(sv)) { XSRETURN_UNDEF; } RETVAL = sv_reftype(SvRV(sv),FALSE); } #line 511 "Util.c" 338 sv_setpv(TARG, RETVAL); XSprePUSH; PUSHTARG; } 338 XSRETURN(1); } XS(XS_Scalar__Util_refaddr); /* prototype to pass -Wmissing-prototypes */ XS(XS_Scalar__Util_refaddr) 1631 { 1631 dXSARGS; 1631 if (items != 1) ###### Perl_croak(aTHX_ "Usage: Scalar::Util::refaddr(sv)"); 1631 PERL_UNUSED_VAR(cv); /* -W */ { 1631 SV * sv = ST(0); 1631 UV RETVAL; 1631 dXSTARG; #line 436 "Util.xs" { if (SvMAGICAL(sv)) mg_get(sv); if(!SvROK(sv)) { XSRETURN_UNDEF; } RETVAL = PTR2UV(SvRV(sv)); } #line 538 "Util.c" 1628 XSprePUSH; PUSHu((UV)RETVAL); } 1628 XSRETURN(1); } XS(XS_Scalar__Util_weaken); /* prototype to pass -Wmissing-prototypes */ XS(XS_Scalar__Util_weaken) 12 { 12 dXSARGS; 12 if (items != 1) ###### Perl_croak(aTHX_ "Usage: Scalar::Util::weaken(sv)"); 12 PERL_UNUSED_VAR(cv); /* -W */ { 12 SV * sv = ST(0); #line 452 "Util.xs" #ifdef SvWEAKREF sv_rvweaken(sv); #else croak("weak references are not implemented in this release of perl"); #endif #line 560 "Util.c" } 12 XSRETURN_EMPTY; } XS(XS_Scalar__Util_isweak); /* prototype to pass -Wmissing-prototypes */ XS(XS_Scalar__Util_isweak) 42 { 42 dXSARGS; 42 if (items != 1) ###### Perl_croak(aTHX_ "Usage: Scalar::Util::isweak(sv)"); 42 PERL_UNUSED_VAR(cv); /* -W */ { 42 SV * sv = ST(0); #line 463 "Util.xs" #ifdef SvWEAKREF ST(0) = boolSV(SvROK(sv) && SvWEAKREF(sv)); XSRETURN(1); #else croak("weak references are not implemented in this release of perl"); #endif #line 582 "Util.c" } XSRETURN(1); } XS(XS_Scalar__Util_readonly); /* prototype to pass -Wmissing-prototypes */ XS(XS_Scalar__Util_readonly) 7 { 7 dXSARGS; 7 if (items != 1) ###### Perl_croak(aTHX_ "Usage: Scalar::Util::readonly(sv)"); 7 PERL_UNUSED_VAR(cv); /* -W */ { 7 SV * sv = ST(0); 7 int RETVAL; 7 dXSTARG; #line 475 "Util.xs" RETVAL = SvREADONLY(sv); #line 601 "Util.c" 7 XSprePUSH; PUSHi((IV)RETVAL); } 7 XSRETURN(1); } XS(XS_Scalar__Util_tainted); /* prototype to pass -Wmissing-prototypes */ XS(XS_Scalar__Util_tainted) 97 { 97 dXSARGS; 97 if (items != 1) ###### Perl_croak(aTHX_ "Usage: Scalar::Util::tainted(sv)"); 97 PERL_UNUSED_VAR(cv); /* -W */ { 97 SV * sv = ST(0); 97 int RETVAL; 97 dXSTARG; #line 484 "Util.xs" RETVAL = SvTAINTED(sv); #line 621 "Util.c" 97 XSprePUSH; PUSHi((IV)RETVAL); } 97 XSRETURN(1); } XS(XS_Scalar__Util_isvstring); /* prototype to pass -Wmissing-prototypes */ XS(XS_Scalar__Util_isvstring) 2 { 2 dXSARGS; 2 if (items != 1) ###### Perl_croak(aTHX_ "Usage: Scalar::Util::isvstring(sv)"); 2 PERL_UNUSED_VAR(cv); /* -W */ { 2 SV * sv = ST(0); #line 493 "Util.xs" #ifdef SvVOK ST(0) = boolSV(SvVOK(sv)); XSRETURN(1); #else croak("vstrings are not implemented in this release of perl"); #endif #line 644 "Util.c" } XSRETURN(1); } XS(XS_Scalar__Util_looks_like_number); /* prototype to pass -Wmissing-prototypes */ XS(XS_Scalar__Util_looks_like_number) 12 { 12 dXSARGS; 12 if (items != 1) ###### Perl_croak(aTHX_ "Usage: Scalar::Util::looks_like_number(sv)"); 12 PERL_UNUSED_VAR(cv); /* -W */ { 12 SV * sv = ST(0); 12 int RETVAL; 12 dXSTARG; #line 505 "Util.xs" RETVAL = looks_like_number(sv); #line 663 "Util.c" 12 XSprePUSH; PUSHi((IV)RETVAL); } 12 XSRETURN(1); } XS(XS_Scalar__Util_set_prototype); /* prototype to pass -Wmissing-prototypes */ XS(XS_Scalar__Util_set_prototype) 8 { 8 dXSARGS; 8 if (items != 2) ###### Perl_croak(aTHX_ "Usage: Scalar::Util::set_prototype(subref, proto)"); 8 PERL_UNUSED_VAR(cv); /* -W */ { 8 SV * subref = ST(0); 8 SV * proto = ST(1); #line 515 "Util.xs" { if (SvROK(subref)) { SV *sv = SvRV(subref); if (SvTYPE(sv) != SVt_PVCV) { /* not a subroutine reference */ croak("set_prototype: not a subroutine reference"); } if (SvPOK(proto)) { /* set the prototype */ STRLEN len; char *ptr = SvPV(proto, len); sv_setpvn(sv, ptr, len); } else { /* delete the prototype */ SvPOK_off(sv); } } else { croak("set_prototype: not a reference"); } XSRETURN(1); } #line 704 "Util.c" } XSRETURN_EMPTY; } #ifdef __cplusplus extern "C" #endif XS(boot_List__Util); /* prototype to pass -Wmissing-prototypes */ XS(boot_List__Util) 122 { 122 dXSARGS; 122 char* file = __FILE__; 122 PERL_UNUSED_VAR(cv); /* -W */ 122 PERL_UNUSED_VAR(items); /* -W */ 122 XS_VERSION_BOOTCHECK ; { 122 CV * cv ; 122 cv = newXS("List::Util::max", XS_List__Util_min, file); 122 XSANY.any_i32 = 1 ; 122 sv_setpv((SV*)cv, "@") ; 122 cv = newXS("List::Util::min", XS_List__Util_min, file); 122 XSANY.any_i32 = 0 ; 122 sv_setpv((SV*)cv, "@") ; 122 newXSproto("List::Util::sum", XS_List__Util_sum, file, "@"); 122 cv = newXS("List::Util::minstr", XS_List__Util_minstr, file); 122 XSANY.any_i32 = 2 ; 122 sv_setpv((SV*)cv, "@") ; 122 cv = newXS("List::Util::maxstr", XS_List__Util_minstr, file); 122 XSANY.any_i32 = 0 ; 122 sv_setpv((SV*)cv, "@") ; 122 newXSproto("List::Util::reduce", XS_List__Util_reduce, file, "&@"); 122 newXSproto("List::Util::first", XS_List__Util_first, file, "&@"); 122 newXSproto("List::Util::shuffle", XS_List__Util_shuffle, file, "@"); 122 newXSproto("Scalar::Util::dualvar", XS_Scalar__Util_dualvar, file, "$$"); 122 newXSproto("Scalar::Util::blessed", XS_Scalar__Util_blessed, file, "$"); 122 newXSproto("Scalar::Util::reftype", XS_Scalar__Util_reftype, file, "$"); 122 newXSproto("Scalar::Util::refaddr", XS_Scalar__Util_refaddr, file, "$"); 122 newXSproto("Scalar::Util::weaken", XS_Scalar__Util_weaken, file, "$"); 122 newXSproto("Scalar::Util::isweak", XS_Scalar__Util_isweak, file, "$"); 122 newXSproto("Scalar::Util::readonly", XS_Scalar__Util_readonly, file, "$"); 122 newXSproto("Scalar::Util::tainted", XS_Scalar__Util_tainted, file, "$"); 122 newXSproto("Scalar::Util::isvstring", XS_Scalar__Util_isvstring, file, "$"); 122 newXSproto("Scalar::Util::looks_like_number", XS_Scalar__Util_looks_like_number, file, "$"); 122 newXSproto("Scalar::Util::set_prototype", XS_Scalar__Util_set_prototype, file, "&$"); } /* Initialisation Section */ #line 540 "Util.xs" { #if !defined(SvWEAKREF) || !defined(SvVOK) HV *stash = gv_stashpvn("Scalar::Util", 12, TRUE); GV *vargv = *(GV**)hv_fetch(stash, "EXPORT_FAIL", 11, TRUE); AV *varav; if (SvTYPE(vargv) != SVt_PVGV) gv_init(vargv, stash, "Scalar::Util", 12, TRUE); varav = GvAVn(vargv); #endif #ifndef SvWEAKREF av_push(varav, newSVpv("weaken",6)); av_push(varav, newSVpv("isweak",6)); #endif #ifndef SvVOK av_push(varav, newSVpv("isvstring",9)); #endif } #line 775 "Util.c" /* End of Initialisation Section */ 122 XSRETURN_YES; }