%PDF- %PDF-
Direktori : /home/opti/optisoftcom/.cpanm/work/1544535406.20768/Class-XSAccessor-1.19/ |
Current File : /home/opti/optisoftcom/.cpanm/work/1544535406.20768/Class-XSAccessor-1.19/XSAccessor.c |
/* * This file was generated automatically by ExtUtils::ParseXS version 3.18 from the * contents of XSAccessor.xs. Do not edit this file, edit XSAccessor.xs instead. * * ANY CHANGES MADE HERE WILL BE LOST! * */ #line 1 "XSAccessor.xs" #ifdef WIN32 /* Win32 doesn't get PERL_CORE, so use the next best thing */ #define PERL_NO_GET_CONTEXT #endif /* For versions of ExtUtils::ParseXS > 3.04_02, we need to * explicitly enforce exporting of XSUBs since we want to * refer to them using XS(). This isn't strictly necessary, * but it's by far the simplest way to be backwards-compatible. */ #define PERL_EUPXS_ALWAYS_EXPORT #include "EXTERN.h" #include "perl.h" /* want this eeaarly, before perl spits in the soup with XSUB.h */ #include "cxsa_memory.h" /* * Quoting chocolateboy from his Method::Lexical module at 2009-02-08: * * for binary compatibility (see perlapi.h), XS modules perform a function call to * access each and every interpreter variable. So, for instance, an innocuous-looking * reference to PL_op becomes: * * (*Perl_Iop_ptr(my_perl)) * * This (obviously) impacts performance. Internally, PL_op is accessed as: * * my_perl->Iop * * (in threaded/multiplicity builds (see intrpvar.h)), which is significantly faster. * * defining PERL_CORE gets us the fast version, at the expense of a future maintenance release * possibly breaking things: https://groups.google.com/group/perl.perl5.porters/browse_thread/thread/9ec0da3f02b3b5a * * Rather than globally defining PERL_CORE, which pokes its fingers into various headers, exposing * internals we'd rather not see, just define it for XSUB.h, which includes * perlapi.h, which imposes the speed limit. */ #ifdef WIN32 /* thanks to Andy Grundman for pointing out problems with this on ActivePerl >= 5.10 */ #include "XSUB.h" #else /* not WIN32 */ #define PERL_CORE #include "XSUB.h" #undef PERL_CORE #endif #include "ppport.h" #include "cxsa_main.h" #include "cxsa_locking.h" #define CXAA(name) XS_Class__XSAccessor__Array_ ## name #define CXAH(name) XS_Class__XSAccessor_ ## name #define CXA_CHECK_HASH(self) \ if (!(SvROK(self) && SvTYPE(SvRV(self)) == SVt_PVHV)) { \ croak("Class::XSAccessor: invalid instance method invocant: no hash ref supplied"); \ } #define CXA_CHECK_ARRAY(self) \ if (!(SvROK(self) && SvTYPE(SvRV(self)) == SVt_PVAV)) { \ croak("Class::XSAccessor: invalid instance method invocant: no array ref supplied"); \ } /* * chocolateboy: 2009-09-06 - 2009-11-14: * * entersub OPs that call our accessors are optimized (i.e. replaced with optimized versions) * in versions of perl >= 5.10.0. This section describes the implementation. * * TL;DR: the first time one of our fast (XS) accessors is called, we reach up into the * calling OP (OP_ENTERSUB) and change its implementation (PL_op->op_ppaddr) to an optimized * version that takes advantage of the fact that our accessors are straightforward hash/array lookups. * In order for this to work safely, we need to be able to disable/prevent this optimization * in some circumstances. This is done by setting a "don't optimize me" flag on the entersub OP. * Prior to 5.10.0, there were no spare bits available on entersub OPs we could use for this, but * perls >= 5.10.0 have a new OP member called op_spare that gives us 3 whole bits to play with! * * First, some preliminaries: a method call is performed as a subroutine call at the OP * level. There's some additional work to look up the method CV and push the invocant * on the stack, but the current OP inside a method call is the subroutine call OP, OP_ENTERSUB. * * Two distinct invocations of the same method will have two entersub OPs and will receive * the same CV on the stack: * * $foo->bar(...); # OP 1: CV 1 * $foo->bar(...); # OP 2: CV 1 * * There are also situations in which the same entersub OP calls more than one CV: * * $foo->$_() for ('foo', 'bar'); # OP 1: CV 1, CV 2 * * Inside each Class::XSAccessor XSUB, we can access the current entersub OP (PL_op). * The default entersub implementation (pp_entersub in pp_hot.c) has a lot of boilerplate for * dealing with all the different ways in which subroutines can be called. It sets up * and tears down a new scope; it deals with the fact that the code ref can be passed * in as a GV or CV; and it has numerous conditional statements to deal with the various * different types of CV. * * For our XSUB accessors, we don't need most of that. We don't need to open a new scope; * the subroutine is almost always a CV (that's what OP_METHOD and OP_METHOD_NAMED usually return); * and we don't need to deal with all the non-XSUB cases. This allows us to replace the * OP's implementation (op_ppaddr) with a version optimized for our simple XSUBs. (This * is inspired by B::XSUB::Dumber: nothingmuch++) * * We do this inside the accessor i.e. at runtime. We can also back out the optimization * if a call site proves to be dynamic e.g. if a method is redefined or the method is * called with multiple different CVs (see below). * * In practice, this is rarely the case. the vast majority of method calls in perl, * and in most dynamic languages (cf. Google's v8), behave like method calls in static * languages. for instance, 97% of the call sites exercised by perl 5.10.0's test suite are * monomorphic. * * We only replace the op_ppaddr pointer of entersub OPs that use the default pp_entersub. * this ensures we don't interfere with any modules that assign a new op_ppaddr e.g. * Data::Alias, Faster. it also ensures we don't tread on our own toes and repeatedly * re-assign the same optimized entersub. * * There's one optimized entersub for each type of Class::XSAccessor accessor. To save typing, * they're generated by C preprocessor macros i.e. poor man's generic programming. * * If, for some reason, the entersub should not be optimized, a flag is set on the * entersub OP. This flag is detected inside the accessor. If the flag is set, * the accessor will never try to optimize the entersub OP. * * There are a number of situations in which optimization is disabled. * * 1) if the entersub is not perl's default entersub i.e. if another module has * provided its own entersub implementation, then we don't replace it. * * 2) if the call site is dynamic. the optimized entersub is optimized for a particular * type of Class::XSAccessor accessor (e.g. getter, setter, predicate &c.). if * an optimized entersub finds itself invoking a function other than the * specific XSUB it's tailored for, then the entersub optimization is disabled. * This also applies if a method is redefined so that an optimized * entersub is passed a different type of CV than the one it's optimized for. * * 1) is detected inside the accessor. 2) is detected inside the optimized entersub. * In the second case, we reinstate the previous entersub, which by 1) was perl's pp_entersub. * * Note: Class::XSAccessor XSUBs continue to optimize "new" call sites, regardless of what may * have happened to a "previous" OP or what may happen to a "subsequent" OP. Take the following * example: * * 1: package Example; * 2: * 3: use Class::XSAccessor { getters => 'foo' }; * 4: * 5: for (1 .. 10) { * 6: $self->foo(); * 7: $self->$_ for ('foo', 'bar'); * 8: $self->foo(); * 9: } * * Here, line 6 is optimized as normal. Line 7 is optimized on the first call, when $_ is "foo", * but the optimization is disabled on the second call, when $_ is "bar", because &Example::bar * is not a Class::XSAccessor getter. All subsequent calls on line 7, use perl's default entersub. * Line 8 is optimized as normal. i.e. the disabled optimization on line 7 doesn't affect subsequent * optimizations. On line 7, only the entersub OP is "pessimized". &Example::foo continues to "look for" * "new" entersub OPs to optimize. Indeed, any calls to &Example::foo will get the optimization treatment, * even call sites outside the Example package/file. * * The following CXAA_OPTIMIZE_ENTERSUB* (Array) and CXAH_OPTIMIZE_ENTERSUB* (Hash) macros are * called from within our accessors to install the optimized entersub (if possible). * The CXAA_GENERATE_ENTERSUB* and CXAH_GENERATE_ENTERSUB* macros further down * generate optimized entersubs for the accessors defined in XS/Array.xs and XS/Hash.xs. */ #if (PERL_BCDVERSION >= 0x5010000) #define CXA_ENABLE_ENTERSUB_OPTIMIZATION #endif #ifdef CXA_ENABLE_ENTERSUB_OPTIMIZATION #define CXA_OPTIMIZATION_OK(op) ((op->op_spare & 1) != 1) #define CXA_DISABLE_OPTIMIZATION(op) (op->op_spare |= 1) /* see t/08hash_entersub.t */ #define CXAH_OPTIMIZE_ENTERSUB_TEST(name) \ STMT_START { \ /* print op_spare so that we get failing tests if perl starts using it */ \ warn("cxah: accessor: op_spare: %u", PL_op->op_spare); \ \ if (PL_op->op_ppaddr == CXA_DEFAULT_ENTERSUB) { \ if (CXA_OPTIMIZATION_OK(PL_op)) { \ warn("cxah: accessor: optimizing entersub"); \ PL_op->op_ppaddr = cxah_entersub_ ## name; \ } else { \ warn("cxah: accessor: entersub optimization has been disabled"); \ } \ } else if (PL_op->op_ppaddr == cxah_entersub_ ## name) { \ warn("cxah: accessor: entersub has been optimized"); \ } \ } STMT_END #define CXAH_OPTIMIZE_ENTERSUB(name) \ STMT_START { \ if ((PL_op->op_ppaddr == CXA_DEFAULT_ENTERSUB) && CXA_OPTIMIZATION_OK(PL_op)) { \ PL_op->op_ppaddr = cxah_entersub_ ## name; \ } \ } STMT_END #define CXAA_OPTIMIZE_ENTERSUB(name) \ STMT_START { \ if ((PL_op->op_ppaddr == CXA_DEFAULT_ENTERSUB) && CXA_OPTIMIZATION_OK(PL_op)) { \ PL_op->op_ppaddr = cxaa_entersub_ ## name; \ } \ } STMT_END #else /* if CXA_ENABLE_ENTERSUB_OPTIMIZATION is not defined... */ #define CXAA_GENERATE_ENTERSUB(name) #define CXAA_OPTIMIZE_ENTERSUB(name) #define CXAH_GENERATE_ENTERSUB(name) #define CXAH_OPTIMIZE_ENTERSUB(name) #define CXAH_GENERATE_ENTERSUB_TEST(name) #define CXAH_OPTIMIZE_ENTERSUB_TEST(name) #endif /* end #ifdef CXA_ENABLE_ENTERSUB_OPTIMIZATION */ /* * VMS mangles XSUB names so that they're less than 32 characters, and * ExtUtils::ParseXS provides no way to XS-ify XSUB names that appear * anywhere else but in the XSUB definition. * * The mangling is deterministic, so we can translate from every other * platform => VMS here * * This will probably never get used. */ /* FIXME: redo this to include new names */ #ifdef VMS #define Class__XSAccessor_lvalue_accessor Class_XSAcc_lvacc #define Class__XSAccessor_array_setter Cs_XSAcesor_ary_set #define Class__XSAccessor_array_accessor Cs_XSAcesor_ary_accessor #define Class__XSAccessor_chained_setter Clas_XSAcesor_chained_seter #define Class__XSAccessor_chained_accessor Clas_XSAcesor_chained_acesor #define Class__XSAccessor_exists_predicate Clas_XSAcesor_eprdicate #define Class__XSAccessor_defined_predicate Clas_XSAcesor_dprdicate #define Class__XSAccessor_constructor Class_XSAccessor_constructor #define Class__XSAccessor_constant_false Clas_XSAcesor_constant_false #define Class__XSAccessor_constant_true Clas_XSAcesor_constant_true #define Class__XSAccessor__Array_getter Clas_XSAcesor_Aray_geter #define Class__XSAccessor__Array_lvalue_accessor Class_XSAcc_Ay_lvacc #define Class__XSAccessor__Array_setter Clas_XSAcesor_Aray_seter #define Class__XSAccessor__Array_chained_setter Cs_XSAs_Ay_cid_seter #define Class__XSAccessor__Array_accessor Clas_XSAcesor_Aray_acesor #define Class__XSAccessor__Array_chained_accessor Cs_XSAs_Ay_cid_acesor #define Class__XSAccessor__Array_predicate Clas_XSAcesor_Aray_predicate #define Class__XSAccessor__Array_constructor Cs_XSAs_Ay_constructor #endif #ifdef CXA_ENABLE_ENTERSUB_OPTIMIZATION #define CXAH_GENERATE_ENTERSUB_TEST(name) \ OP * cxah_entersub_ ## name(pTHX) { \ dVAR; dSP; dTOPss; \ warn("cxah: entersub: inside optimized entersub"); \ \ if (sv \ && (SvTYPE(sv) == SVt_PVCV) \ && (CvXSUB((CV *)sv) == CXAH(name)) \ ) { \ (void)POPs; \ PUTBACK; \ (void)CXAH(name)(aTHX_ (CV *)sv); \ return NORMAL; \ } else { /* not static: disable optimization */ \ if (!sv) { \ warn("cxah: entersub: disabling optimization: SV is null"); \ } else if (SvTYPE(sv) != SVt_PVCV) { \ warn("cxah: entersub: disabling optimization: SV is not a CV"); \ } else { \ warn("cxah: entersub: disabling optimization: SV is not " # name); \ } \ CXA_DISABLE_OPTIMIZATION(PL_op); /* make sure it's not reinstated */ \ PL_op->op_ppaddr = CXA_DEFAULT_ENTERSUB; \ return CXA_DEFAULT_ENTERSUB(aTHX); \ } \ } #define CXAH_GENERATE_ENTERSUB(name) \ OP * cxah_entersub_ ## name(pTHX) { \ dVAR; dSP; dTOPss; \ \ if (sv \ && (SvTYPE(sv) == SVt_PVCV) \ && (CvXSUB((CV *)sv) == CXAH(name)) \ ) { \ (void)POPs; \ PUTBACK; \ (void)CXAH(name)(aTHX_ (CV *)sv); \ return NORMAL; \ } else { /* not static: disable optimization */ \ CXA_DISABLE_OPTIMIZATION(PL_op); /* make sure it's not reinstated */ \ PL_op->op_ppaddr = CXA_DEFAULT_ENTERSUB; \ return CXA_DEFAULT_ENTERSUB(aTHX); \ } \ } #define CXAA_GENERATE_ENTERSUB(name) \ OP * cxaa_entersub_ ## name(pTHX) { \ dVAR; dSP; dTOPss; \ \ if (sv \ && (SvTYPE(sv) == SVt_PVCV) \ && (CvXSUB((CV *)sv) == CXAA(name)) \ ) { \ (void)POPs; \ PUTBACK; \ (void)CXAA(name)(aTHX_ (CV *)sv); \ return NORMAL; \ } else { /* not static: disable optimization */ \ CXA_DISABLE_OPTIMIZATION(PL_op); /* make sure it's not reinstated */ \ PL_op->op_ppaddr = CXA_DEFAULT_ENTERSUB; \ return CXA_DEFAULT_ENTERSUB(aTHX); \ } \ } #endif /* CXA_ENABLE_ENTERSUB_OPTIMIZATION */ /* Install a new XSUB under 'name' and automatically set the file name */ #define INSTALL_NEW_CV(name, xsub) \ STMT_START { \ if (newXS(name, xsub, (char*)__FILE__) == NULL) \ croak("ARG! Something went really wrong while installing a new XSUB!"); \ } STMT_END /* Install a new XSUB under 'name' and set the function index attribute * Requires a previous declaration of a CV* cv! * TODO: Once the array case has been migrated to storing pointers instead * of indexes, this macro can probably go away. **/ #define INSTALL_NEW_CV_WITH_INDEX(name, xsub, function_index) \ STMT_START { \ cv = newXS(name, xsub, (char*)__FILE__); \ if (cv == NULL) \ croak("ARG! Something went really wrong while installing a new XSUB!"); \ XSANY.any_i32 = function_index; \ } STMT_END /* Install a new XSUB under 'name' and set the function index attribute * Requires a previous declaration of a CV* cv! **/ #define INSTALL_NEW_CV_WITH_PTR(name, xsub, user_pointer) \ STMT_START { \ cv = newXS(name, xsub, (char*)__FILE__); \ if (cv == NULL) \ croak("ARG! Something went really wrong while installing a new XSUB!"); \ XSANY.any_ptr = (void *)user_pointer; \ } STMT_END /* Install a new XSUB under 'name' and set the function index attribute * for array-based objects. Requires a previous declaration of a CV* cv! **/ #define INSTALL_NEW_CV_ARRAY_OBJ(name, xsub, obj_array_index) \ STMT_START { \ const U32 function_index = get_internal_array_index((I32)obj_array_index); \ INSTALL_NEW_CV_WITH_INDEX(name, xsub, function_index); \ CXSAccessor_arrayindices[function_index] = obj_array_index; \ } STMT_END /* Install a new XSUB under 'name' and set the function index attribute * for hash-based objects. Requires a previous declaration of a CV* cv! **/ #define INSTALL_NEW_CV_HASH_OBJ(name, xsub, obj_hash_key, obj_hash_key_len) \ STMT_START { \ autoxs_hashkey *hk_ptr = get_hashkey(aTHX_ obj_hash_key, obj_hash_key_len);\ INSTALL_NEW_CV_WITH_PTR(name, xsub, hk_ptr); \ hk_ptr->key = (char*)cxa_malloc(obj_hash_key_len+1); \ cxa_memcpy(hk_ptr->key, obj_hash_key, obj_hash_key_len); \ hk_ptr->key[obj_hash_key_len] = 0; \ hk_ptr->len = obj_hash_key_len; \ PERL_HASH(hk_ptr->hash, obj_hash_key, obj_hash_key_len); \ } STMT_END #ifdef CXA_ENABLE_ENTERSUB_OPTIMIZATION static Perl_ppaddr_t CXA_DEFAULT_ENTERSUB = NULL; /* predeclare the XSUBs so we can refer to them in the optimized entersubs */ XS(CXAH(getter)); CXAH_GENERATE_ENTERSUB(getter); XS(CXAH(lvalue_accessor)); CXAH_GENERATE_ENTERSUB(lvalue_accessor); XS(CXAH(setter)); CXAH_GENERATE_ENTERSUB(setter); /* for the Class::Accessor compatibility layer only! */ XS(CXAH(array_setter)); CXAH_GENERATE_ENTERSUB(array_setter); XS(CXAH(chained_setter)); CXAH_GENERATE_ENTERSUB(chained_setter); XS(CXAH(accessor)); CXAH_GENERATE_ENTERSUB(accessor); /* for the Class::Accessor compatibility layer only! */ XS(CXAH(array_accessor)); CXAH_GENERATE_ENTERSUB(array_accessor); XS(CXAH(chained_accessor)); CXAH_GENERATE_ENTERSUB(chained_accessor); XS(CXAH(defined_predicate)); CXAH_GENERATE_ENTERSUB(defined_predicate); XS(CXAH(exists_predicate)); CXAH_GENERATE_ENTERSUB(exists_predicate); XS(CXAH(constructor)); CXAH_GENERATE_ENTERSUB(constructor); XS(CXAH(constant_false)); CXAH_GENERATE_ENTERSUB(constant_false); XS(CXAH(constant_true)); CXAH_GENERATE_ENTERSUB(constant_true); XS(CXAH(test)); CXAH_GENERATE_ENTERSUB_TEST(test); XS(CXAA(getter)); CXAA_GENERATE_ENTERSUB(getter); XS(CXAA(lvalue_accessor)); CXAA_GENERATE_ENTERSUB(lvalue_accessor); XS(CXAA(setter)); CXAA_GENERATE_ENTERSUB(setter); XS(CXAA(chained_setter)); CXAA_GENERATE_ENTERSUB(chained_setter); XS(CXAA(accessor)); CXAA_GENERATE_ENTERSUB(accessor); XS(CXAA(chained_accessor)); CXAA_GENERATE_ENTERSUB(chained_accessor); XS(CXAA(predicate)); CXAA_GENERATE_ENTERSUB(predicate); XS(CXAA(constructor)); CXAA_GENERATE_ENTERSUB(constructor); #endif /* CXA_ENABLE_ENTERSUB_OPTIMIZATION */ /* magic vtable and setter function for lvalue accessors */ STATIC int setter_for_lvalues(pTHX_ SV *sv, MAGIC* mg); STATIC int setter_for_lvalues(pTHX_ SV *sv, MAGIC* mg) { PERL_UNUSED_VAR(mg); sv_setsv(LvTARG(sv), sv); return TRUE; } STATIC MGVTBL cxsa_lvalue_acc_magic_vtable = { 0 /* get */ ,setter_for_lvalues /* set */ ,0 /* len */ ,0 /* clear */ ,0 /* free */ #if (PERL_BCDVERSION >= 0x5008000) ,0 /* copy */ ,0 /* dup */ #if (PERL_BCDVERSION >= 0x5008009) ,0 /* local */ #endif /* perl >= 5.8.0 */ #endif /* perl >= 5.8.9 */ }; #line 491 "XSAccessor.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(pTHX_ const CV *const cv, const char *const params); 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(aTHX_ "Usage: %s::%s(%s)", hvname, gvname, params); else Perl_croak(aTHX_ "Usage: %s(%s)", gvname, params); } else { /* Pants. I don't think that it should be possible to get here. */ Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params); } } #undef PERL_ARGS_ASSERT_CROAK_XS_USAGE #ifdef PERL_IMPLICIT_CONTEXT #define croak_xs_usage(a,b) S_croak_xs_usage(aTHX_ a,b) #else #define croak_xs_usage S_croak_xs_usage #endif #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) */ #line 633 "XSAccessor.c" XS_EUPXS(XS_Class__XSAccessor_END); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_END) { dVAR; dXSARGS; if (items != 0) croak_xs_usage(cv, ""); { #line 509 "XSAccessor.xs" if (CXSAccessor_reverse_hashkeys) { /* This can run before Perl is done, so accessors might still be called, * so we can't free our memory here. Solution? Special global destruction * phase *AFTER* all Perl END() subs were run? */ /*CXSA_HashTable_free(CXSAccessor_reverse_hashkeys, true);*/ } #line 650 "XSAccessor.c" } XSRETURN_EMPTY; } XS_EUPXS(XS_Class__XSAccessor___entersub_optimized__); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor___entersub_optimized__) { dVAR; dXSARGS; if (items != 0) croak_xs_usage(cv, ""); { #line 521 "XSAccessor.xs" #ifdef CXA_ENABLE_ENTERSUB_OPTIMIZATION XSRETURN(1); #else XSRETURN(0); #endif #line 669 "XSAccessor.c" } XSRETURN_EMPTY; } /* INCLUDE: Including 'XS/Hash.xs' from 'XSAccessor.xs' */ #include "ppport.h" #ifdef hv_common_key_len # define CXSA_HASH_FETCH(hv, key, len, hash) \ hv_common_key_len((hv), (key), (len), HV_FETCH_JUST_SV, NULL, (hash)) # define CXSA_HASH_FETCH_LVALUE(hv, key, len, hash) \ hv_common_key_len((hv), (key), (len), (HV_FETCH_JUST_SV|HV_FETCH_LVALUE), NULL, (hash)) # define CXSA_HASH_EXISTS(hv, key, len, hash) \ hv_common_key_len((hv), (key), (len), HV_FETCH_ISEXISTS, NULL, (hash)) #else # define CXSA_HASH_FETCH(hv, key, len, hash) hv_fetch((hv), (key), (len), 0) # define CXSA_HASH_FETCH_LVALUE(hv, key, len, hash) hv_fetch((hv), (key), (len), 1) # define CXSA_HASH_EXISTS(hv, key, len, hash) hv_exists((hv), (key), (len)) #endif #ifndef croak_xs_usage #define croak_xs_usage(cv,msg) croak(aTHX_ "Usage: %s(%s)", GvNAME(CvGV(cv)), msg) #endif XS_EUPXS(XS_Class__XSAccessor_getter); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_getter) { dVAR; dXSARGS; if (items != 1) croak_xs_usage(cv, "self"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; #line 34 "./XS/Hash.xs" /* Get the const hash key struct from the global storage */ const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY; SV** svp; #line 710 "XSAccessor.c" #line 38 "./XS/Hash.xs" CXA_CHECK_HASH(self); CXAH_OPTIMIZE_ENTERSUB(getter); if ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash))) PUSHs(*svp); else XSRETURN_UNDEF; #line 718 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor_lvalue_accessor); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_lvalue_accessor) { dVAR; dXSARGS; if (items != 1) croak_xs_usage(cv, "self"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; #line 49 "./XS/Hash.xs" /* Get the const hash key struct from the global storage */ const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY; SV** svp; SV* sv; #line 741 "XSAccessor.c" #line 54 "./XS/Hash.xs" CXA_CHECK_HASH(self); CXAH_OPTIMIZE_ENTERSUB(lvalue_accessor); if ((svp = CXSA_HASH_FETCH_LVALUE((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash))) { sv = *svp; sv_upgrade(sv, SVt_PVLV); sv_magic(sv, 0, PERL_MAGIC_ext, Nullch, 0); SvSMAGICAL_on(sv); LvTYPE(sv) = '~'; SvREFCNT_inc(sv); LvTARG(sv) = SvREFCNT_inc(sv); SvMAGIC(sv)->mg_virtual = &cxsa_lvalue_acc_magic_vtable; ST(0) = sv; XSRETURN(1); } else XSRETURN_UNDEF; #line 759 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor_setter); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_setter) { dVAR; dXSARGS; if (items != 2) croak_xs_usage(cv, "self, newvalue"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; SV* newvalue = ST(1) ; #line 76 "./XS/Hash.xs" /* Get the const hash key struct from the global storage */ const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY; #line 782 "XSAccessor.c" #line 79 "./XS/Hash.xs" CXA_CHECK_HASH(self); CXAH_OPTIMIZE_ENTERSUB(setter); if (NULL == hv_store((HV*)SvRV(self), readfrom->key, readfrom->len, newSVsv(newvalue), readfrom->hash)) croak("Failed to write new value to hash."); PUSHs(newvalue); #line 789 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor_chained_setter); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_chained_setter) { dVAR; dXSARGS; if (items != 2) croak_xs_usage(cv, "self, newvalue"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; SV* newvalue = ST(1) ; #line 90 "./XS/Hash.xs" /* Get the const hash key struct from the global storage */ const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY; #line 812 "XSAccessor.c" #line 93 "./XS/Hash.xs" CXA_CHECK_HASH(self); CXAH_OPTIMIZE_ENTERSUB(chained_setter); if (NULL == hv_store((HV*)SvRV(self), readfrom->key, readfrom->len, newSVsv(newvalue), readfrom->hash)) croak("Failed to write new value to hash."); PUSHs(self); #line 819 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor_accessor); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_accessor) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "self, ..."); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; #line 103 "./XS/Hash.xs" /* Get the const hash key struct from the global storage */ const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY; SV** svp; #line 841 "XSAccessor.c" #line 107 "./XS/Hash.xs" CXA_CHECK_HASH(self); CXAH_OPTIMIZE_ENTERSUB(accessor); if (items > 1) { SV* newvalue = ST(1); if (NULL == hv_store((HV*)SvRV(self), readfrom->key, readfrom->len, newSVsv(newvalue), readfrom->hash)) croak("Failed to write new value to hash."); PUSHs(newvalue); } else { if ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash))) PUSHs(*svp); else XSRETURN_UNDEF; } #line 857 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor_chained_accessor); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_chained_accessor) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "self, ..."); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; #line 126 "./XS/Hash.xs" /* Get the const hash key struct from the global storage */ const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY; SV** svp; #line 879 "XSAccessor.c" #line 130 "./XS/Hash.xs" CXA_CHECK_HASH(self); CXAH_OPTIMIZE_ENTERSUB(chained_accessor); if (items > 1) { SV* newvalue = ST(1); if (NULL == hv_store((HV*)SvRV(self), readfrom->key, readfrom->len, newSVsv(newvalue), readfrom->hash)) croak("Failed to write new value to hash."); PUSHs(self); } else { if ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash))) PUSHs(*svp); else XSRETURN_UNDEF; } #line 895 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor_exists_predicate); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_exists_predicate) { dVAR; dXSARGS; if (items != 1) croak_xs_usage(cv, "self"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; #line 149 "./XS/Hash.xs" /* Get the const hash key struct from the global storage */ const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY; #line 916 "XSAccessor.c" #line 152 "./XS/Hash.xs" CXA_CHECK_HASH(self); CXAH_OPTIMIZE_ENTERSUB(exists_predicate); if ( CXSA_HASH_EXISTS((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash) != NULL ) XSRETURN_YES; else XSRETURN_NO; #line 924 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor_defined_predicate); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_defined_predicate) { dVAR; dXSARGS; if (items != 1) croak_xs_usage(cv, "self"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; #line 163 "./XS/Hash.xs" /* Get the const hash key struct from the global storage */ const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY; SV** svp; #line 946 "XSAccessor.c" #line 167 "./XS/Hash.xs" CXA_CHECK_HASH(self); CXAH_OPTIMIZE_ENTERSUB(defined_predicate); if ( ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash))) && SvOK(*svp) ) XSRETURN_YES; else XSRETURN_NO; #line 954 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor_constructor); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_constructor) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "class, ..."); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* class = ST(0) ; #line 178 "./XS/Hash.xs" int iStack; HV* hash; SV* obj; const char* classname; #line 977 "XSAccessor.c" #line 183 "./XS/Hash.xs" CXAH_OPTIMIZE_ENTERSUB(constructor); classname = SvROK(class) ? sv_reftype(SvRV(class), 1) : SvPV_nolen_const(class); hash = newHV(); obj = sv_bless(newRV_noinc((SV *)hash), gv_stashpv(classname, 1)); if (items > 1) { /* if @_ - 1 (for $class) is even: most compilers probably convert items % 2 into this, but just in case */ if (items & 1) { for (iStack = 1; iStack < items; iStack += 2) { /* we could check for the hv_store_ent return value, but perl doesn't in this situation (see pp_anonhash) */ (void)hv_store_ent(hash, ST(iStack), newSVsv(ST(iStack+1)), 0); } } else { croak("Uneven number of arguments to constructor."); } } PUSHs(sv_2mortal(obj)); #line 998 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor_constant_false); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_constant_false) { dVAR; dXSARGS; if (items != 1) croak_xs_usage(cv, "self"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV * self = ST(0) ; #line 207 "./XS/Hash.xs" PERL_UNUSED_VAR(self); CXAH_OPTIMIZE_ENTERSUB(constant_false); { XSRETURN_NO; } #line 1022 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor_constant_true); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_constant_true) { dVAR; dXSARGS; if (items != 1) croak_xs_usage(cv, "self"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; #line 217 "./XS/Hash.xs" PERL_UNUSED_VAR(self); CXAH_OPTIMIZE_ENTERSUB(constant_true); { XSRETURN_YES; } #line 1046 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor_test); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_test) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "self, ..."); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; #line 227 "./XS/Hash.xs" /* Get the const hash key struct from the global storage */ const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY; SV** svp; #line 1068 "XSAccessor.c" #line 231 "./XS/Hash.xs" CXA_CHECK_HASH(self); warn("cxah: accessor: inside test"); CXAH_OPTIMIZE_ENTERSUB_TEST(test); if (items > 1) { SV* newvalue = ST(1); if (NULL == hv_store((HV*)SvRV(self), readfrom->key, readfrom->len, newSVsv(newvalue), readfrom->hash)) croak("Failed to write new value to hash."); PUSHs(newvalue); } else { if ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash))) PUSHs(*svp); else XSRETURN_UNDEF; } #line 1085 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor_newxs_getter); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_newxs_getter) { dVAR; dXSARGS; dXSI32; if (items != 2) croak_xs_usage(cv, "namesv, keysv"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV * namesv = ST(0) ; SV * keysv = ST(1) ; #line 257 "./XS/Hash.xs" char *name; char *key; STRLEN namelen, keylen; #line 1110 "XSAccessor.c" #line 261 "./XS/Hash.xs" name = SvPV(namesv, namelen); key = SvPV(keysv, keylen); switch (ix) { case 0: /* newxs_getter */ INSTALL_NEW_CV_HASH_OBJ(name, CXAH(getter), key, keylen); break; case 1: { /* newxs_lvalue_accessor */ CV* cv; INSTALL_NEW_CV_HASH_OBJ(name, CXAH(lvalue_accessor), key, keylen); /* Make the CV lvalue-able. "cv" was set by the previous macro */ CvLVALUE_on(cv); } break; case 2: case 3: INSTALL_NEW_CV_HASH_OBJ(name, CXAH(defined_predicate), key, keylen); break; case 4: INSTALL_NEW_CV_HASH_OBJ(name, CXAH(exists_predicate), key, keylen); break; default: croak("Invalid alias of newxs_getter called"); break; } #line 1136 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor_newxs_setter); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_newxs_setter) { dVAR; dXSARGS; dXSI32; if (items != 3) croak_xs_usage(cv, "namesv, keysv, chained"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV * namesv = ST(0) ; SV * keysv = ST(1) ; bool chained = (bool)SvTRUE(ST(2)) ; #line 294 "./XS/Hash.xs" char *name; char *key; STRLEN namelen, keylen; #line 1163 "XSAccessor.c" #line 298 "./XS/Hash.xs" name = SvPV(namesv, namelen); key = SvPV(keysv, keylen); if (ix == 0) { /* newxs_setter */ if (chained) INSTALL_NEW_CV_HASH_OBJ(name, CXAH(chained_setter), key, keylen); else INSTALL_NEW_CV_HASH_OBJ(name, CXAH(setter), key, keylen); } else { /* newxs_accessor */ if (chained) INSTALL_NEW_CV_HASH_OBJ(name, CXAH(chained_accessor), key, keylen); else INSTALL_NEW_CV_HASH_OBJ(name, CXAH(accessor), key, keylen); } #line 1179 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor_newxs_constructor); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_newxs_constructor) { dVAR; dXSARGS; if (items != 1) croak_xs_usage(cv, "namesv"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV * namesv = ST(0) ; #line 317 "./XS/Hash.xs" char *name; STRLEN namelen; #line 1200 "XSAccessor.c" #line 320 "./XS/Hash.xs" name = SvPV(namesv, namelen); INSTALL_NEW_CV(name, CXAH(constructor)); #line 1204 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor_newxs_boolean); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_newxs_boolean) { dVAR; dXSARGS; if (items != 2) croak_xs_usage(cv, "namesv, truth"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV * namesv = ST(0) ; bool truth = (bool)SvTRUE(ST(1)) ; #line 328 "./XS/Hash.xs" char *name; STRLEN namelen; #line 1227 "XSAccessor.c" #line 331 "./XS/Hash.xs" name = SvPV(namesv, namelen); if (truth) INSTALL_NEW_CV(name, CXAH(constant_true)); else INSTALL_NEW_CV(name, CXAH(constant_false)); #line 1234 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor_newxs_test); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_newxs_test) { dVAR; dXSARGS; if (items != 2) croak_xs_usage(cv, "namesv, keysv"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV * namesv = ST(0) ; SV * keysv = ST(1) ; #line 342 "./XS/Hash.xs" char *name; char *key; STRLEN namelen, keylen; #line 1258 "XSAccessor.c" #line 346 "./XS/Hash.xs" name = SvPV(namesv, namelen); key = SvPV(keysv, keylen); INSTALL_NEW_CV_HASH_OBJ(name, CXAH(test), key, keylen); #line 1263 "XSAccessor.c" PUTBACK; return; } } /* INCLUDE: Returning to 'XSAccessor.xs' from 'XS/Hash.xs' */ /* INCLUDE: Including 'XS/HashCACompat.xs' from 'XSAccessor.xs' */ #include "ppport.h" #ifdef hv_common_key_len #define CXSA_HASH_FETCH(hv, key, len, hash) hv_common_key_len((hv), (key), (len), HV_FETCH_JUST_SV, NULL, (hash)) #else #define CXSA_HASH_FETCH(hv, key, len, hash) hv_fetch(hv, key, len, 0) #endif #ifndef croak_xs_usage #define croak_xs_usage(cv,msg) croak(aTHX_ "Usage: %s(%s)", GvNAME(CvGV(cv)), msg) #endif XS_EUPXS(XS_Class__XSAccessor_array_setter_init); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_array_setter_init) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "self, ..."); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; #line 22 "./XS/HashCACompat.xs" /* NOTE: This method is for Class::Accessor compatibility only. It's not * part of the normal API! */ SV* newvalue = NULL; /* squelch may-be-used-uninitialized warning that doesn't apply */ SV ** hashAssignRes; /* Get the const hash key struct from the global storage */ const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY; #line 1304 "XSAccessor.c" #line 29 "./XS/HashCACompat.xs" CXA_CHECK_HASH(self); CXAH_OPTIMIZE_ENTERSUB(array_setter); if (items == 2) { newvalue = newSVsv(ST(1)); } else if (items > 2) { I32 i; AV* tmp = newAV(); av_extend(tmp, items-1); for (i = 1; i < items; ++i) { newvalue = newSVsv(ST(i)); if (!av_store(tmp, i-1, newvalue)) { SvREFCNT_dec(newvalue); croak("Failure to store value in array"); } } newvalue = newRV_noinc((SV*) tmp); } else { croak_xs_usage(cv, "self, newvalue(s)"); } if ((hashAssignRes = hv_store((HV*)SvRV(self), readfrom->key, readfrom->len, newvalue, readfrom->hash))) { PUSHs(*hashAssignRes); } else { SvREFCNT_dec(newvalue); croak("Failed to write new value to hash."); } #line 1335 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor_array_setter); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_array_setter) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "self, ..."); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; #line 63 "./XS/HashCACompat.xs" /* NOTE: This method is for Class::Accessor compatibility only. It's not * part of the normal API! */ SV* newvalue = NULL; /* squelch may-be-used-uninitialized warning that doesn't apply */ SV ** hashAssignRes; /* Get the const hash key struct from the global storage */ const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY; #line 1360 "XSAccessor.c" #line 70 "./XS/HashCACompat.xs" CXA_CHECK_HASH(self); if (items == 2) { newvalue = newSVsv(ST(1)); } else if (items > 2) { I32 i; AV* tmp = newAV(); av_extend(tmp, items-1); for (i = 1; i < items; ++i) { newvalue = newSVsv(ST(i)); if (!av_store(tmp, i-1, newvalue)) { SvREFCNT_dec(newvalue); croak("Failure to store value in array"); } } newvalue = newRV_noinc((SV*) tmp); } else { croak_xs_usage(cv, "self, newvalue(s)"); } if ((hashAssignRes = hv_store((HV*)SvRV(self), readfrom->key, readfrom->len, newvalue, readfrom->hash))) { PUSHs(*hashAssignRes); } else { SvREFCNT_dec(newvalue); croak("Failed to write new value to hash."); } #line 1390 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor_array_accessor_init); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_array_accessor_init) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "self, ..."); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; #line 103 "./XS/HashCACompat.xs" /* NOTE: This method is for Class::Accessor compatibility only. It's not * part of the normal API! */ SV ** hashAssignRes; /* Get the const hash key struct from the global storage */ const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY; #line 1414 "XSAccessor.c" #line 109 "./XS/HashCACompat.xs" CXA_CHECK_HASH(self); CXAH_OPTIMIZE_ENTERSUB(array_accessor); if (items == 1) { SV** svp; if ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash))) PUSHs(*svp); else XSRETURN_UNDEF; } else { /* writing branch */ SV* newvalue; if (items == 2) { newvalue = newSVsv(ST(1)); } else { /* items > 2 */ I32 i; AV* tmp = newAV(); av_extend(tmp, items-1); for (i = 1; i < items; ++i) { newvalue = newSVsv(ST(i)); if (!av_store(tmp, i-1, newvalue)) { SvREFCNT_dec(newvalue); croak("Failure to store value in array"); } } newvalue = newRV_noinc((SV*) tmp); } if ((hashAssignRes = hv_store((HV*)SvRV(self), readfrom->key, readfrom->len, newvalue, readfrom->hash))) { PUSHs(*hashAssignRes); } else { SvREFCNT_dec(newvalue); croak("Failed to write new value to hash."); } } /* end writing branch */ #line 1452 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor_array_accessor); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor_array_accessor) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "self, ..."); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; #line 150 "./XS/HashCACompat.xs" /* NOTE: This method is for Class::Accessor compatibility only. It's not * part of the normal API! */ SV ** hashAssignRes; /* Get the const hash key struct from the global storage */ const autoxs_hashkey * readfrom = CXAH_GET_HASHKEY; #line 1476 "XSAccessor.c" #line 156 "./XS/HashCACompat.xs" CXA_CHECK_HASH(self); if (items == 1) { SV** svp; if ((svp = CXSA_HASH_FETCH((HV *)SvRV(self), readfrom->key, readfrom->len, readfrom->hash))) PUSHs(*svp); else XSRETURN_UNDEF; } else { /* writing branch */ SV* newvalue; if (items == 2) { newvalue = newSVsv(ST(1)); } else { /* items > 2 */ I32 i; AV* tmp = newAV(); av_extend(tmp, items-1); for (i = 1; i < items; ++i) { newvalue = newSVsv(ST(i)); if (!av_store(tmp, i-1, newvalue)) { SvREFCNT_dec(newvalue); croak("Failure to store value in array"); } } newvalue = newRV_noinc((SV*) tmp); } if ((hashAssignRes = hv_store((HV*)SvRV(self), readfrom->key, readfrom->len, newvalue, readfrom->hash))) { PUSHs(*hashAssignRes); } else { SvREFCNT_dec(newvalue); croak("Failed to write new value to hash."); } } /* end writing branch */ #line 1513 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor__newxs_compat_setter); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor__newxs_compat_setter) { dVAR; dXSARGS; if (items != 2) croak_xs_usage(cv, "namesv, keysv"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV * namesv = ST(0) ; SV * keysv = ST(1) ; #line 197 "./XS/HashCACompat.xs" char *name; char *key; STRLEN namelen, keylen; #line 1537 "XSAccessor.c" #line 201 "./XS/HashCACompat.xs" name = SvPV(namesv, namelen); key = SvPV(keysv, keylen); /* WARNING: If this is called in your code, you're doing it WRONG! */ INSTALL_NEW_CV_HASH_OBJ(name, CXAH(array_setter_init), key, keylen); #line 1543 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor__newxs_compat_accessor); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor__newxs_compat_accessor) { dVAR; dXSARGS; if (items != 2) croak_xs_usage(cv, "namesv, keysv"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV * namesv = ST(0) ; SV * keysv = ST(1) ; #line 211 "./XS/HashCACompat.xs" char *name; char *key; STRLEN namelen, keylen; #line 1567 "XSAccessor.c" #line 215 "./XS/HashCACompat.xs" name = SvPV(namesv, namelen); key = SvPV(keysv, keylen); /* WARNING: If this is called in your code, you're doing it WRONG! */ INSTALL_NEW_CV_HASH_OBJ(name, CXAH(array_accessor_init), key, keylen); #line 1573 "XSAccessor.c" PUTBACK; return; } } /* INCLUDE: Returning to 'XSAccessor.xs' from 'XS/HashCACompat.xs' */ /* INCLUDE: Including 'XS/Array.xs' from 'XSAccessor.xs' */ #define NEED_sv_2pv_flags_GLOBAL #include "ppport.h" XS_EUPXS(XS_Class__XSAccessor__Array_getter); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor__Array_getter) { dVAR; dXSARGS; dXSI32; if (items != 1) croak_xs_usage(cv, "self"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; #line 12 "./XS/Array.xs" /* Get the array index from the global storage */ /* ix is the magic integer variable that is set by the perl guts for us. * We uses it to identify the currently running alias of the accessor. Gollum! */ const I32 index = CXSAccessor_arrayindices[ix]; SV** svp; #line 1607 "XSAccessor.c" #line 18 "./XS/Array.xs" CXA_CHECK_ARRAY(self); CXAA_OPTIMIZE_ENTERSUB(getter); if ((svp = av_fetch((AV *)SvRV(self), index, 1))) PUSHs(svp[0]); else XSRETURN_UNDEF; #line 1615 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor__Array_lvalue_accessor); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor__Array_lvalue_accessor) { dVAR; dXSARGS; dXSI32; if (items != 1) croak_xs_usage(cv, "self"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; #line 30 "./XS/Array.xs" /* Get the array index from the global storage */ /* ix is the magic integer variable that is set by the perl guts for us. * We uses it to identify the currently running alias of the accessor. Gollum! */ const I32 index = CXSAccessor_arrayindices[ix]; SV** svp; SV* sv; #line 1641 "XSAccessor.c" #line 37 "./XS/Array.xs" CXA_CHECK_ARRAY(self); CXAA_OPTIMIZE_ENTERSUB(lvalue_accessor); if ((svp = av_fetch((AV *)SvRV(self), index, 1))) { sv = *svp; sv_upgrade(sv, SVt_PVLV); sv_magic(sv, 0, PERL_MAGIC_ext, Nullch, 0); SvSMAGICAL_on(sv); LvTYPE(sv) = '~'; SvREFCNT_inc(sv); LvTARG(sv) = SvREFCNT_inc(sv); SvMAGIC(sv)->mg_virtual = &cxsa_lvalue_acc_magic_vtable; ST(0) = sv; XSRETURN(1); } else XSRETURN_UNDEF; #line 1659 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor__Array_setter); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor__Array_setter) { dVAR; dXSARGS; dXSI32; if (items != 2) croak_xs_usage(cv, "self, newvalue"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; SV* newvalue = ST(1) ; #line 60 "./XS/Array.xs" /* Get the array index from the global storage */ /* ix is the magic integer variable that is set by the perl guts for us. * We uses it to identify the currently running alias of the accessor. Gollum! */ const I32 index = CXSAccessor_arrayindices[ix]; #line 1685 "XSAccessor.c" #line 65 "./XS/Array.xs" CXA_CHECK_ARRAY(self); CXAA_OPTIMIZE_ENTERSUB(setter); if (NULL == av_store((AV*)SvRV(self), index, newSVsv(newvalue))) croak("Failed to write new value to array."); PUSHs(newvalue); #line 1692 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor__Array_chained_setter); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor__Array_chained_setter) { dVAR; dXSARGS; dXSI32; if (items != 2) croak_xs_usage(cv, "self, newvalue"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; SV* newvalue = ST(1) ; #line 77 "./XS/Array.xs" /* Get the array index from the global storage */ /* ix is the magic integer variable that is set by the perl guts for us. * We uses it to identify the currently running alias of the accessor. Gollum! */ const I32 index = CXSAccessor_arrayindices[ix]; #line 1718 "XSAccessor.c" #line 82 "./XS/Array.xs" CXA_CHECK_ARRAY(self); CXAA_OPTIMIZE_ENTERSUB(chained_setter); if (NULL == av_store((AV*)SvRV(self), index, newSVsv(newvalue))) croak("Failed to write new value to array."); PUSHs(self); #line 1725 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor__Array_accessor); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor__Array_accessor) { dVAR; dXSARGS; dXSI32; if (items < 1) croak_xs_usage(cv, "self, ..."); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; #line 93 "./XS/Array.xs" /* Get the array index from the global storage */ /* ix is the magic integer variable that is set by the perl guts for us. * We uses it to identify the currently running alias of the accessor. Gollum! */ const I32 index = CXSAccessor_arrayindices[ix]; SV** svp; #line 1750 "XSAccessor.c" #line 99 "./XS/Array.xs" CXA_CHECK_ARRAY(self); CXAA_OPTIMIZE_ENTERSUB(accessor); if (items > 1) { SV* newvalue = ST(1); if (NULL == av_store((AV*)SvRV(self), index, newSVsv(newvalue))) croak("Failed to write new value to array."); PUSHs(newvalue); } else { if ((svp = av_fetch((AV *)SvRV(self), index, 1))) PUSHs(svp[0]); else XSRETURN_UNDEF; } #line 1766 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor__Array_chained_accessor); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor__Array_chained_accessor) { dVAR; dXSARGS; dXSI32; if (items < 1) croak_xs_usage(cv, "self, ..."); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; #line 119 "./XS/Array.xs" /* Get the array index from the global storage */ /* ix is the magic integer variable that is set by the perl guts for us. * We uses it to identify the currently running alias of the accessor. Gollum! */ const I32 index = CXSAccessor_arrayindices[ix]; SV** svp; #line 1791 "XSAccessor.c" #line 125 "./XS/Array.xs" CXA_CHECK_ARRAY(self); CXAA_OPTIMIZE_ENTERSUB(chained_accessor); if (items > 1) { SV* newvalue = ST(1); if (NULL == av_store((AV*)SvRV(self), index, newSVsv(newvalue))) croak("Failed to write new value to array."); PUSHs(self); } else { if ((svp = av_fetch((AV *)SvRV(self), index, 1))) PUSHs(svp[0]); else XSRETURN_UNDEF; } #line 1807 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor__Array_predicate); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor__Array_predicate) { dVAR; dXSARGS; dXSI32; if (items != 1) croak_xs_usage(cv, "self"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* self = ST(0) ; #line 145 "./XS/Array.xs" /* Get the array index from the global storage */ /* ix is the magic integer variable that is set by the perl guts for us. * We uses it to identify the currently running alias of the accessor. Gollum! */ const I32 index = CXSAccessor_arrayindices[ix]; SV** svp; #line 1832 "XSAccessor.c" #line 151 "./XS/Array.xs" CXA_CHECK_ARRAY(self); CXAA_OPTIMIZE_ENTERSUB(predicate); if ( (svp = av_fetch((AV *)SvRV(self), index, 1)) && SvOK(svp[0]) ) XSRETURN_YES; else XSRETURN_NO; #line 1840 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor__Array_constructor); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor__Array_constructor) { dVAR; dXSARGS; if (items < 1) croak_xs_usage(cv, "class, ..."); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV* class = ST(0) ; #line 162 "./XS/Array.xs" AV* array; SV* obj; const char* classname; #line 1862 "XSAccessor.c" #line 166 "./XS/Array.xs" CXAA_OPTIMIZE_ENTERSUB(constructor); classname = SvROK(class) ? sv_reftype(SvRV(class), 1) : SvPV_nolen_const(class); array = newAV(); obj = sv_bless( newRV_noinc((SV*)array), gv_stashpv(classname, 1) ); /* we ignore arguments. See Class::XSAccessor's XS code for * how we'd use them in case of bless {@_} => $class. */ PUSHs(sv_2mortal(obj)); #line 1873 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor__Array_newxs_getter); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor__Array_newxs_getter) { dVAR; dXSARGS; dXSI32; if (items != 2) croak_xs_usage(cv, "namesv, index"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV * namesv = ST(0) ; U32 index = (unsigned long)SvUV(ST(1)) ; #line 184 "./XS/Array.xs" char *name; STRLEN namelen; #line 1897 "XSAccessor.c" #line 187 "./XS/Array.xs" name = SvPV(namesv, namelen); switch (ix) { case 0: /* newxs_getter */ INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(getter), index); break; case 1: /* newxs_lvalue_accessor */ { CV* cv; INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(lvalue_accessor), index); /* Make the CV lvalue-able. "cv" was set by the previous macro */ CvLVALUE_on(cv); break; } case 2: /* newxs_predicate */ INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(predicate), index); break; default: croak("Invalid alias of newxs_getter called"); break; } #line 1919 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor__Array_newxs_setter); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor__Array_newxs_setter) { dVAR; dXSARGS; dXSI32; if (items != 3) croak_xs_usage(cv, "namesv, index, chained"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV * namesv = ST(0) ; U32 index = (unsigned long)SvUV(ST(1)) ; bool chained = (bool)SvTRUE(ST(2)) ; #line 216 "./XS/Array.xs" char *name; STRLEN namelen; #line 1945 "XSAccessor.c" #line 219 "./XS/Array.xs" name = SvPV(namesv, namelen); if (ix == 0) { /* newxs_setter */ if (chained) INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(chained_setter), index); else INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(setter), index); } else { /* newxs_accessor */ if (chained) INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(chained_accessor), index); else INSTALL_NEW_CV_ARRAY_OBJ(name, CXAA(accessor), index); } #line 1960 "XSAccessor.c" PUTBACK; return; } } XS_EUPXS(XS_Class__XSAccessor__Array_newxs_constructor); /* prototype to pass -Wmissing-prototypes */ XS_EUPXS(XS_Class__XSAccessor__Array_newxs_constructor) { dVAR; dXSARGS; if (items != 1) croak_xs_usage(cv, "namesv"); PERL_UNUSED_VAR(ax); /* -Wall */ SP -= items; { SV * namesv = ST(0) ; #line 237 "./XS/Array.xs" char *name; STRLEN namelen; #line 1981 "XSAccessor.c" #line 240 "./XS/Array.xs" name = SvPV(namesv, namelen); INSTALL_NEW_CV(name, CXAA(constructor)); #line 1985 "XSAccessor.c" PUTBACK; return; } } /* INCLUDE: Returning to 'XSAccessor.xs' from 'XS/Array.xs' */ #ifdef __cplusplus extern "C" #endif XS_EXTERNAL(boot_Class__XSAccessor); /* prototype to pass -Wmissing-prototypes */ XS_EXTERNAL(boot_Class__XSAccessor) { dVAR; dXSARGS; #if (PERL_REVISION == 5 && PERL_VERSION < 9) char* file = __FILE__; #else const char* file = __FILE__; #endif PERL_UNUSED_VAR(cv); /* -W */ PERL_UNUSED_VAR(items); /* -W */ #ifdef XS_APIVERSION_BOOTCHECK XS_APIVERSION_BOOTCHECK; #endif XS_VERSION_BOOTCHECK; { CV * cv; (void)newXSproto_portable("Class::XSAccessor::END", XS_Class__XSAccessor_END, file, ""); (void)newXSproto_portable("Class::XSAccessor::__entersub_optimized__", XS_Class__XSAccessor___entersub_optimized__, file, ""); newXS("Class::XSAccessor::getter", XS_Class__XSAccessor_getter, file); newXS("Class::XSAccessor::lvalue_accessor", XS_Class__XSAccessor_lvalue_accessor, file); newXS("Class::XSAccessor::setter", XS_Class__XSAccessor_setter, file); newXS("Class::XSAccessor::chained_setter", XS_Class__XSAccessor_chained_setter, file); newXS("Class::XSAccessor::accessor", XS_Class__XSAccessor_accessor, file); newXS("Class::XSAccessor::chained_accessor", XS_Class__XSAccessor_chained_accessor, file); newXS("Class::XSAccessor::exists_predicate", XS_Class__XSAccessor_exists_predicate, file); newXS("Class::XSAccessor::defined_predicate", XS_Class__XSAccessor_defined_predicate, file); newXS("Class::XSAccessor::constructor", XS_Class__XSAccessor_constructor, file); newXS("Class::XSAccessor::constant_false", XS_Class__XSAccessor_constant_false, file); newXS("Class::XSAccessor::constant_true", XS_Class__XSAccessor_constant_true, file); newXS("Class::XSAccessor::test", XS_Class__XSAccessor_test, file); cv = newXS("Class::XSAccessor::newxs_predicate", XS_Class__XSAccessor_newxs_getter, file); XSANY.any_i32 = 2; cv = newXS("Class::XSAccessor::newxs_lvalue_accessor", XS_Class__XSAccessor_newxs_getter, file); XSANY.any_i32 = 1; cv = newXS("Class::XSAccessor::newxs_getter", XS_Class__XSAccessor_newxs_getter, file); XSANY.any_i32 = 0; cv = newXS("Class::XSAccessor::newxs_exists_predicate", XS_Class__XSAccessor_newxs_getter, file); XSANY.any_i32 = 4; cv = newXS("Class::XSAccessor::newxs_defined_predicate", XS_Class__XSAccessor_newxs_getter, file); XSANY.any_i32 = 3; cv = newXS("Class::XSAccessor::newxs_setter", XS_Class__XSAccessor_newxs_setter, file); XSANY.any_i32 = 0; cv = newXS("Class::XSAccessor::newxs_accessor", XS_Class__XSAccessor_newxs_setter, file); XSANY.any_i32 = 1; newXS("Class::XSAccessor::newxs_constructor", XS_Class__XSAccessor_newxs_constructor, file); newXS("Class::XSAccessor::newxs_boolean", XS_Class__XSAccessor_newxs_boolean, file); newXS("Class::XSAccessor::newxs_test", XS_Class__XSAccessor_newxs_test, file); newXS("Class::XSAccessor::array_setter_init", XS_Class__XSAccessor_array_setter_init, file); newXS("Class::XSAccessor::array_setter", XS_Class__XSAccessor_array_setter, file); newXS("Class::XSAccessor::array_accessor_init", XS_Class__XSAccessor_array_accessor_init, file); newXS("Class::XSAccessor::array_accessor", XS_Class__XSAccessor_array_accessor, file); newXS("Class::XSAccessor::_newxs_compat_setter", XS_Class__XSAccessor__newxs_compat_setter, file); newXS("Class::XSAccessor::_newxs_compat_accessor", XS_Class__XSAccessor__newxs_compat_accessor, file); newXS("Class::XSAccessor::Array::getter", XS_Class__XSAccessor__Array_getter, file); newXS("Class::XSAccessor::Array::lvalue_accessor", XS_Class__XSAccessor__Array_lvalue_accessor, file); newXS("Class::XSAccessor::Array::setter", XS_Class__XSAccessor__Array_setter, file); newXS("Class::XSAccessor::Array::chained_setter", XS_Class__XSAccessor__Array_chained_setter, file); newXS("Class::XSAccessor::Array::accessor", XS_Class__XSAccessor__Array_accessor, file); newXS("Class::XSAccessor::Array::chained_accessor", XS_Class__XSAccessor__Array_chained_accessor, file); newXS("Class::XSAccessor::Array::predicate", XS_Class__XSAccessor__Array_predicate, file); newXS("Class::XSAccessor::Array::constructor", XS_Class__XSAccessor__Array_constructor, file); cv = newXS("Class::XSAccessor::Array::newxs_lvalue_accessor", XS_Class__XSAccessor__Array_newxs_getter, file); XSANY.any_i32 = 1; cv = newXS("Class::XSAccessor::Array::newxs_getter", XS_Class__XSAccessor__Array_newxs_getter, file); XSANY.any_i32 = 0; cv = newXS("Class::XSAccessor::Array::newxs_predicate", XS_Class__XSAccessor__Array_newxs_getter, file); XSANY.any_i32 = 2; cv = newXS("Class::XSAccessor::Array::newxs_accessor", XS_Class__XSAccessor__Array_newxs_setter, file); XSANY.any_i32 = 1; cv = newXS("Class::XSAccessor::Array::newxs_setter", XS_Class__XSAccessor__Array_newxs_setter, file); XSANY.any_i32 = 0; newXS("Class::XSAccessor::Array::newxs_constructor", XS_Class__XSAccessor__Array_newxs_constructor, file); } /* Initialisation Section */ #line 485 "XSAccessor.xs" #ifdef CXA_ENABLE_ENTERSUB_OPTIMIZATION CXA_DEFAULT_ENTERSUB = PL_ppaddr[OP_ENTERSUB]; #endif #ifdef USE_ITHREADS _init_cxsa_lock(&CXSAccessor_lock); /* cf. CXSAccessor.h */ #endif /* USE_ITHREADS */ /* * testing the hashtable implementation... */ /* { HashTable* tb = CXSA_HashTable_new(16, 0.9); CXSA_HashTable_store(tb, "test", 4, 12); CXSA_HashTable_store(tb, "test5", 5, 199); warn("12==%u\n", CXSA_HashTable_fetch(tb, "test", 4)); warn("199==%u\n", CXSA_HashTable_fetch(tb, "test5", 5)); warn("0==%u\n", CXSA_HashTable_fetch(tb, "test123", 7)); } */ #line 2098 "XSAccessor.c" /* End of Initialisation Section */ #if (PERL_REVISION == 5 && PERL_VERSION >= 9) if (PL_unitcheckav) call_list(PL_scopestack_ix, PL_unitcheckav); #endif XSRETURN_YES; }