summaryrefslogtreecommitdiff
path: root/universal.c
diff options
context:
space:
mode:
authorNicholas Clark <nick@ccl4.org>2010-01-05 13:06:52 +0000
committerNicholas Clark <nick@ccl4.org>2010-05-28 09:44:57 +0100
commiteff5b9d539e47421a784cb6a5fa9366c6522a4eb (patch)
tree20dc2eff31cd04ca658efe914ca4efd0da5d5b08 /universal.c
parentdc1f0c2041dab5a98af69338d1fa501b5e90ac70 (diff)
downloadperl-eff5b9d539e47421a784cb6a5fa9366c6522a4eb.tar.gz
InPerl_boot_core_UNIVERSAL() use a data structure for calls to newXS{,proto}
Replacing the longhand list of calls to newXS{,proto} with loop over a data structure reduces the object size by over 1K.
Diffstat (limited to 'universal.c')
-rw-r--r--universal.c199
1 files changed, 81 insertions, 118 deletions
diff --git a/universal.c b/universal.c
index 006baa2fed..79ff772747 100644
--- a/universal.c
+++ b/universal.c
@@ -208,124 +208,6 @@ Perl_sv_does(pTHX_ SV *sv, const char *const name)
return does_it;
}
-PERL_XS_EXPORT_C void XS_UNIVERSAL_isa(pTHX_ CV *cv);
-PERL_XS_EXPORT_C void XS_UNIVERSAL_can(pTHX_ CV *cv);
-PERL_XS_EXPORT_C void XS_UNIVERSAL_DOES(pTHX_ CV *cv);
-PERL_XS_EXPORT_C void XS_UNIVERSAL_VERSION(pTHX_ CV *cv);
-XS(XS_version_new);
-XS(XS_version_stringify);
-XS(XS_version_numify);
-XS(XS_version_normal);
-XS(XS_version_vcmp);
-XS(XS_version_boolean);
-#ifdef HASATTRIBUTE_NORETURN
-XS(XS_version_noop) __attribute__noreturn__;
-#else
-XS(XS_version_noop);
-#endif
-XS(XS_version_is_alpha);
-XS(XS_version_qv);
-XS(XS_version_is_qv);
-XS(XS_utf8_is_utf8);
-XS(XS_utf8_valid);
-XS(XS_utf8_encode);
-XS(XS_utf8_decode);
-XS(XS_utf8_upgrade);
-XS(XS_utf8_downgrade);
-XS(XS_utf8_unicode_to_native);
-XS(XS_utf8_native_to_unicode);
-XS(XS_Internals_SvREADONLY);
-XS(XS_Internals_SvREFCNT);
-XS(XS_Internals_hv_clear_placehold);
-XS(XS_PerlIO_get_layers);
-XS(XS_Internals_hash_seed);
-XS(XS_Internals_rehash_seed);
-XS(XS_Internals_HvREHASH);
-XS(XS_re_is_regexp);
-XS(XS_re_regname);
-XS(XS_re_regnames);
-XS(XS_re_regnames_count);
-XS(XS_re_regexp_pattern);
-XS(XS_Tie_Hash_NamedCapture_FETCH);
-XS(XS_Tie_Hash_NamedCapture_STORE);
-XS(XS_Tie_Hash_NamedCapture_DELETE);
-XS(XS_Tie_Hash_NamedCapture_CLEAR);
-XS(XS_Tie_Hash_NamedCapture_EXISTS);
-XS(XS_Tie_Hash_NamedCapture_FIRSTK);
-XS(XS_Tie_Hash_NamedCapture_NEXTK);
-XS(XS_Tie_Hash_NamedCapture_SCALAR);
-XS(XS_Tie_Hash_NamedCapture_flags);
-
-void
-Perl_boot_core_UNIVERSAL(pTHX)
-{
- dVAR;
- static const char file[] = __FILE__;
-
- newXS("UNIVERSAL::isa", XS_UNIVERSAL_isa, file);
- newXS("UNIVERSAL::can", XS_UNIVERSAL_can, file);
- newXS("UNIVERSAL::DOES", XS_UNIVERSAL_DOES, file);
- newXS("UNIVERSAL::VERSION", XS_UNIVERSAL_VERSION, file);
- {
- /* register the overloading (type 'A') magic */
- PL_amagic_generation++;
- /* Make it findable via fetchmethod */
- newXS("version::()", XS_version_noop, file);
- newXS("version::new", XS_version_new, file);
- newXS("version::parse", XS_version_new, file);
- newXS("version::(\"\"", XS_version_stringify, file);
- newXS("version::stringify", XS_version_stringify, file);
- newXS("version::(0+", XS_version_numify, file);
- newXS("version::numify", XS_version_numify, file);
- newXS("version::normal", XS_version_normal, file);
- newXS("version::(cmp", XS_version_vcmp, file);
- newXS("version::(<=>", XS_version_vcmp, file);
- newXS("version::vcmp", XS_version_vcmp, file);
- newXS("version::(bool", XS_version_boolean, file);
- newXS("version::boolean", XS_version_boolean, file);
- newXS("version::(nomethod", XS_version_noop, file);
- newXS("version::noop", XS_version_noop, file);
- newXS("version::is_alpha", XS_version_is_alpha, file);
- newXS("version::qv", XS_version_qv, file);
- newXS("version::declare", XS_version_qv, file);
- newXS("version::is_qv", XS_version_is_qv, file);
- }
- newXS("utf8::is_utf8", XS_utf8_is_utf8, file);
- newXS("utf8::valid", XS_utf8_valid, file);
- newXS("utf8::encode", XS_utf8_encode, file);
- newXS("utf8::decode", XS_utf8_decode, file);
- newXS("utf8::upgrade", XS_utf8_upgrade, file);
- newXS("utf8::downgrade", XS_utf8_downgrade, file);
- newXS("utf8::native_to_unicode", XS_utf8_native_to_unicode, file);
- newXS("utf8::unicode_to_native", XS_utf8_unicode_to_native, file);
- newXSproto("Internals::SvREADONLY",XS_Internals_SvREADONLY, file, "\\[$%@];$");
- newXSproto("Internals::SvREFCNT",XS_Internals_SvREFCNT, file, "\\[$%@];$");
- newXSproto("Internals::hv_clear_placeholders",
- XS_Internals_hv_clear_placehold, file, "\\%");
- newXSproto("PerlIO::get_layers",
- XS_PerlIO_get_layers, file, "*;@");
- /* Providing a Regexp::DESTROY fixes #21347. See test in t/op/ref.t */
- CvFILE(newCONSTSUB(get_hv("Regexp::", GV_ADD), "DESTROY", NULL))
- = (char *)file;
- newXSproto("Internals::hash_seed",XS_Internals_hash_seed, file, "");
- newXSproto("Internals::rehash_seed",XS_Internals_rehash_seed, file, "");
- newXSproto("Internals::HvREHASH", XS_Internals_HvREHASH, file, "\\%");
- newXSproto("re::is_regexp", XS_re_is_regexp, file, "$");
- newXSproto("re::regname", XS_re_regname, file, ";$$");
- newXSproto("re::regnames", XS_re_regnames, file, ";$");
- newXSproto("re::regnames_count", XS_re_regnames_count, file, "");
- newXSproto("re::regexp_pattern", XS_re_regexp_pattern, file, "$");
- newXS("Tie::Hash::NamedCapture::FETCH", XS_Tie_Hash_NamedCapture_FETCH, file);
- newXS("Tie::Hash::NamedCapture::STORE", XS_Tie_Hash_NamedCapture_STORE, file);
- newXS("Tie::Hash::NamedCapture::DELETE", XS_Tie_Hash_NamedCapture_DELETE, file);
- newXS("Tie::Hash::NamedCapture::CLEAR", XS_Tie_Hash_NamedCapture_CLEAR, file);
- newXS("Tie::Hash::NamedCapture::EXISTS", XS_Tie_Hash_NamedCapture_EXISTS, file);
- newXS("Tie::Hash::NamedCapture::FIRSTKEY", XS_Tie_Hash_NamedCapture_FIRSTK, file);
- newXS("Tie::Hash::NamedCapture::NEXTKEY", XS_Tie_Hash_NamedCapture_NEXTK, file);
- newXS("Tie::Hash::NamedCapture::SCALAR", XS_Tie_Hash_NamedCapture_SCALAR, file);
- newXS("Tie::Hash::NamedCapture::flags", XS_Tie_Hash_NamedCapture_flags, file);
-}
-
/*
=for apidoc croak_xs_usage
@@ -1589,6 +1471,87 @@ XS(XS_Tie_Hash_NamedCapture_flags)
return;
}
+struct xsub_details {
+ const char *name;
+ XSUBADDR_t xsub;
+ const char *proto;
+};
+
+struct xsub_details details[] = {
+ {"UNIVERSAL::isa", XS_UNIVERSAL_isa, NULL},
+ {"UNIVERSAL::can", XS_UNIVERSAL_can, NULL},
+ {"UNIVERSAL::DOES", XS_UNIVERSAL_DOES, NULL},
+ {"UNIVERSAL::VERSION", XS_UNIVERSAL_VERSION, NULL},
+ {"version::()", XS_version_noop, NULL},
+ {"version::new", XS_version_new, NULL},
+ {"version::parse", XS_version_new, NULL},
+ {"version::(\"\"", XS_version_stringify, NULL},
+ {"version::stringify", XS_version_stringify, NULL},
+ {"version::(0+", XS_version_numify, NULL},
+ {"version::numify", XS_version_numify, NULL},
+ {"version::normal", XS_version_normal, NULL},
+ {"version::(cmp", XS_version_vcmp, NULL},
+ {"version::(<=>", XS_version_vcmp, NULL},
+ {"version::vcmp", XS_version_vcmp, NULL},
+ {"version::(bool", XS_version_boolean, NULL},
+ {"version::boolean", XS_version_boolean, NULL},
+ {"version::(nomethod", XS_version_noop, NULL},
+ {"version::noop", XS_version_noop, NULL},
+ {"version::is_alpha", XS_version_is_alpha, NULL},
+ {"version::qv", XS_version_qv, NULL},
+ {"version::declare", XS_version_qv, NULL},
+ {"version::is_qv", XS_version_is_qv, NULL},
+ {"utf8::is_utf8", XS_utf8_is_utf8, NULL},
+ {"utf8::valid", XS_utf8_valid, NULL},
+ {"utf8::encode", XS_utf8_encode, NULL},
+ {"utf8::decode", XS_utf8_decode, NULL},
+ {"utf8::upgrade", XS_utf8_upgrade, NULL},
+ {"utf8::downgrade", XS_utf8_downgrade, NULL},
+ {"utf8::native_to_unicode", XS_utf8_native_to_unicode, NULL},
+ {"utf8::unicode_to_native", XS_utf8_unicode_to_native, NULL},
+ {"Internals::SvREADONLY", XS_Internals_SvREADONLY, "\\[$%@];$"},
+ {"Internals::SvREFCNT", XS_Internals_SvREFCNT, "\\[$%@];$"},
+ {"Internals::hv_clear_placeholders", XS_Internals_hv_clear_placehold, "\\%"},
+ {"PerlIO::get_layers", XS_PerlIO_get_layers, "*;@"},
+ {"Internals::hash_seed", XS_Internals_hash_seed, ""},
+ {"Internals::rehash_seed", XS_Internals_rehash_seed, ""},
+ {"Internals::HvREHASH", XS_Internals_HvREHASH, "\\%"},
+ {"re::is_regexp", XS_re_is_regexp, "$"},
+ {"re::regname", XS_re_regname, ";$$"},
+ {"re::regnames", XS_re_regnames, ";$"},
+ {"re::regnames_count", XS_re_regnames_count, ""},
+ {"re::regexp_pattern", XS_re_regexp_pattern, "$"},
+ {"Tie::Hash::NamedCapture::FETCH", XS_Tie_Hash_NamedCapture_FETCH, NULL},
+ {"Tie::Hash::NamedCapture::STORE", XS_Tie_Hash_NamedCapture_STORE, NULL},
+ {"Tie::Hash::NamedCapture::DELETE", XS_Tie_Hash_NamedCapture_DELETE, NULL},
+ {"Tie::Hash::NamedCapture::CLEAR", XS_Tie_Hash_NamedCapture_CLEAR, NULL},
+ {"Tie::Hash::NamedCapture::EXISTS", XS_Tie_Hash_NamedCapture_EXISTS, NULL},
+ {"Tie::Hash::NamedCapture::FIRSTKEY", XS_Tie_Hash_NamedCapture_FIRSTK, NULL},
+ {"Tie::Hash::NamedCapture::NEXTKEY", XS_Tie_Hash_NamedCapture_NEXTK, NULL},
+ {"Tie::Hash::NamedCapture::SCALAR", XS_Tie_Hash_NamedCapture_SCALAR, NULL},
+ {"Tie::Hash::NamedCapture::flags", XS_Tie_Hash_NamedCapture_flags, NULL}
+};
+
+void
+Perl_boot_core_UNIVERSAL(pTHX)
+{
+ dVAR;
+ static const char file[] = __FILE__;
+ struct xsub_details *xsub = details;
+ const struct xsub_details *end
+ = details + sizeof(details) / sizeof(details[0]);
+
+ do {
+ newXS_flags(xsub->name, xsub->xsub, file, xsub->proto, 0);
+ } while (++xsub < end);
+
+ /* register the overloading (type 'A') magic */
+ PL_amagic_generation++;
+
+ /* Providing a Regexp::DESTROY fixes #21347. See test in t/op/ref.t */
+ CvFILE(newCONSTSUB(get_hv("Regexp::", GV_ADD), "DESTROY", NULL))
+ = (char *)file;
+}
/*
* Local variables: