diff options
Diffstat (limited to 'xs')
| -rw-r--r-- | xs/Attribute.xs | 9 | ||||
| -rw-r--r-- | xs/AttributeCore.xs | 18 | ||||
| -rw-r--r-- | xs/Class.xs | 12 | ||||
| -rw-r--r-- | xs/Generated.xs | 9 | ||||
| -rw-r--r-- | xs/HasAttributes.xs | 9 | ||||
| -rw-r--r-- | xs/HasMethods.xs | 88 | ||||
| -rw-r--r-- | xs/Inlined.xs | 8 | ||||
| -rw-r--r-- | xs/Instance.xs | 8 | ||||
| -rw-r--r-- | xs/MOP.xs | 21 | ||||
| -rw-r--r-- | xs/Method.xs | 23 | ||||
| -rw-r--r-- | xs/Moose.xs | 170 | ||||
| -rw-r--r-- | xs/Package.xs | 8 | ||||
| -rw-r--r-- | xs/ToInstance.xs | 63 | ||||
| -rw-r--r-- | xs/typemap | 17 |
14 files changed, 463 insertions, 0 deletions
diff --git a/xs/Attribute.xs b/xs/Attribute.xs new file mode 100644 index 0000000..6314af8 --- /dev/null +++ b/xs/Attribute.xs @@ -0,0 +1,9 @@ +#include "mop.h" + +MODULE = Class::MOP::Attribute PACKAGE = Class::MOP::Attribute + +PROTOTYPES: DISABLE + +BOOT: + INSTALL_SIMPLE_READER(Attribute, associated_class); + INSTALL_SIMPLE_READER(Attribute, associated_methods); diff --git a/xs/AttributeCore.xs b/xs/AttributeCore.xs new file mode 100644 index 0000000..d495a16 --- /dev/null +++ b/xs/AttributeCore.xs @@ -0,0 +1,18 @@ +#include "mop.h" + +MODULE = Class::MOP::Mixin::AttributeCore PACKAGE = Class::MOP::Mixin::AttributeCore + +PROTOTYPES: DISABLE + +BOOT: + INSTALL_SIMPLE_READER(Mixin::AttributeCore, name); + INSTALL_SIMPLE_READER(Mixin::AttributeCore, accessor); + INSTALL_SIMPLE_READER(Mixin::AttributeCore, reader); + INSTALL_SIMPLE_READER(Mixin::AttributeCore, writer); + INSTALL_SIMPLE_READER(Mixin::AttributeCore, predicate); + INSTALL_SIMPLE_READER(Mixin::AttributeCore, clearer); + INSTALL_SIMPLE_READER(Mixin::AttributeCore, builder); + INSTALL_SIMPLE_READER(Mixin::AttributeCore, init_arg); + INSTALL_SIMPLE_READER(Mixin::AttributeCore, initializer); + INSTALL_SIMPLE_READER(Mixin::AttributeCore, definition_context); + INSTALL_SIMPLE_READER(Mixin::AttributeCore, insertion_order); diff --git a/xs/Class.xs b/xs/Class.xs new file mode 100644 index 0000000..5c5d5c9 --- /dev/null +++ b/xs/Class.xs @@ -0,0 +1,12 @@ +#include "mop.h" + +MODULE = Class::MOP::Class PACKAGE = Class::MOP::Class + +PROTOTYPES: DISABLE + +BOOT: + INSTALL_SIMPLE_READER(Class, instance_metaclass); + INSTALL_SIMPLE_READER(Class, immutable_trait); + INSTALL_SIMPLE_READER(Class, constructor_class); + INSTALL_SIMPLE_READER(Class, constructor_name); + INSTALL_SIMPLE_READER(Class, destructor_class); diff --git a/xs/Generated.xs b/xs/Generated.xs new file mode 100644 index 0000000..57db324 --- /dev/null +++ b/xs/Generated.xs @@ -0,0 +1,9 @@ +#include "mop.h" + +MODULE = Class::MOP::Method::Generated PACKAGE = Class::MOP::Method::Generated + +PROTOTYPES: DISABLE + +BOOT: + INSTALL_SIMPLE_READER(Method::Generated, is_inline); + INSTALL_SIMPLE_READER(Method::Generated, definition_context); diff --git a/xs/HasAttributes.xs b/xs/HasAttributes.xs new file mode 100644 index 0000000..dc59227 --- /dev/null +++ b/xs/HasAttributes.xs @@ -0,0 +1,9 @@ +#include "mop.h" + +MODULE = Class::MOP::Mixin::HasAttributes PACKAGE = Class::MOP::Mixin::HasAttributes + +PROTOTYPES: DISABLE + +BOOT: + INSTALL_SIMPLE_READER(Mixin::HasAttributes, attribute_metaclass); + INSTALL_SIMPLE_READER_WITH_KEY(Mixin::HasAttributes, _attribute_map, attributes); diff --git a/xs/HasMethods.xs b/xs/HasMethods.xs new file mode 100644 index 0000000..e136abe --- /dev/null +++ b/xs/HasMethods.xs @@ -0,0 +1,88 @@ +#include "mop.h" + +SV *mop_method_metaclass; +SV *mop_associated_metaclass; +SV *mop_wrap; + +static void +mop_update_method_map(pTHX_ HV *const stash, HV *const map) +{ + char *method_name; + I32 method_name_len; + SV *method; + HV *symbols; + + symbols = mop_get_all_package_symbols(stash, TYPE_FILTER_CODE); + sv_2mortal((SV*)symbols); + + (void)hv_iterinit(map); + while ((method = hv_iternextsv(map, &method_name, &method_name_len))) { + SV *body; + SV *stash_slot; + + if (!SvROK(method)) { + continue; + } + + if (sv_isobject(method)) { + /* $method_object->body() */ + body = mop_call0(aTHX_ method, KEY_FOR(body)); + } + else { + body = method; + } + + stash_slot = *hv_fetch(symbols, method_name, method_name_len, TRUE); + if (SvROK(stash_slot) && ((CV*)SvRV(body)) == ((CV*)SvRV(stash_slot))) { + continue; + } + + /* delete $map->{$method_name} */ + (void)hv_delete(map, method_name, method_name_len, G_DISCARD); + } +} + +MODULE = Class::MOP::Mixin::HasMethods PACKAGE = Class::MOP::Mixin::HasMethods + +PROTOTYPES: DISABLE + +void +_method_map(self) + SV *self + PREINIT: + HV *const obj = (HV *)SvRV(self); + SV *const class_name = HeVAL( hv_fetch_ent(obj, KEY_FOR(package), 0, HASH_FOR(package)) ); + HV *const stash = gv_stashsv(class_name, 0); + UV current; + SV *cache_flag; + SV *map_ref; + PPCODE: + if (!stash) { + mXPUSHs(newRV_noinc((SV *)newHV())); + return; + } + + current = mop_check_package_cache_flag(aTHX_ stash); + cache_flag = HeVAL( hv_fetch_ent(obj, KEY_FOR(package_cache_flag), TRUE, HASH_FOR(package_cache_flag))); + map_ref = HeVAL( hv_fetch_ent(obj, KEY_FOR(methods), TRUE, HASH_FOR(methods))); + + /* $self->{methods} does not yet exist (or got deleted) */ + if ( !SvROK(map_ref) || SvTYPE(SvRV(map_ref)) != SVt_PVHV ) { + SV *new_map_ref = newRV_noinc((SV *)newHV()); + sv_2mortal(new_map_ref); + sv_setsv(map_ref, new_map_ref); + } + + if ( !SvOK(cache_flag) || SvUV(cache_flag) != current ) { + mop_update_method_map(aTHX_ stash, (HV *)SvRV(map_ref)); + sv_setuv(cache_flag, mop_check_package_cache_flag(aTHX_ stash)); /* update_cache_flag() */ + } + + XPUSHs(map_ref); + +BOOT: + mop_method_metaclass = newSVpvs("method_metaclass"); + mop_associated_metaclass = newSVpvs("associated_metaclass"); + mop_wrap = newSVpvs("wrap"); + INSTALL_SIMPLE_READER(Mixin::HasMethods, method_metaclass); + INSTALL_SIMPLE_READER(Mixin::HasMethods, wrapped_method_metaclass); diff --git a/xs/Inlined.xs b/xs/Inlined.xs new file mode 100644 index 0000000..a7f1f56 --- /dev/null +++ b/xs/Inlined.xs @@ -0,0 +1,8 @@ +#include "mop.h" + +MODULE = Class::MOP::Method::Inlined PACKAGE = Class::MOP::Method::Inlined + +PROTOTYPES: DISABLE + +BOOT: + INSTALL_SIMPLE_READER(Method::Inlined, _expected_method_class); diff --git a/xs/Instance.xs b/xs/Instance.xs new file mode 100644 index 0000000..944caed --- /dev/null +++ b/xs/Instance.xs @@ -0,0 +1,8 @@ +#include "mop.h" + +MODULE = Class::MOP::Instance PACKAGE = Class::MOP::Instance + +PROTOTYPES: DISABLE + +BOOT: + INSTALL_SIMPLE_READER(Instance, associated_metaclass); diff --git a/xs/MOP.xs b/xs/MOP.xs new file mode 100644 index 0000000..0bf05dc --- /dev/null +++ b/xs/MOP.xs @@ -0,0 +1,21 @@ +#include "mop.h" + +MODULE = Class::MOP PACKAGE = Class::MOP + +PROTOTYPES: DISABLE + +# use prototype here to be compatible with get_code_info from Sub::Identify +void +get_code_info(coderef) + SV *coderef + PROTOTYPE: $ + PREINIT: + char *pkg = NULL; + char *name = NULL; + PPCODE: + SvGETMAGIC(coderef); + if (mop_get_code_info(coderef, &pkg, &name)) { + EXTEND(SP, 2); + mPUSHs(newSVpv(pkg, 0)); + mPUSHs(newSVpv(name, 0)); + } diff --git a/xs/Method.xs b/xs/Method.xs new file mode 100644 index 0000000..5ffa467 --- /dev/null +++ b/xs/Method.xs @@ -0,0 +1,23 @@ +#include "mop.h" + +MODULE = Class::MOP::Method PACKAGE = Class::MOP::Method + +PROTOTYPES: DISABLE + +BOOT: + INSTALL_SIMPLE_READER(Method, name); + INSTALL_SIMPLE_READER(Method, package_name); + INSTALL_SIMPLE_READER(Method, body); + +bool +is_stub(self) + SV *self + + PREINIT: + CV *const body = (CV *)SvRV( HeVAL( hv_fetch_ent((HV *)SvRV(self), KEY_FOR(body), 0, HASH_FOR(body)) ) ); + + CODE: + RETVAL = !( CvISXSUB(body) || CvROOT(body) ); + + OUTPUT: + RETVAL diff --git a/xs/Moose.xs b/xs/Moose.xs new file mode 100644 index 0000000..22686cd --- /dev/null +++ b/xs/Moose.xs @@ -0,0 +1,170 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include "ppport.h" +#include "mop.h" + +#ifndef MGf_COPY +# define MGf_COPY 0 +#endif + +#ifndef MGf_DUP +# define MGf_DUP 0 +#endif + +#ifndef MGf_LOCAL +# define MGf_LOCAL 0 +#endif + +STATIC int unset_export_flag (pTHX_ SV *sv, MAGIC *mg); + +STATIC MGVTBL export_flag_vtbl = { + NULL, /* get */ + unset_export_flag, /* set */ + NULL, /* len */ + NULL, /* clear */ + NULL, /* free */ +#if MGf_COPY + NULL, /* copy */ +#endif +#if MGf_DUP + NULL, /* dup */ +#endif +#if MGf_LOCAL + NULL, /* local */ +#endif +}; + +STATIC bool +export_flag_is_set (pTHX_ SV *sv) +{ + MAGIC *mg, *moremagic; + + if (SvTYPE(SvRV(sv)) != SVt_PVGV) { + return 0; + } + + for (mg = SvMAGIC(SvRV(sv)); mg; mg = moremagic) { + moremagic = mg->mg_moremagic; + + if (mg->mg_type == PERL_MAGIC_ext && mg->mg_virtual == &export_flag_vtbl) { + break; + } + } + + return !!mg; +} + +STATIC int +unset_export_flag (pTHX_ SV *sv, MAGIC *mymg) +{ + MAGIC *mg, *prevmagic = NULL, *moremagic = NULL; + + for (mg = SvMAGIC(sv); mg; prevmagic = mg, mg = moremagic) { + moremagic = mg->mg_moremagic; + + if (mg == mymg) { + break; + } + } + + if (!mg) { + return 0; + } + + if (prevmagic) { + prevmagic->mg_moremagic = moremagic; + } + else { + SvMAGIC_set(sv, moremagic); + } + + mg->mg_moremagic = NULL; + + Safefree (mg); + + return 0; +} + +#ifndef SvRXOK +/* SvRXOK appeared before SVt_REGEXP did, so this implementation assumes magic + * based qr//. Note re::is_regexp isn't in 5.8, hence the need for this XS. + */ +#define SvRXOK(sv) is_regexp(aTHX_ sv) + +STATIC int +is_regexp (pTHX_ SV* sv) { + SV* tmpsv; + + if (SvMAGICAL(sv)) { + mg_get(sv); + } + + if (SvROK(sv) && + (tmpsv = (SV*) SvRV(sv)) && + SvTYPE(tmpsv) == SVt_PVMG && + (mg_find(tmpsv, PERL_MAGIC_qr))) { + return TRUE; + } + + return FALSE; +} +#endif + +XS_EXTERNAL(boot_Class__MOP); +XS_EXTERNAL(boot_Class__MOP__Mixin__HasAttributes); +XS_EXTERNAL(boot_Class__MOP__Mixin__HasMethods); +XS_EXTERNAL(boot_Class__MOP__Package); +XS_EXTERNAL(boot_Class__MOP__Mixin__AttributeCore); +XS_EXTERNAL(boot_Class__MOP__Method); +XS_EXTERNAL(boot_Class__MOP__Method__Inlined); +XS_EXTERNAL(boot_Class__MOP__Method__Generated); +XS_EXTERNAL(boot_Class__MOP__Class); +XS_EXTERNAL(boot_Class__MOP__Attribute); +XS_EXTERNAL(boot_Class__MOP__Instance); +XS_EXTERNAL(boot_Moose__Meta__Role__Application__ToInstance); + +MODULE = Moose PACKAGE = Moose::Exporter + +PROTOTYPES: DISABLE + +BOOT: + mop_prehash_keys(); + + MOP_CALL_BOOT (boot_Class__MOP); + MOP_CALL_BOOT (boot_Class__MOP__Mixin__HasAttributes); + MOP_CALL_BOOT (boot_Class__MOP__Mixin__HasMethods); + MOP_CALL_BOOT (boot_Class__MOP__Package); + MOP_CALL_BOOT (boot_Class__MOP__Mixin__AttributeCore); + MOP_CALL_BOOT (boot_Class__MOP__Method); + MOP_CALL_BOOT (boot_Class__MOP__Method__Inlined); + MOP_CALL_BOOT (boot_Class__MOP__Method__Generated); + MOP_CALL_BOOT (boot_Class__MOP__Class); + MOP_CALL_BOOT (boot_Class__MOP__Attribute); + MOP_CALL_BOOT (boot_Class__MOP__Instance); + MOP_CALL_BOOT (boot_Moose__Meta__Role__Application__ToInstance); + +void +_flag_as_reexport (SV *sv) + CODE: + sv_magicext(SvRV(sv), NULL, PERL_MAGIC_ext, &export_flag_vtbl, NULL, 0); + +bool +_export_is_flagged (SV *sv) + CODE: + RETVAL = export_flag_is_set(aTHX_ sv); + OUTPUT: + RETVAL + +MODULE = Moose PACKAGE = Moose::Util::TypeConstraints::Builtins + +bool +_RegexpRef (SV *sv=NULL) + INIT: + if (!items) { + sv = DEFSV; + } + CODE: + RETVAL = SvRXOK(sv); + OUTPUT: + RETVAL diff --git a/xs/Package.xs b/xs/Package.xs new file mode 100644 index 0000000..6c47099 --- /dev/null +++ b/xs/Package.xs @@ -0,0 +1,8 @@ +#include "mop.h" + +MODULE = Class::MOP::Package PACKAGE = Class::MOP::Package + +PROTOTYPES: DISABLE + +BOOT: + INSTALL_SIMPLE_READER_WITH_KEY(Package, name, package); diff --git a/xs/ToInstance.xs b/xs/ToInstance.xs new file mode 100644 index 0000000..044d2f3 --- /dev/null +++ b/xs/ToInstance.xs @@ -0,0 +1,63 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" + +static void +S_reset_amagic (pTHX_ SV *rv, const bool on) +{ + /* It is assumed that you've already turned magic on/off on rv */ + + SV *sva; + SV *const target = SvRV (rv); + + /* Less 1 for the reference we've already dealt with. */ + U32 how_many = SvREFCNT (target) - 1; + MAGIC *mg; + + if (SvMAGICAL (target) && (mg = mg_find (target, PERL_MAGIC_backref))) { + /* Back references also need to be found, but aren't part of the target's reference count. */ + how_many += 1 + av_len ((AV *)mg->mg_obj); + } + + if (!how_many) { + /* There was only 1 reference to this object. */ + return; + } + + for (sva = PL_sv_arenaroot; sva; sva = (SV *)SvANY (sva)) { + register const SV *const svend = &sva[SvREFCNT (sva)]; + register SV *sv; + for (sv = sva + 1; sv < svend; ++sv) { + if (SvTYPE (sv) != SVTYPEMASK + && ((sv->sv_flags & SVf_ROK) == SVf_ROK) + && SvREFCNT (sv) + && SvRV (sv) == target + && sv != rv) { + if (on) { + SvAMAGIC_on (sv); + } + else { + SvAMAGIC_off (sv); + } + + if (--how_many == 0) { + /* We have found them all. */ + return; + } + } + } + } +} + +MODULE = Moose::Meta::Role::Application::ToInstance PACKAGE = Moose::Meta::Role::Application::ToInstance + +PROTOTYPES: DISABLE + +void +_reset_amagic (rv) + SV *rv + CODE: + if (Gv_AMG (SvSTASH (SvRV (rv))) && !SvAMAGIC (rv)) { + SvAMAGIC_on (rv); + S_reset_amagic (aTHX_ rv, TRUE); + } diff --git a/xs/typemap b/xs/typemap new file mode 100644 index 0000000..7ab39e1 --- /dev/null +++ b/xs/typemap @@ -0,0 +1,17 @@ +type_filter_t T_TYPE_FILTER + +INPUT + +T_TYPE_FILTER + { + const char *__tMp = SvPV_nolen($arg); + switch (*__tMp) { + case 'C': $var = TYPE_FILTER_CODE; break; + case 'A': $var = TYPE_FILTER_ARRAY; break; + case 'I': $var = TYPE_FILTER_IO; break; + case 'H': $var = TYPE_FILTER_HASH; break; + case 'S': $var = TYPE_FILTER_SCALAR; break; + default: + croak(\"Unknown type %s\\n\", __tMp); + } + } |