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)
318 sv = MUTABLE_SV(SvRV(ST(0)));
320 Perl_croak(aTHX_ "Cannot find version of an unblessed reference");
324 pkg = gv_stashsv(ST(0), 0);
327 gvp = pkg ? (GV**)hv_fetchs(pkg, "VERSION", FALSE) : NULL;
329 if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
330 SV * const nsv = sv_newmortal();
333 if ( !sv_derived_from(sv, "version"))
334 upg_version(sv, FALSE);
347 const char * const name = HvNAME_get(pkg);
349 "%s does not define $%s::VERSION--version check failed",
353 "%s defines neither package nor VERSION--version check failed",
354 SvPVx_nolen_const(ST(0)) );
358 if ( !sv_derived_from(req, "version")) {
359 /* req may very well be R/O, so create a new object */
360 req = sv_2mortal( new_version(req) );
363 if ( vcmp( req, sv ) > 0 ) {
364 if ( hv_exists(MUTABLE_HV(SvRV(req)), "qv", 2 ) ) {
365 Perl_croak(aTHX_ "%s version %"SVf" required--"
366 "this is only version %"SVf"", HvNAME_get(pkg),
367 SVfARG(sv_2mortal(vnormal(req))),
368 SVfARG(sv_2mortal(vnormal(sv))));
370 Perl_croak(aTHX_ "%s version %"SVf" required--"
371 "this is only version %"SVf"", HvNAME_get(pkg),
372 SVfARG(sv_2mortal(vstringify(req))),
373 SVfARG(sv_2mortal(vstringify(sv))));
379 if ( SvOK(sv) && sv_derived_from(sv, "version") ) {
380 ST(0) = sv_2mortal(vstringify(sv));
393 croak_xs_usage(cv, "class, version");
398 const char * const classname =
399 sv_isobject(ST(0)) /* get the class if called as an object method */
400 ? HvNAME(SvSTASH(SvRV(ST(0))))
401 : (char *)SvPV_nolen(ST(0));
403 if ( items == 1 || ! SvOK(vs) ) { /* no param or explicit undef */
404 /* create empty object */
408 else if ( items == 3 ) {
410 Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(ST(2)));
413 rv = new_version(vs);
414 if ( strcmp(classname,"version") != 0 ) /* inherited new() */
415 sv_bless(rv, gv_stashpv(classname, GV_ADD));
423 XS(XS_version_stringify)
428 croak_xs_usage(cv, "lobj, ...");
433 if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
437 Perl_croak(aTHX_ "lobj is not of type version");
439 mPUSHs(vstringify(lobj));
446 XS(XS_version_numify)
451 croak_xs_usage(cv, "lobj, ...");
456 if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
460 Perl_croak(aTHX_ "lobj is not of type version");
462 mPUSHs(vnumify(lobj));
469 XS(XS_version_normal)
474 croak_xs_usage(cv, "lobj, ...");
479 if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
483 Perl_croak(aTHX_ "lobj is not of type version");
485 mPUSHs(vnormal(lobj));
497 croak_xs_usage(cv, "lobj, ...");
502 if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
506 Perl_croak(aTHX_ "lobj is not of type version");
512 const IV swap = (IV)SvIV(ST(2));
514 if ( ! sv_derived_from(robj, "version") )
516 robj = new_version(SvOK(robj) ? robj : newSVpvs_flags("0", SVs_TEMP));
523 rs = newSViv(vcmp(rvs,lobj));
527 rs = newSViv(vcmp(lobj,rvs));
538 XS(XS_version_boolean)
543 croak_xs_usage(cv, "lobj, ...");
545 if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
546 SV * const lobj = SvRV(ST(0));
547 SV * const rs = newSViv( vcmp(lobj,new_version(newSVpvs("0"))) );
553 Perl_croak(aTHX_ "lobj is not of type version");
561 croak_xs_usage(cv, "lobj, ...");
562 if (sv_derived_from(ST(0), "version") && SvROK(ST(0)))
563 Perl_croak(aTHX_ "operation not supported with version object");
565 Perl_croak(aTHX_ "lobj is not of type version");
566 #ifndef HASATTRIBUTE_NORETURN
571 XS(XS_version_is_alpha)
576 croak_xs_usage(cv, "lobj");
578 if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
579 SV * const lobj = ST(0);
580 if ( hv_exists(MUTABLE_HV(SvRV(lobj)), "alpha", 5 ) )
588 Perl_croak(aTHX_ "lobj is not of type version");
600 const char * classname = "";
601 if ( items == 2 && SvOK(ST(1)) ) {
602 /* getting called as object or class method */
605 sv_isobject(ST(0)) /* class called as an object method */
606 ? HvNAME_get(SvSTASH(SvRV(ST(0))))
607 : (char *)SvPV_nolen(ST(0));
609 if ( !SvVOK(ver) ) { /* not already a v-string */
611 sv_setsv(rv,ver); /* make a duplicate */
612 upg_version(rv, TRUE);
614 rv = sv_2mortal(new_version(ver));
616 if ( items == 2 && strcmp(classname,"version") ) { /* inherited new() */
617 sv_bless(rv, gv_stashpv(classname, GV_ADD));
630 croak_xs_usage(cv, "lobj");
632 if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
633 SV * const lobj = ST(0);
634 if ( hv_exists(MUTABLE_HV(SvRV(lobj)), "qv", 2 ) )
642 Perl_croak(aTHX_ "lobj is not of type version");
650 croak_xs_usage(cv, "sv");
652 SV * const sv = ST(0);
667 croak_xs_usage(cv, "sv");
669 SV * const sv = ST(0);
671 const char * const s = SvPV_const(sv,len);
672 if (!SvUTF8(sv) || is_utf8_string((const U8*)s,len))
685 croak_xs_usage(cv, "sv");
686 sv_utf8_encode(ST(0));
695 croak_xs_usage(cv, "sv");
697 SV * const sv = ST(0);
699 if (SvIsCOW(sv)) sv_force_normal(sv);
700 RETVAL = sv_utf8_decode(sv);
701 ST(0) = boolSV(RETVAL);
711 croak_xs_usage(cv, "sv");
713 SV * const sv = ST(0);
717 RETVAL = sv_utf8_upgrade(sv);
718 XSprePUSH; PUSHi((IV)RETVAL);
723 XS(XS_utf8_downgrade)
727 if (items < 1 || items > 2)
728 croak_xs_usage(cv, "sv, failok=0");
730 SV * const sv = ST(0);
731 const bool failok = (items < 2) ? 0 : (int)SvIV(ST(1));
732 const bool RETVAL = sv_utf8_downgrade(sv, failok);
734 ST(0) = boolSV(RETVAL);
739 XS(XS_utf8_native_to_unicode)
743 const UV uv = SvUV(ST(0));
746 croak_xs_usage(cv, "sv");
748 ST(0) = sv_2mortal(newSViv(NATIVE_TO_UNI(uv)));
752 XS(XS_utf8_unicode_to_native)
756 const UV uv = SvUV(ST(0));
759 croak_xs_usage(cv, "sv");
761 ST(0) = sv_2mortal(newSViv(UNI_TO_NATIVE(uv)));
765 XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */
769 SV * const svz = ST(0);
773 /* [perl #77776] - called as &foo() not foo() */
775 croak_xs_usage(cv, "SCALAR[, ON]");
780 if (SvREADONLY(sv) && !SvIsCOW(sv))
785 else if (items == 2) {
787 if (SvIsCOW(sv)) sv_force_normal(sv);
792 /* I hope you really know what you are doing. */
793 if (!SvIsCOW(sv)) SvREADONLY_off(sv);
797 XSRETURN_UNDEF; /* Can't happen. */
800 XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */
804 SV * const svz = ST(0);
808 /* [perl #77776] - called as &foo() not foo() */
810 croak_xs_usage(cv, "SCALAR[, REFCOUNT]");
815 XSRETURN_IV(SvREFCNT(sv) - 1); /* Minus the ref created for us. */
816 else if (items == 2) {
817 /* I hope you really know what you are doing. */
818 SvREFCNT(sv) = SvIV(ST(1));
819 XSRETURN_IV(SvREFCNT(sv));
821 XSRETURN_UNDEF; /* Can't happen. */
824 XS(XS_Internals_hv_clear_placehold)
829 if (items != 1 || !SvROK(ST(0)))
830 croak_xs_usage(cv, "hv");
832 HV * const hv = MUTABLE_HV(SvRV(ST(0)));
833 hv_clear_placeholders(hv);
838 XS(XS_PerlIO_get_layers)
842 if (items < 1 || items % 2 == 0)
843 croak_xs_usage(cv, "filehandle[,args]");
850 bool details = FALSE;
854 for (svp = MARK + 2; svp <= SP; svp += 2) {
855 SV * const * const varp = svp;
856 SV * const * const valp = svp + 1;
858 const char * const key = SvPV_const(*varp, klen);
862 if (klen == 5 && memEQ(key, "input", 5)) {
863 input = SvTRUE(*valp);
868 if (klen == 6 && memEQ(key, "output", 6)) {
869 input = !SvTRUE(*valp);
874 if (klen == 7 && memEQ(key, "details", 7)) {
875 details = SvTRUE(*valp);
882 "get_layers: unknown argument '%s'",
894 if (SvROK(sv) && isGV(SvRV(sv)))
895 gv = MUTABLE_GV(SvRV(sv));
897 gv = gv_fetchsv(sv, 0, SVt_PVIO);
900 if (gv && (io = GvIO(gv))) {
901 AV* const av = PerlIO_get_layers(aTHX_ input ?
902 IoIFP(io) : IoOFP(io));
904 const I32 last = av_len(av);
907 for (i = last; i >= 0; i -= 3) {
908 SV * const * const namsvp = av_fetch(av, i - 2, FALSE);
909 SV * const * const argsvp = av_fetch(av, i - 1, FALSE);
910 SV * const * const flgsvp = av_fetch(av, i, FALSE);
912 const bool namok = namsvp && *namsvp && SvPOK(*namsvp);
913 const bool argok = argsvp && *argsvp && SvPOK(*argsvp);
914 const bool flgok = flgsvp && *flgsvp && SvIOK(*flgsvp);
917 /* Indents of 5? Yuck. */
918 /* We know that PerlIO_get_layers creates a new SV for
919 the name and flags, so we can just take a reference
920 and "steal" it when we free the AV below. */
922 ? sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp))
925 ? newSVpvn_flags(SvPVX_const(*argsvp),
927 (SvUTF8(*argsvp) ? SVf_UTF8 : 0)
931 ? sv_2mortal(SvREFCNT_inc_simple_NN(*flgsvp))
937 XPUSHs(sv_2mortal(Perl_newSVpvf(aTHX_ "%"SVf"(%"SVf")",
941 XPUSHs(sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp)));
943 XPUSHs(&PL_sv_undef);
946 const IV flags = SvIVX(*flgsvp);
948 if (flags & PERLIO_F_UTF8) {
949 XPUSHs(newSVpvs_flags("utf8", SVs_TEMP));
966 XS(XS_Internals_hash_seed)
969 /* Using dXSARGS would also have dITEM and dSP,
970 * which define 2 unused local variables. */
973 PERL_UNUSED_VAR(mark);
974 XSRETURN_UV(PERL_HASH_SEED);
977 XS(XS_Internals_rehash_seed)
980 /* Using dXSARGS would also have dITEM and dSP,
981 * which define 2 unused local variables. */
984 PERL_UNUSED_VAR(mark);
985 XSRETURN_UV(PL_rehash_seed);
988 XS(XS_Internals_HvREHASH) /* Subject to change */
994 const HV * const hv = (const HV *) SvRV(ST(0));
995 if (items == 1 && SvTYPE(hv) == SVt_PVHV) {
1002 Perl_croak(aTHX_ "Internals::HvREHASH $hashref");
1009 PERL_UNUSED_VAR(cv);
1012 croak_xs_usage(cv, "sv");
1014 if (SvRXOK(ST(0))) {
1021 XS(XS_re_regnames_count)
1023 REGEXP *rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
1029 croak_xs_usage(cv, "");
1037 ret = CALLREG_NAMED_BUFF_COUNT(rx);
1040 PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);
1052 if (items < 1 || items > 2)
1053 croak_xs_usage(cv, "name[, all ]");
1058 rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
1063 if (items == 2 && SvTRUE(ST(1))) {
1068 ret = CALLREG_NAMED_BUFF_FETCH(rx, ST(0), (flags | RXapif_REGNAME));
1071 PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);
1089 croak_xs_usage(cv, "[all]");
1091 rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
1096 if (items == 1 && SvTRUE(ST(0))) {
1105 ret = CALLREG_NAMED_BUFF_ALL(rx, (flags | RXapif_REGNAMES));
1112 av = MUTABLE_AV(SvRV(ret));
1113 length = av_len(av);
1115 for (i = 0; i <= length; i++) {
1116 entry = av_fetch(av, i, FALSE);
1119 Perl_croak(aTHX_ "NULL array element in re::regnames()");
1121 mXPUSHs(SvREFCNT_inc_simple_NN(*entry));
1130 XS(XS_re_regexp_pattern)
1137 croak_xs_usage(cv, "sv");
1142 Checks if a reference is a regex or not. If the parameter is
1143 not a ref, or is not the result of a qr// then returns false
1144 in scalar context and an empty list in list context.
1145 Otherwise in list context it returns the pattern and the
1146 modifiers, in scalar context it returns the pattern just as it
1147 would if the qr// was stringified normally, regardless as
1148 to the class of the variable and any stringification overloads
1152 if ((re = SvRX(ST(0)))) /* assign deliberate */
1154 /* Houston, we have a regex! */
1157 if ( GIMME_V == G_ARRAY ) {
1159 char reflags[sizeof(INT_PAT_MODS) + MAX_CHARSET_NAME_LENGTH];
1165 we are in list context so stringify
1166 the modifiers that apply. We ignore "negative
1167 modifiers" in this scenario, and the default character set
1170 if (get_regex_charset(RX_EXTFLAGS(re)) != REGEX_DEPENDS_CHARSET) {
1172 const char* const name = get_regex_charset_name(RX_EXTFLAGS(re),
1174 Copy(name, reflags + left, len, char);
1177 fptr = INT_PAT_MODS;
1178 match_flags = (U16)((RX_EXTFLAGS(re) & RXf_PMf_COMPILETIME)
1179 >> RXf_PMf_STD_PMMOD_SHIFT);
1181 while((ch = *fptr++)) {
1182 if(match_flags & 1) {
1183 reflags[left++] = ch;
1188 pattern = newSVpvn_flags(RX_PRECOMP(re),RX_PRELEN(re),
1189 (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP);
1191 /* return the pattern and the modifiers */
1193 XPUSHs(newSVpvn_flags(reflags, left, SVs_TEMP));
1196 /* Scalar, so use the string that Perl would return */
1197 /* return the pattern in (?msix:..) format */
1198 #if PERL_VERSION >= 11
1199 pattern = sv_2mortal(newSVsv(MUTABLE_SV(re)));
1201 pattern = newSVpvn_flags(RX_WRAPPED(re), RX_WRAPLEN(re),
1202 (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP);
1208 /* It ain't a regexp folks */
1209 if ( GIMME_V == G_ARRAY ) {
1210 /* return the empty list */
1213 /* Because of the (?:..) wrapping involved in a
1214 stringified pattern it is impossible to get a
1215 result for a real regexp that would evaluate to
1216 false. Therefore we can return PL_sv_no to signify
1217 that the object is not a regex, this means that one
1220 if (regex($might_be_a_regex) eq '(?:foo)') { }
1222 and not worry about undefined values.
1230 struct xsub_details {
1236 struct xsub_details details[] = {
1237 {"UNIVERSAL::isa", XS_UNIVERSAL_isa, NULL},
1238 {"UNIVERSAL::can", XS_UNIVERSAL_can, NULL},
1239 {"UNIVERSAL::DOES", XS_UNIVERSAL_DOES, NULL},
1240 {"UNIVERSAL::VERSION", XS_UNIVERSAL_VERSION, NULL},
1241 {"version::()", XS_version_noop, NULL},
1242 {"version::new", XS_version_new, NULL},
1243 {"version::parse", XS_version_new, NULL},
1244 {"version::(\"\"", XS_version_stringify, NULL},
1245 {"version::stringify", XS_version_stringify, NULL},
1246 {"version::(0+", XS_version_numify, NULL},
1247 {"version::numify", XS_version_numify, NULL},
1248 {"version::normal", XS_version_normal, NULL},
1249 {"version::(cmp", XS_version_vcmp, NULL},
1250 {"version::(<=>", XS_version_vcmp, NULL},
1251 {"version::vcmp", XS_version_vcmp, NULL},
1252 {"version::(bool", XS_version_boolean, NULL},
1253 {"version::boolean", XS_version_boolean, NULL},
1254 {"version::(nomethod", XS_version_noop, NULL},
1255 {"version::noop", XS_version_noop, NULL},
1256 {"version::is_alpha", XS_version_is_alpha, NULL},
1257 {"version::qv", XS_version_qv, NULL},
1258 {"version::declare", XS_version_qv, NULL},
1259 {"version::is_qv", XS_version_is_qv, NULL},
1260 {"utf8::is_utf8", XS_utf8_is_utf8, NULL},
1261 {"utf8::valid", XS_utf8_valid, NULL},
1262 {"utf8::encode", XS_utf8_encode, NULL},
1263 {"utf8::decode", XS_utf8_decode, NULL},
1264 {"utf8::upgrade", XS_utf8_upgrade, NULL},
1265 {"utf8::downgrade", XS_utf8_downgrade, NULL},
1266 {"utf8::native_to_unicode", XS_utf8_native_to_unicode, NULL},
1267 {"utf8::unicode_to_native", XS_utf8_unicode_to_native, NULL},
1268 {"Internals::SvREADONLY", XS_Internals_SvREADONLY, "\\[$%@];$"},
1269 {"Internals::SvREFCNT", XS_Internals_SvREFCNT, "\\[$%@];$"},
1270 {"Internals::hv_clear_placeholders", XS_Internals_hv_clear_placehold, "\\%"},
1271 {"PerlIO::get_layers", XS_PerlIO_get_layers, "*;@"},
1272 {"Internals::hash_seed", XS_Internals_hash_seed, ""},
1273 {"Internals::rehash_seed", XS_Internals_rehash_seed, ""},
1274 {"Internals::HvREHASH", XS_Internals_HvREHASH, "\\%"},
1275 {"re::is_regexp", XS_re_is_regexp, "$"},
1276 {"re::regname", XS_re_regname, ";$$"},
1277 {"re::regnames", XS_re_regnames, ";$"},
1278 {"re::regnames_count", XS_re_regnames_count, ""},
1279 {"re::regexp_pattern", XS_re_regexp_pattern, "$"},
1283 Perl_boot_core_UNIVERSAL(pTHX)
1286 static const char file[] = __FILE__;
1287 struct xsub_details *xsub = details;
1288 const struct xsub_details *end
1289 = details + sizeof(details) / sizeof(details[0]);
1292 newXS_flags(xsub->name, xsub->xsub, file, xsub->proto, 0);
1293 } while (++xsub < end);
1295 /* register the overloading (type 'A') magic */
1296 PL_amagic_generation++;
1298 /* Providing a Regexp::DESTROY fixes #21347. See test in t/op/ref.t */
1299 CvFILE(newCONSTSUB(get_hv("Regexp::", GV_ADD), "DESTROY", NULL))
1305 * c-indentation-style: bsd
1307 * indent-tabs-mode: t
1310 * ex: set ts=8 sts=4 sw=4 noet: