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: invocand->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);
698 const bool RETVAL = sv_utf8_decode(sv);
699 ST(0) = boolSV(RETVAL);
710 croak_xs_usage(cv, "sv");
712 SV * const sv = ST(0);
716 RETVAL = sv_utf8_upgrade(sv);
717 XSprePUSH; PUSHi((IV)RETVAL);
722 XS(XS_utf8_downgrade)
726 if (items < 1 || items > 2)
727 croak_xs_usage(cv, "sv, failok=0");
729 SV * const sv = ST(0);
730 const bool failok = (items < 2) ? 0 : (int)SvIV(ST(1));
731 const bool RETVAL = sv_utf8_downgrade(sv, failok);
733 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]");
785 else if (items == 2) {
791 /* I hope you really know what you are doing. */
796 XSRETURN_UNDEF; /* Can't happen. */
799 XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */
803 SV * const svz = ST(0);
807 /* [perl #77776] - called as &foo() not foo() */
809 croak_xs_usage(cv, "SCALAR[, REFCOUNT]");
814 XSRETURN_IV(SvREFCNT(sv) - 1); /* Minus the ref created for us. */
815 else if (items == 2) {
816 /* I hope you really know what you are doing. */
817 SvREFCNT(sv) = SvIV(ST(1));
818 XSRETURN_IV(SvREFCNT(sv));
820 XSRETURN_UNDEF; /* Can't happen. */
823 XS(XS_Internals_hv_clear_placehold)
828 if (items != 1 || !SvROK(ST(0)))
829 croak_xs_usage(cv, "hv");
831 HV * const hv = MUTABLE_HV(SvRV(ST(0)));
832 hv_clear_placeholders(hv);
837 XS(XS_PerlIO_get_layers)
841 if (items < 1 || items % 2 == 0)
842 croak_xs_usage(cv, "filehandle[,args]");
849 bool details = FALSE;
853 for (svp = MARK + 2; svp <= SP; svp += 2) {
854 SV * const * const varp = svp;
855 SV * const * const valp = svp + 1;
857 const char * const key = SvPV_const(*varp, klen);
861 if (klen == 5 && memEQ(key, "input", 5)) {
862 input = SvTRUE(*valp);
867 if (klen == 6 && memEQ(key, "output", 6)) {
868 input = !SvTRUE(*valp);
873 if (klen == 7 && memEQ(key, "details", 7)) {
874 details = SvTRUE(*valp);
881 "get_layers: unknown argument '%s'",
893 if (SvROK(sv) && isGV(SvRV(sv)))
894 gv = MUTABLE_GV(SvRV(sv));
896 gv = gv_fetchsv(sv, 0, SVt_PVIO);
899 if (gv && (io = GvIO(gv))) {
900 AV* const av = PerlIO_get_layers(aTHX_ input ?
901 IoIFP(io) : IoOFP(io));
903 const I32 last = av_len(av);
906 for (i = last; i >= 0; i -= 3) {
907 SV * const * const namsvp = av_fetch(av, i - 2, FALSE);
908 SV * const * const argsvp = av_fetch(av, i - 1, FALSE);
909 SV * const * const flgsvp = av_fetch(av, i, FALSE);
911 const bool namok = namsvp && *namsvp && SvPOK(*namsvp);
912 const bool argok = argsvp && *argsvp && SvPOK(*argsvp);
913 const bool flgok = flgsvp && *flgsvp && SvIOK(*flgsvp);
916 /* Indents of 5? Yuck. */
917 /* We know that PerlIO_get_layers creates a new SV for
918 the name and flags, so we can just take a reference
919 and "steal" it when we free the AV below. */
921 ? sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp))
924 ? newSVpvn_flags(SvPVX_const(*argsvp),
926 (SvUTF8(*argsvp) ? SVf_UTF8 : 0)
930 ? sv_2mortal(SvREFCNT_inc_simple_NN(*flgsvp))
936 XPUSHs(sv_2mortal(Perl_newSVpvf(aTHX_ "%"SVf"(%"SVf")",
940 XPUSHs(sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp)));
942 XPUSHs(&PL_sv_undef);
945 const IV flags = SvIVX(*flgsvp);
947 if (flags & PERLIO_F_UTF8) {
948 XPUSHs(newSVpvs_flags("utf8", SVs_TEMP));
965 XS(XS_Internals_hash_seed)
968 /* Using dXSARGS would also have dITEM and dSP,
969 * which define 2 unused local variables. */
972 PERL_UNUSED_VAR(mark);
973 XSRETURN_UV(PERL_HASH_SEED);
976 XS(XS_Internals_rehash_seed)
979 /* Using dXSARGS would also have dITEM and dSP,
980 * which define 2 unused local variables. */
983 PERL_UNUSED_VAR(mark);
984 XSRETURN_UV(PL_rehash_seed);
987 XS(XS_Internals_HvREHASH) /* Subject to change */
993 const HV * const hv = (const HV *) SvRV(ST(0));
994 if (items == 1 && SvTYPE(hv) == SVt_PVHV) {
1001 Perl_croak(aTHX_ "Internals::HvREHASH $hashref");
1008 PERL_UNUSED_VAR(cv);
1011 croak_xs_usage(cv, "sv");
1013 if (SvRXOK(ST(0))) {
1020 XS(XS_re_regnames_count)
1022 REGEXP *rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
1028 croak_xs_usage(cv, "");
1036 ret = CALLREG_NAMED_BUFF_COUNT(rx);
1039 PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);
1051 if (items < 1 || items > 2)
1052 croak_xs_usage(cv, "name[, all ]");
1057 rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
1062 if (items == 2 && SvTRUE(ST(1))) {
1067 ret = CALLREG_NAMED_BUFF_FETCH(rx, ST(0), (flags | RXapif_REGNAME));
1070 PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);
1088 croak_xs_usage(cv, "[all]");
1090 rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
1095 if (items == 1 && SvTRUE(ST(0))) {
1104 ret = CALLREG_NAMED_BUFF_ALL(rx, (flags | RXapif_REGNAMES));
1111 av = MUTABLE_AV(SvRV(ret));
1112 length = av_len(av);
1114 for (i = 0; i <= length; i++) {
1115 entry = av_fetch(av, i, FALSE);
1118 Perl_croak(aTHX_ "NULL array element in re::regnames()");
1120 mXPUSHs(SvREFCNT_inc_simple_NN(*entry));
1129 XS(XS_re_regexp_pattern)
1136 croak_xs_usage(cv, "sv");
1141 Checks if a reference is a regex or not. If the parameter is
1142 not a ref, or is not the result of a qr// then returns false
1143 in scalar context and an empty list in list context.
1144 Otherwise in list context it returns the pattern and the
1145 modifiers, in scalar context it returns the pattern just as it
1146 would if the qr// was stringified normally, regardless as
1147 to the class of the variable and any stringification overloads
1151 if ((re = SvRX(ST(0)))) /* assign deliberate */
1153 /* Houston, we have a regex! */
1156 if ( GIMME_V == G_ARRAY ) {
1158 char reflags[sizeof(INT_PAT_MODS) + MAX_CHARSET_NAME_LENGTH];
1164 we are in list context so stringify
1165 the modifiers that apply. We ignore "negative
1166 modifiers" in this scenario, and the default character set
1169 if (get_regex_charset(RX_EXTFLAGS(re)) != REGEX_DEPENDS_CHARSET) {
1171 const char* const name = get_regex_charset_name(RX_EXTFLAGS(re),
1173 Copy(name, reflags + left, len, char);
1176 fptr = INT_PAT_MODS;
1177 match_flags = (U16)((RX_EXTFLAGS(re) & RXf_PMf_COMPILETIME)
1178 >> RXf_PMf_STD_PMMOD_SHIFT);
1180 while((ch = *fptr++)) {
1181 if(match_flags & 1) {
1182 reflags[left++] = ch;
1187 pattern = newSVpvn_flags(RX_PRECOMP(re),RX_PRELEN(re),
1188 (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP);
1190 /* return the pattern and the modifiers */
1192 XPUSHs(newSVpvn_flags(reflags, left, SVs_TEMP));
1195 /* Scalar, so use the string that Perl would return */
1196 /* return the pattern in (?msix:..) format */
1197 #if PERL_VERSION >= 11
1198 pattern = sv_2mortal(newSVsv(MUTABLE_SV(re)));
1200 pattern = newSVpvn_flags(RX_WRAPPED(re), RX_WRAPLEN(re),
1201 (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP);
1207 /* It ain't a regexp folks */
1208 if ( GIMME_V == G_ARRAY ) {
1209 /* return the empty list */
1212 /* Because of the (?:..) wrapping involved in a
1213 stringified pattern it is impossible to get a
1214 result for a real regexp that would evaluate to
1215 false. Therefore we can return PL_sv_no to signify
1216 that the object is not a regex, this means that one
1219 if (regex($might_be_a_regex) eq '(?:foo)') { }
1221 and not worry about undefined values.
1229 struct xsub_details {
1235 struct xsub_details details[] = {
1236 {"UNIVERSAL::isa", XS_UNIVERSAL_isa, NULL},
1237 {"UNIVERSAL::can", XS_UNIVERSAL_can, NULL},
1238 {"UNIVERSAL::DOES", XS_UNIVERSAL_DOES, NULL},
1239 {"UNIVERSAL::VERSION", XS_UNIVERSAL_VERSION, NULL},
1240 {"version::()", XS_version_noop, NULL},
1241 {"version::new", XS_version_new, NULL},
1242 {"version::parse", XS_version_new, NULL},
1243 {"version::(\"\"", XS_version_stringify, NULL},
1244 {"version::stringify", XS_version_stringify, NULL},
1245 {"version::(0+", XS_version_numify, NULL},
1246 {"version::numify", XS_version_numify, NULL},
1247 {"version::normal", XS_version_normal, NULL},
1248 {"version::(cmp", XS_version_vcmp, NULL},
1249 {"version::(<=>", XS_version_vcmp, NULL},
1250 {"version::vcmp", XS_version_vcmp, NULL},
1251 {"version::(bool", XS_version_boolean, NULL},
1252 {"version::boolean", XS_version_boolean, NULL},
1253 {"version::(nomethod", XS_version_noop, NULL},
1254 {"version::noop", XS_version_noop, NULL},
1255 {"version::is_alpha", XS_version_is_alpha, NULL},
1256 {"version::qv", XS_version_qv, NULL},
1257 {"version::declare", XS_version_qv, NULL},
1258 {"version::is_qv", XS_version_is_qv, NULL},
1259 {"utf8::is_utf8", XS_utf8_is_utf8, NULL},
1260 {"utf8::valid", XS_utf8_valid, NULL},
1261 {"utf8::encode", XS_utf8_encode, NULL},
1262 {"utf8::decode", XS_utf8_decode, NULL},
1263 {"utf8::upgrade", XS_utf8_upgrade, NULL},
1264 {"utf8::downgrade", XS_utf8_downgrade, NULL},
1265 {"utf8::native_to_unicode", XS_utf8_native_to_unicode, NULL},
1266 {"utf8::unicode_to_native", XS_utf8_unicode_to_native, NULL},
1267 {"Internals::SvREADONLY", XS_Internals_SvREADONLY, "\\[$%@];$"},
1268 {"Internals::SvREFCNT", XS_Internals_SvREFCNT, "\\[$%@];$"},
1269 {"Internals::hv_clear_placeholders", XS_Internals_hv_clear_placehold, "\\%"},
1270 {"PerlIO::get_layers", XS_PerlIO_get_layers, "*;@"},
1271 {"Internals::hash_seed", XS_Internals_hash_seed, ""},
1272 {"Internals::rehash_seed", XS_Internals_rehash_seed, ""},
1273 {"Internals::HvREHASH", XS_Internals_HvREHASH, "\\%"},
1274 {"re::is_regexp", XS_re_is_regexp, "$"},
1275 {"re::regname", XS_re_regname, ";$$"},
1276 {"re::regnames", XS_re_regnames, ";$"},
1277 {"re::regnames_count", XS_re_regnames_count, ""},
1278 {"re::regexp_pattern", XS_re_regexp_pattern, "$"},
1282 Perl_boot_core_UNIVERSAL(pTHX)
1285 static const char file[] = __FILE__;
1286 struct xsub_details *xsub = details;
1287 const struct xsub_details *end
1288 = details + sizeof(details) / sizeof(details[0]);
1291 newXS_flags(xsub->name, xsub->xsub, file, xsub->proto, 0);
1292 } while (++xsub < end);
1294 /* register the overloading (type 'A') magic */
1295 PL_amagic_generation++;
1297 /* Providing a Regexp::DESTROY fixes #21347. See test in t/op/ref.t */
1298 CvFILE(newCONSTSUB(get_hv("Regexp::", GV_ADD), "DESTROY", NULL))
1304 * c-indentation-style: bsd
1306 * indent-tabs-mode: t
1309 * ex: set ts=8 sts=4 sw=4 noet: