3 * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
4 * 2005, 2006, 2007, 2008 by Larry Wall and others
6 * You may distribute under the terms of either the GNU General Public
7 * License or the Artistic License, as specified in the README file.
12 * '"The roots of those mountains must be roots indeed; there must be
13 * great secrets buried there which have not been discovered since the
14 * beginning."' --Gandalf, relating Gollum's history
16 * [p.54 of _The Lord of the Rings_, I/ii: "The Shadow of the Past"]
19 /* This file contains the code that implements the functions in Perl's
20 * UNIVERSAL package, such as UNIVERSAL->can().
22 * It is also used to store XS functions that need to be present in
23 * miniperl for a lack of a better place to put them. It might be
24 * clever to move them to separate XS files which would then be pulled
25 * in by some to-be-written build process.
29 #define PERL_IN_UNIVERSAL_C
33 #include "perliol.h" /* For the PERLIO_F_XXX */
37 * Contributed by Graham Barr <Graham.Barr@tiuk.ti.com>
38 * The main guts of traverse_isa was actually copied from gv_fetchmeth
42 S_isa_lookup(pTHX_ HV *stash, const char * const name)
45 const struct mro_meta *const meta = HvMROMETA(stash);
47 STRLEN len = strlen(name);
50 PERL_ARGS_ASSERT_ISA_LOOKUP;
53 (void)mro_get_linear_isa(stash);
57 if (hv_common(isa, NULL, name, len, 0 /* No "UTF-8" flag possible with only
59 HV_FETCH_ISEXISTS, NULL, 0)) {
60 /* Direct name lookup worked. */
64 /* A stash/class can go by many names (ie. User == main::User), so
65 we use the HvENAME in the stash itself, which is canonical, falling
66 back to HvNAME if necessary. */
67 our_stash = gv_stashpvn(name, len, 0);
70 HEK *canon_name = HvENAME_HEK(our_stash);
71 if (!canon_name) canon_name = HvNAME_HEK(our_stash);
73 if (hv_common(isa, NULL, HEK_KEY(canon_name), HEK_LEN(canon_name),
74 HEK_FLAGS(canon_name),
75 HV_FETCH_ISEXISTS, NULL, HEK_HASH(canon_name))) {
84 =head1 SV Manipulation Functions
86 =for apidoc sv_derived_from
88 Returns a boolean indicating whether the SV is derived from the specified class
89 I<at the C level>. To check derivation at the Perl level, call C<isa()> as a
96 Perl_sv_derived_from(pTHX_ SV *sv, const char *const name)
101 PERL_ARGS_ASSERT_SV_DERIVED_FROM;
108 type = sv_reftype(sv,0);
109 if (type && strEQ(type,name))
111 stash = SvOBJECT(sv) ? SvSTASH(sv) : NULL;
114 stash = gv_stashsv(sv, 0);
117 return stash ? isa_lookup(stash, name) : FALSE;
123 Returns a boolean indicating whether the SV performs a specific, named role.
124 The SV can be a Perl object or the name of a Perl class.
132 Perl_sv_does(pTHX_ SV *sv, const char *const name)
134 const char *classname;
139 PERL_ARGS_ASSERT_SV_DOES;
146 if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
147 || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv)))) {
152 if (sv_isobject(sv)) {
153 classname = sv_reftype(SvRV(sv),TRUE);
155 classname = SvPV_nolen(sv);
158 if (strEQ(name,classname)) {
165 mXPUSHs(newSVpv(name, 0));
168 methodname = newSVpvs_flags("isa", SVs_TEMP);
169 /* ugly hack: use the SvSCREAM flag so S_method_common
170 * can figure out we're calling DOES() and not isa(),
171 * and report eventual errors correctly. --rgs */
172 SvSCREAM_on(methodname);
173 call_sv(methodname, G_SCALAR | G_METHOD);
176 does_it = SvTRUE( TOPs );
184 =for apidoc croak_xs_usage
186 A specialised variant of C<croak()> for emitting the usage message for xsubs
188 croak_xs_usage(cv, "eee_yow");
190 works out the package name and subroutine name from C<cv>, and then calls
191 C<croak()>. Hence if C<cv> is C<&ouch::awk>, it would call C<croak> as:
193 Perl_croak(aTHX_ "Usage: %s::%s(%s)", "ouch" "awk", "eee_yow");
199 Perl_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
201 const GV *const gv = CvGV(cv);
203 PERL_ARGS_ASSERT_CROAK_XS_USAGE;
206 const char *const gvname = GvNAME(gv);
207 const HV *const stash = GvSTASH(gv);
208 const char *const hvname = stash ? HvNAME_get(stash) : NULL;
211 Perl_croak(aTHX_ "Usage: %s::%s(%s)", hvname, gvname, params);
213 Perl_croak(aTHX_ "Usage: %s(%s)", gvname, params);
215 /* Pants. I don't think that it should be possible to get here. */
216 Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
226 croak_xs_usage(cv, "reference, kind");
228 SV * const sv = ST(0);
233 if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
234 || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
237 name = SvPV_nolen_const(ST(1));
239 ST(0) = boolSV(sv_derived_from(sv, name));
254 croak_xs_usage(cv, "object-ref, method");
260 if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
261 || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
264 name = SvPV_nolen_const(ST(1));
268 sv = MUTABLE_SV(SvRV(sv));
273 pkg = gv_stashsv(sv, 0);
277 GV * const gv = gv_fetchmethod_autoload(pkg, name, FALSE);
279 rv = sv_2mortal(newRV(MUTABLE_SV(GvCV(gv))));
286 XS(XS_UNIVERSAL_DOES)
293 Perl_croak(aTHX_ "Usage: invocant->DOES(kind)");
295 SV * const sv = ST(0);
298 name = SvPV_nolen_const(ST(1));
299 if (sv_does( sv, name ))
306 XS(XS_UNIVERSAL_VERSION)
319 sv = MUTABLE_SV(SvRV(ST(0)));
321 Perl_croak(aTHX_ "Cannot find version of an unblessed reference");
325 pkg = gv_stashsv(ST(0), 0);
328 gvp = pkg ? (GV**)hv_fetchs(pkg, "VERSION", FALSE) : NULL;
330 if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
331 ret = sv_newmortal();
336 sv = ret = &PL_sv_undef;
345 const char * const name = HvNAME_get(pkg);
347 "%s does not define $%s::VERSION--version check failed",
351 "%s defines neither package nor VERSION--version check failed",
352 SvPVx_nolen_const(ST(0)) );
356 if ( !sv_derived_from(sv, "version"))
357 upg_version(sv, FALSE);
359 if ( !sv_derived_from(req, "version")) {
360 /* req may very well be R/O, so create a new object */
361 req = sv_2mortal( new_version(req) );
364 if ( vcmp( req, sv ) > 0 ) {
365 if ( hv_exists(MUTABLE_HV(SvRV(req)), "qv", 2 ) ) {
366 Perl_croak(aTHX_ "%s version %"SVf" required--"
367 "this is only version %"SVf"", HvNAME_get(pkg),
368 SVfARG(sv_2mortal(vnormal(req))),
369 SVfARG(sv_2mortal(vnormal(sv))));
371 Perl_croak(aTHX_ "%s version %"SVf" required--"
372 "this is only version %"SVf"", HvNAME_get(pkg),
373 SVfARG(sv_2mortal(vstringify(req))),
374 SVfARG(sv_2mortal(vstringify(sv))));
390 croak_xs_usage(cv, "class, version");
395 const char * const classname =
396 sv_isobject(ST(0)) /* get the class if called as an object method */
397 ? HvNAME(SvSTASH(SvRV(ST(0))))
398 : (char *)SvPV_nolen(ST(0));
400 if ( items == 1 || ! SvOK(vs) ) { /* no param or explicit undef */
401 /* create empty object */
405 else if ( items == 3 ) {
407 Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(ST(2)));
410 rv = new_version(vs);
411 if ( strcmp(classname,"version") != 0 ) /* inherited new() */
412 sv_bless(rv, gv_stashpv(classname, GV_ADD));
420 XS(XS_version_stringify)
425 croak_xs_usage(cv, "lobj, ...");
430 if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
434 Perl_croak(aTHX_ "lobj is not of type version");
436 mPUSHs(vstringify(lobj));
443 XS(XS_version_numify)
448 croak_xs_usage(cv, "lobj, ...");
453 if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
457 Perl_croak(aTHX_ "lobj is not of type version");
459 mPUSHs(vnumify(lobj));
466 XS(XS_version_normal)
471 croak_xs_usage(cv, "lobj, ...");
476 if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
480 Perl_croak(aTHX_ "lobj is not of type version");
482 mPUSHs(vnormal(lobj));
494 croak_xs_usage(cv, "lobj, ...");
499 if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
503 Perl_croak(aTHX_ "lobj is not of type version");
509 const IV swap = (IV)SvIV(ST(2));
511 if ( ! sv_derived_from(robj, "version") )
513 robj = new_version(SvOK(robj) ? robj : newSVpvs_flags("0", SVs_TEMP));
520 rs = newSViv(vcmp(rvs,lobj));
524 rs = newSViv(vcmp(lobj,rvs));
535 XS(XS_version_boolean)
540 croak_xs_usage(cv, "lobj, ...");
542 if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
543 SV * const lobj = SvRV(ST(0));
544 SV * const rs = newSViv( vcmp(lobj,new_version(newSVpvs("0"))) );
550 Perl_croak(aTHX_ "lobj is not of type version");
558 croak_xs_usage(cv, "lobj, ...");
559 if (sv_derived_from(ST(0), "version") && SvROK(ST(0)))
560 Perl_croak(aTHX_ "operation not supported with version object");
562 Perl_croak(aTHX_ "lobj is not of type version");
563 #ifndef HASATTRIBUTE_NORETURN
568 XS(XS_version_is_alpha)
573 croak_xs_usage(cv, "lobj");
575 if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
576 SV * const lobj = ST(0);
577 if ( hv_exists(MUTABLE_HV(SvRV(lobj)), "alpha", 5 ) )
585 Perl_croak(aTHX_ "lobj is not of type version");
597 const char * classname = "";
598 if ( items == 2 && SvOK(ST(1)) ) {
599 /* getting called as object or class method */
602 sv_isobject(ST(0)) /* class called as an object method */
603 ? HvNAME_get(SvSTASH(SvRV(ST(0))))
604 : (char *)SvPV_nolen(ST(0));
606 if ( !SvVOK(ver) ) { /* not already a v-string */
608 sv_setsv(rv,ver); /* make a duplicate */
609 upg_version(rv, TRUE);
611 rv = sv_2mortal(new_version(ver));
613 if ( items == 2 && strcmp(classname,"version") ) { /* inherited new() */
614 sv_bless(rv, gv_stashpv(classname, GV_ADD));
627 croak_xs_usage(cv, "lobj");
629 if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
630 SV * const lobj = ST(0);
631 if ( hv_exists(MUTABLE_HV(SvRV(lobj)), "qv", 2 ) )
639 Perl_croak(aTHX_ "lobj is not of type version");
647 croak_xs_usage(cv, "sv");
649 SV * const sv = ST(0);
664 croak_xs_usage(cv, "sv");
666 SV * const sv = ST(0);
668 const char * const s = SvPV_const(sv,len);
669 if (!SvUTF8(sv) || is_utf8_string((const U8*)s,len))
682 croak_xs_usage(cv, "sv");
683 sv_utf8_encode(ST(0));
692 croak_xs_usage(cv, "sv");
694 SV * const sv = ST(0);
696 if (SvIsCOW(sv)) sv_force_normal(sv);
697 RETVAL = sv_utf8_decode(sv);
698 ST(0) = boolSV(RETVAL);
708 croak_xs_usage(cv, "sv");
710 SV * const sv = ST(0);
714 RETVAL = sv_utf8_upgrade(sv);
715 XSprePUSH; PUSHi((IV)RETVAL);
720 XS(XS_utf8_downgrade)
724 if (items < 1 || items > 2)
725 croak_xs_usage(cv, "sv, failok=0");
727 SV * const sv = ST(0);
728 const bool failok = (items < 2) ? 0 : (int)SvIV(ST(1));
729 const bool RETVAL = sv_utf8_downgrade(sv, failok);
731 ST(0) = boolSV(RETVAL);
736 XS(XS_utf8_native_to_unicode)
740 const UV uv = SvUV(ST(0));
743 croak_xs_usage(cv, "sv");
745 ST(0) = sv_2mortal(newSViv(NATIVE_TO_UNI(uv)));
749 XS(XS_utf8_unicode_to_native)
753 const UV uv = SvUV(ST(0));
756 croak_xs_usage(cv, "sv");
758 ST(0) = sv_2mortal(newSViv(UNI_TO_NATIVE(uv)));
762 XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */
766 SV * const svz = ST(0);
770 /* [perl #77776] - called as &foo() not foo() */
772 croak_xs_usage(cv, "SCALAR[, ON]");
777 if (SvREADONLY(sv) && !SvIsCOW(sv))
782 else if (items == 2) {
784 if (SvIsCOW(sv)) sv_force_normal(sv);
789 /* I hope you really know what you are doing. */
790 if (!SvIsCOW(sv)) SvREADONLY_off(sv);
794 XSRETURN_UNDEF; /* Can't happen. */
797 XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */
801 SV * const svz = ST(0);
805 /* [perl #77776] - called as &foo() not foo() */
807 croak_xs_usage(cv, "SCALAR[, REFCOUNT]");
812 XSRETURN_IV(SvREFCNT(sv) - 1); /* Minus the ref created for us. */
813 else if (items == 2) {
814 /* I hope you really know what you are doing. */
815 SvREFCNT(sv) = SvIV(ST(1));
816 XSRETURN_IV(SvREFCNT(sv));
818 XSRETURN_UNDEF; /* Can't happen. */
821 XS(XS_Internals_hv_clear_placehold)
826 if (items != 1 || !SvROK(ST(0)))
827 croak_xs_usage(cv, "hv");
829 HV * const hv = MUTABLE_HV(SvRV(ST(0)));
830 hv_clear_placeholders(hv);
835 XS(XS_PerlIO_get_layers)
839 if (items < 1 || items % 2 == 0)
840 croak_xs_usage(cv, "filehandle[,args]");
847 bool details = FALSE;
851 for (svp = MARK + 2; svp <= SP; svp += 2) {
852 SV * const * const varp = svp;
853 SV * const * const valp = svp + 1;
855 const char * const key = SvPV_const(*varp, klen);
859 if (klen == 5 && memEQ(key, "input", 5)) {
860 input = SvTRUE(*valp);
865 if (klen == 6 && memEQ(key, "output", 6)) {
866 input = !SvTRUE(*valp);
871 if (klen == 7 && memEQ(key, "details", 7)) {
872 details = SvTRUE(*valp);
879 "get_layers: unknown argument '%s'",
891 if (SvROK(sv) && isGV(SvRV(sv)))
892 gv = MUTABLE_GV(SvRV(sv));
894 gv = gv_fetchsv(sv, 0, SVt_PVIO);
897 if (gv && (io = GvIO(gv))) {
898 AV* const av = PerlIO_get_layers(aTHX_ input ?
899 IoIFP(io) : IoOFP(io));
901 const I32 last = av_len(av);
904 for (i = last; i >= 0; i -= 3) {
905 SV * const * const namsvp = av_fetch(av, i - 2, FALSE);
906 SV * const * const argsvp = av_fetch(av, i - 1, FALSE);
907 SV * const * const flgsvp = av_fetch(av, i, FALSE);
909 const bool namok = namsvp && *namsvp && SvPOK(*namsvp);
910 const bool argok = argsvp && *argsvp && SvPOK(*argsvp);
911 const bool flgok = flgsvp && *flgsvp && SvIOK(*flgsvp);
914 /* Indents of 5? Yuck. */
915 /* We know that PerlIO_get_layers creates a new SV for
916 the name and flags, so we can just take a reference
917 and "steal" it when we free the AV below. */
919 ? sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp))
922 ? newSVpvn_flags(SvPVX_const(*argsvp),
924 (SvUTF8(*argsvp) ? SVf_UTF8 : 0)
928 ? sv_2mortal(SvREFCNT_inc_simple_NN(*flgsvp))
934 XPUSHs(sv_2mortal(Perl_newSVpvf(aTHX_ "%"SVf"(%"SVf")",
938 XPUSHs(sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp)));
940 XPUSHs(&PL_sv_undef);
943 const IV flags = SvIVX(*flgsvp);
945 if (flags & PERLIO_F_UTF8) {
946 XPUSHs(newSVpvs_flags("utf8", SVs_TEMP));
963 XS(XS_Internals_hash_seed)
966 /* Using dXSARGS would also have dITEM and dSP,
967 * which define 2 unused local variables. */
970 PERL_UNUSED_VAR(mark);
971 XSRETURN_UV(PERL_HASH_SEED);
974 XS(XS_Internals_rehash_seed)
977 /* Using dXSARGS would also have dITEM and dSP,
978 * which define 2 unused local variables. */
981 PERL_UNUSED_VAR(mark);
982 XSRETURN_UV(PL_rehash_seed);
985 XS(XS_Internals_HvREHASH) /* Subject to change */
991 const HV * const hv = (const HV *) SvRV(ST(0));
992 if (items == 1 && SvTYPE(hv) == SVt_PVHV) {
999 Perl_croak(aTHX_ "Internals::HvREHASH $hashref");
1006 PERL_UNUSED_VAR(cv);
1009 croak_xs_usage(cv, "sv");
1011 if (SvRXOK(ST(0))) {
1018 XS(XS_re_regnames_count)
1020 REGEXP *rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
1026 croak_xs_usage(cv, "");
1034 ret = CALLREG_NAMED_BUFF_COUNT(rx);
1037 PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);
1049 if (items < 1 || items > 2)
1050 croak_xs_usage(cv, "name[, all ]");
1055 rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
1060 if (items == 2 && SvTRUE(ST(1))) {
1065 ret = CALLREG_NAMED_BUFF_FETCH(rx, ST(0), (flags | RXapif_REGNAME));
1068 PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);
1086 croak_xs_usage(cv, "[all]");
1088 rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
1093 if (items == 1 && SvTRUE(ST(0))) {
1102 ret = CALLREG_NAMED_BUFF_ALL(rx, (flags | RXapif_REGNAMES));
1109 av = MUTABLE_AV(SvRV(ret));
1110 length = av_len(av);
1112 for (i = 0; i <= length; i++) {
1113 entry = av_fetch(av, i, FALSE);
1116 Perl_croak(aTHX_ "NULL array element in re::regnames()");
1118 mXPUSHs(SvREFCNT_inc_simple_NN(*entry));
1127 XS(XS_re_regexp_pattern)
1134 croak_xs_usage(cv, "sv");
1139 Checks if a reference is a regex or not. If the parameter is
1140 not a ref, or is not the result of a qr// then returns false
1141 in scalar context and an empty list in list context.
1142 Otherwise in list context it returns the pattern and the
1143 modifiers, in scalar context it returns the pattern just as it
1144 would if the qr// was stringified normally, regardless as
1145 to the class of the variable and any stringification overloads
1149 if ((re = SvRX(ST(0)))) /* assign deliberate */
1151 /* Houston, we have a regex! */
1154 if ( GIMME_V == G_ARRAY ) {
1156 char reflags[sizeof(INT_PAT_MODS) + MAX_CHARSET_NAME_LENGTH];
1162 we are in list context so stringify
1163 the modifiers that apply. We ignore "negative
1164 modifiers" in this scenario, and the default character set
1167 if (get_regex_charset(RX_EXTFLAGS(re)) != REGEX_DEPENDS_CHARSET) {
1169 const char* const name = get_regex_charset_name(RX_EXTFLAGS(re),
1171 Copy(name, reflags + left, len, char);
1174 fptr = INT_PAT_MODS;
1175 match_flags = (U16)((RX_EXTFLAGS(re) & RXf_PMf_COMPILETIME)
1176 >> RXf_PMf_STD_PMMOD_SHIFT);
1178 while((ch = *fptr++)) {
1179 if(match_flags & 1) {
1180 reflags[left++] = ch;
1185 pattern = newSVpvn_flags(RX_PRECOMP(re),RX_PRELEN(re),
1186 (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP);
1188 /* return the pattern and the modifiers */
1190 XPUSHs(newSVpvn_flags(reflags, left, SVs_TEMP));
1193 /* Scalar, so use the string that Perl would return */
1194 /* return the pattern in (?msix:..) format */
1195 #if PERL_VERSION >= 11
1196 pattern = sv_2mortal(newSVsv(MUTABLE_SV(re)));
1198 pattern = newSVpvn_flags(RX_WRAPPED(re), RX_WRAPLEN(re),
1199 (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP);
1205 /* It ain't a regexp folks */
1206 if ( GIMME_V == G_ARRAY ) {
1207 /* return the empty list */
1210 /* Because of the (?:..) wrapping involved in a
1211 stringified pattern it is impossible to get a
1212 result for a real regexp that would evaluate to
1213 false. Therefore we can return PL_sv_no to signify
1214 that the object is not a regex, this means that one
1217 if (regex($might_be_a_regex) eq '(?:foo)') { }
1219 and not worry about undefined values.
1227 struct xsub_details {
1233 struct xsub_details details[] = {
1234 {"UNIVERSAL::isa", XS_UNIVERSAL_isa, NULL},
1235 {"UNIVERSAL::can", XS_UNIVERSAL_can, NULL},
1236 {"UNIVERSAL::DOES", XS_UNIVERSAL_DOES, NULL},
1237 {"UNIVERSAL::VERSION", XS_UNIVERSAL_VERSION, NULL},
1238 {"version::()", XS_version_noop, NULL},
1239 {"version::new", XS_version_new, NULL},
1240 {"version::parse", XS_version_new, NULL},
1241 {"version::(\"\"", XS_version_stringify, NULL},
1242 {"version::stringify", XS_version_stringify, NULL},
1243 {"version::(0+", XS_version_numify, NULL},
1244 {"version::numify", XS_version_numify, NULL},
1245 {"version::normal", XS_version_normal, NULL},
1246 {"version::(cmp", XS_version_vcmp, NULL},
1247 {"version::(<=>", XS_version_vcmp, NULL},
1248 {"version::vcmp", XS_version_vcmp, NULL},
1249 {"version::(bool", XS_version_boolean, NULL},
1250 {"version::boolean", XS_version_boolean, NULL},
1251 {"version::(nomethod", XS_version_noop, NULL},
1252 {"version::noop", XS_version_noop, NULL},
1253 {"version::is_alpha", XS_version_is_alpha, NULL},
1254 {"version::qv", XS_version_qv, NULL},
1255 {"version::declare", XS_version_qv, NULL},
1256 {"version::is_qv", XS_version_is_qv, NULL},
1257 {"utf8::is_utf8", XS_utf8_is_utf8, NULL},
1258 {"utf8::valid", XS_utf8_valid, NULL},
1259 {"utf8::encode", XS_utf8_encode, NULL},
1260 {"utf8::decode", XS_utf8_decode, NULL},
1261 {"utf8::upgrade", XS_utf8_upgrade, NULL},
1262 {"utf8::downgrade", XS_utf8_downgrade, NULL},
1263 {"utf8::native_to_unicode", XS_utf8_native_to_unicode, NULL},
1264 {"utf8::unicode_to_native", XS_utf8_unicode_to_native, NULL},
1265 {"Internals::SvREADONLY", XS_Internals_SvREADONLY, "\\[$%@];$"},
1266 {"Internals::SvREFCNT", XS_Internals_SvREFCNT, "\\[$%@];$"},
1267 {"Internals::hv_clear_placeholders", XS_Internals_hv_clear_placehold, "\\%"},
1268 {"PerlIO::get_layers", XS_PerlIO_get_layers, "*;@"},
1269 {"Internals::hash_seed", XS_Internals_hash_seed, ""},
1270 {"Internals::rehash_seed", XS_Internals_rehash_seed, ""},
1271 {"Internals::HvREHASH", XS_Internals_HvREHASH, "\\%"},
1272 {"re::is_regexp", XS_re_is_regexp, "$"},
1273 {"re::regname", XS_re_regname, ";$$"},
1274 {"re::regnames", XS_re_regnames, ";$"},
1275 {"re::regnames_count", XS_re_regnames_count, ""},
1276 {"re::regexp_pattern", XS_re_regexp_pattern, "$"},
1280 Perl_boot_core_UNIVERSAL(pTHX)
1283 static const char file[] = __FILE__;
1284 struct xsub_details *xsub = details;
1285 const struct xsub_details *end
1286 = details + sizeof(details) / sizeof(details[0]);
1289 newXS_flags(xsub->name, xsub->xsub, file, xsub->proto, 0);
1290 } while (++xsub < end);
1292 /* register the overloading (type 'A') magic */
1293 PL_amagic_generation++;
1295 /* Providing a Regexp::DESTROY fixes #21347. See test in t/op/ref.t */
1298 newCONSTSUB(get_hv("Regexp::", GV_ADD), "DESTROY", NULL);
1299 Safefree(CvFILE(cv));
1300 CvFILE(cv) = (char *)file;
1307 * c-indentation-style: bsd
1309 * indent-tabs-mode: t
1312 * ex: set ts=8 sts=4 sw=4 noet: