This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #96126] Allocate CvFILE more simply
[perl5.git] / universal.c
CommitLineData
d6376244
JH
1/* universal.c
2 *
b5f8cc5c 3 * Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
1129b882 4 * 2005, 2006, 2007, 2008 by Larry Wall and others
d6376244
JH
5 *
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.
8 *
9 */
10
d31a8517 11/*
4ac71550
TC
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
15 *
16 * [p.54 of _The Lord of the Rings_, I/ii: "The Shadow of the Past"]
d31a8517
AT
17 */
18
166f8a29
DM
19/* This file contains the code that implements the functions in Perl's
20 * UNIVERSAL package, such as UNIVERSAL->can().
192b9cd1
AB
21 *
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
486ec47a 24 * clever to move them to separate XS files which would then be pulled
192b9cd1 25 * in by some to-be-written build process.
166f8a29
DM
26 */
27
6d4a7be2 28#include "EXTERN.h"
864dbfa3 29#define PERL_IN_UNIVERSAL_C
6d4a7be2 30#include "perl.h"
6d4a7be2 31
39f7a870
JH
32#ifdef USE_PERLIO
33#include "perliol.h" /* For the PERLIO_F_XXX */
34#endif
35
6d4a7be2
PP
36/*
37 * Contributed by Graham Barr <Graham.Barr@tiuk.ti.com>
38 * The main guts of traverse_isa was actually copied from gv_fetchmeth
39 */
40
a9ec700e 41STATIC bool
515a4f72 42S_isa_lookup(pTHX_ HV *stash, const char * const name)
6d4a7be2 43{
97aff369 44 dVAR;
a49ba3fc 45 const struct mro_meta *const meta = HvMROMETA(stash);
4340b386 46 HV *isa = meta->isa;
a49ba3fc
NC
47 STRLEN len = strlen(name);
48 const HV *our_stash;
6d4a7be2 49
7918f24d
NC
50 PERL_ARGS_ASSERT_ISA_LOOKUP;
51
4340b386
FC
52 if (!isa) {
53 (void)mro_get_linear_isa(stash);
54 isa = meta->isa;
55 }
56
a49ba3fc
NC
57 if (hv_common(isa, NULL, name, len, 0 /* No "UTF-8" flag possible with only
58 a char * argument*/,
59 HV_FETCH_ISEXISTS, NULL, 0)) {
60 /* Direct name lookup worked. */
a9ec700e 61 return TRUE;
a49ba3fc 62 }
6d4a7be2 63
a49ba3fc 64 /* A stash/class can go by many names (ie. User == main::User), so
81a5123c
FC
65 we use the HvENAME in the stash itself, which is canonical, falling
66 back to HvNAME if necessary. */
a49ba3fc
NC
67 our_stash = gv_stashpvn(name, len, 0);
68
69 if (our_stash) {
81a5123c
FC
70 HEK *canon_name = HvENAME_HEK(our_stash);
71 if (!canon_name) canon_name = HvNAME_HEK(our_stash);
a1d407e8 72
a49ba3fc
NC
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))) {
e1a479c5 76 return TRUE;
a49ba3fc 77 }
6d4a7be2
PP
78 }
79
a9ec700e 80 return FALSE;
6d4a7be2
PP
81}
82
954c1994 83/*
ccfc67b7
JH
84=head1 SV Manipulation Functions
85
954c1994
GS
86=for apidoc sv_derived_from
87
6885da0e 88Returns a boolean indicating whether the SV is derived from the specified class
89I<at the C level>. To check derivation at the Perl level, call C<isa()> as a
90normal Perl method.
954c1994
GS
91
92=cut
93*/
94
55497cff 95bool
15f169a1 96Perl_sv_derived_from(pTHX_ SV *sv, const char *const name)
55497cff 97{
97aff369 98 dVAR;
0b6f4f5c 99 HV *stash;
46e4b22b 100
7918f24d
NC
101 PERL_ARGS_ASSERT_SV_DERIVED_FROM;
102
5b295bef 103 SvGETMAGIC(sv);
55497cff
PP
104
105 if (SvROK(sv)) {
0b6f4f5c 106 const char *type;
55497cff
PP
107 sv = SvRV(sv);
108 type = sv_reftype(sv,0);
0b6f4f5c
AL
109 if (type && strEQ(type,name))
110 return TRUE;
111 stash = SvOBJECT(sv) ? SvSTASH(sv) : NULL;
55497cff
PP
112 }
113 else {
da51bb9b 114 stash = gv_stashsv(sv, 0);
55497cff 115 }
46e4b22b 116
4a9e32d8 117 return stash ? isa_lookup(stash, name) : FALSE;
55497cff
PP
118}
119
cbc021f9 120/*
121=for apidoc sv_does
122
123Returns a boolean indicating whether the SV performs a specific, named role.
124The SV can be a Perl object or the name of a Perl class.
125
126=cut
127*/
128
1b026014
NIS
129#include "XSUB.h"
130
cbc021f9 131bool
15f169a1 132Perl_sv_does(pTHX_ SV *sv, const char *const name)
cbc021f9 133{
134 const char *classname;
135 bool does_it;
59e7186f 136 SV *methodname;
cbc021f9 137 dSP;
7918f24d
NC
138
139 PERL_ARGS_ASSERT_SV_DOES;
140
cbc021f9 141 ENTER;
142 SAVETMPS;
143
144 SvGETMAGIC(sv);
145
146 if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
7ce46f2a
GG
147 || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv)))) {
148 LEAVE;
cbc021f9 149 return FALSE;
7ce46f2a 150 }
cbc021f9 151
152 if (sv_isobject(sv)) {
153 classname = sv_reftype(SvRV(sv),TRUE);
154 } else {
94707740 155 classname = SvPV_nolen(sv);
cbc021f9 156 }
157
7ce46f2a
GG
158 if (strEQ(name,classname)) {
159 LEAVE;
cbc021f9 160 return TRUE;
7ce46f2a 161 }
cbc021f9 162
163 PUSHMARK(SP);
164 XPUSHs(sv);
6e449a3a 165 mXPUSHs(newSVpv(name, 0));
cbc021f9 166 PUTBACK;
167
84bafc02 168 methodname = newSVpvs_flags("isa", SVs_TEMP);
59e7186f
RGS
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);
cbc021f9 174 SPAGAIN;
175
176 does_it = SvTRUE( TOPs );
177 FREETMPS;
178 LEAVE;
179
180 return does_it;
181}
182
afa74d42
NC
183/*
184=for apidoc croak_xs_usage
185
186A specialised variant of C<croak()> for emitting the usage message for xsubs
187
188 croak_xs_usage(cv, "eee_yow");
189
190works out the package name and subroutine name from C<cv>, and then calls
191C<croak()>. Hence if C<cv> is C<&ouch::awk>, it would call C<croak> as:
192
1b1ee2ef 193 Perl_croak(aTHX_ "Usage: %s::%s(%s)", "ouch" "awk", "eee_yow");
afa74d42
NC
194
195=cut
196*/
197
198void
199Perl_croak_xs_usage(pTHX_ const CV *const cv, const char *const params)
200{
201 const GV *const gv = CvGV(cv);
202
203 PERL_ARGS_ASSERT_CROAK_XS_USAGE;
204
205 if (gv) {
206 const char *const gvname = GvNAME(gv);
207 const HV *const stash = GvSTASH(gv);
208 const char *const hvname = stash ? HvNAME_get(stash) : NULL;
209
210 if (hvname)
211 Perl_croak(aTHX_ "Usage: %s::%s(%s)", hvname, gvname, params);
212 else
213 Perl_croak(aTHX_ "Usage: %s(%s)", gvname, params);
214 } else {
215 /* Pants. I don't think that it should be possible to get here. */
93c51217 216 Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
afa74d42
NC
217 }
218}
55497cff 219
6d4a7be2
PP
220XS(XS_UNIVERSAL_isa)
221{
97aff369 222 dVAR;
6d4a7be2 223 dXSARGS;
6d4a7be2
PP
224
225 if (items != 2)
afa74d42 226 croak_xs_usage(cv, "reference, kind");
c4420975
AL
227 else {
228 SV * const sv = ST(0);
229 const char *name;
6d4a7be2 230
c4420975 231 SvGETMAGIC(sv);
d3f7f2b2 232
c4420975
AL
233 if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
234 || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
235 XSRETURN_UNDEF;
f8f70380 236
c4420975 237 name = SvPV_nolen_const(ST(1));
6d4a7be2 238
c4420975
AL
239 ST(0) = boolSV(sv_derived_from(sv, name));
240 XSRETURN(1);
241 }
6d4a7be2
PP
242}
243
6d4a7be2
PP
244XS(XS_UNIVERSAL_can)
245{
97aff369 246 dVAR;
6d4a7be2
PP
247 dXSARGS;
248 SV *sv;
6867be6d 249 const char *name;
6d4a7be2 250 SV *rv;
6f08146e 251 HV *pkg = NULL;
6d4a7be2
PP
252
253 if (items != 2)
afa74d42 254 croak_xs_usage(cv, "object-ref, method");
6d4a7be2
PP
255
256 sv = ST(0);
f8f70380 257
5b295bef 258 SvGETMAGIC(sv);
d3f7f2b2 259
253ecd6d
RGS
260 if (!SvOK(sv) || !(SvROK(sv) || (SvPOK(sv) && SvCUR(sv))
261 || (SvGMAGICAL(sv) && SvPOKp(sv) && SvCUR(sv))))
f8f70380
GS
262 XSRETURN_UNDEF;
263
0510663f 264 name = SvPV_nolen_const(ST(1));
3280af22 265 rv = &PL_sv_undef;
6d4a7be2 266
46e4b22b 267 if (SvROK(sv)) {
daba3364 268 sv = MUTABLE_SV(SvRV(sv));
46e4b22b 269 if (SvOBJECT(sv))
6f08146e
NIS
270 pkg = SvSTASH(sv);
271 }
272 else {
da51bb9b 273 pkg = gv_stashsv(sv, 0);
6f08146e
NIS
274 }
275
276 if (pkg) {
c4420975 277 GV * const gv = gv_fetchmethod_autoload(pkg, name, FALSE);
dc848c6f 278 if (gv && isGV(gv))
daba3364 279 rv = sv_2mortal(newRV(MUTABLE_SV(GvCV(gv))));
6d4a7be2
PP
280 }
281
282 ST(0) = rv;
283 XSRETURN(1);
284}
285
cbc021f9 286XS(XS_UNIVERSAL_DOES)
287{
288 dVAR;
289 dXSARGS;
58c0efa5 290 PERL_UNUSED_ARG(cv);
cbc021f9 291
292 if (items != 2)
46404226 293 Perl_croak(aTHX_ "Usage: invocant->DOES(kind)");
cbc021f9 294 else {
295 SV * const sv = ST(0);
296 const char *name;
297
298 name = SvPV_nolen_const(ST(1));
299 if (sv_does( sv, name ))
300 XSRETURN_YES;
301
302 XSRETURN_NO;
303 }
304}
305
6d4a7be2
PP
306XS(XS_UNIVERSAL_VERSION)
307{
97aff369 308 dVAR;
6d4a7be2
PP
309 dXSARGS;
310 HV *pkg;
311 GV **gvp;
312 GV *gv;
313 SV *sv;
9bf41c1d 314 SV *ret;
e1ec3a88 315 const char *undef;
58c0efa5 316 PERL_UNUSED_ARG(cv);
6d4a7be2 317
1571675a 318 if (SvROK(ST(0))) {
daba3364 319 sv = MUTABLE_SV(SvRV(ST(0)));
1571675a 320 if (!SvOBJECT(sv))
cea2e8a9 321 Perl_croak(aTHX_ "Cannot find version of an unblessed reference");
6d4a7be2
PP
322 pkg = SvSTASH(sv);
323 }
324 else {
da51bb9b 325 pkg = gv_stashsv(ST(0), 0);
6d4a7be2
PP
326 }
327
4608196e 328 gvp = pkg ? (GV**)hv_fetchs(pkg, "VERSION", FALSE) : NULL;
6d4a7be2 329
0008872a 330 if (gvp && isGV(gv = *gvp) && (sv = GvSV(gv)) && SvOK(sv)) {
9bf41c1d
FC
331 ret = sv_newmortal();
332 sv_setsv(ret, sv);
c445ea15 333 undef = NULL;
6d4a7be2
PP
334 }
335 else {
9bf41c1d 336 sv = ret = &PL_sv_undef;
6d4a7be2
PP
337 undef = "(undef)";
338 }
339
1571675a 340 if (items > 1) {
1571675a
GS
341 SV *req = ST(1);
342
62658f4d 343 if (undef) {
bfcb3514 344 if (pkg) {
c4420975 345 const char * const name = HvNAME_get(pkg);
a3b680e6 346 Perl_croak(aTHX_
bfcb3514
NC
347 "%s does not define $%s::VERSION--version check failed",
348 name, name);
349 } else {
a3b680e6
AL
350 Perl_croak(aTHX_
351 "%s defines neither package nor VERSION--version check failed",
0510663f 352 SvPVx_nolen_const(ST(0)) );
62658f4d
PM
353 }
354 }
ad63d80f 355
9bf41c1d
FC
356 if ( !sv_derived_from(sv, "version"))
357 upg_version(sv, FALSE);
358
137d6fc0
JP
359 if ( !sv_derived_from(req, "version")) {
360 /* req may very well be R/O, so create a new object */
ac0e6a2f 361 req = sv_2mortal( new_version(req) );
137d6fc0 362 }
1571675a 363
ac0e6a2f 364 if ( vcmp( req, sv ) > 0 ) {
ef8f7699 365 if ( hv_exists(MUTABLE_HV(SvRV(req)), "qv", 2 ) ) {
ac0e6a2f
RGS
366 Perl_croak(aTHX_ "%s version %"SVf" required--"
367 "this is only version %"SVf"", HvNAME_get(pkg),
e3a22e3f 368 SVfARG(sv_2mortal(vnormal(req))),
369 SVfARG(sv_2mortal(vnormal(sv))));
ac0e6a2f
RGS
370 } else {
371 Perl_croak(aTHX_ "%s version %"SVf" required--"
372 "this is only version %"SVf"", HvNAME_get(pkg),
e3a22e3f 373 SVfARG(sv_2mortal(vstringify(req))),
374 SVfARG(sv_2mortal(vstringify(sv))));
ac0e6a2f
RGS
375 }
376 }
377
2d8e6c8d 378 }
6d4a7be2 379
9bf41c1d 380 ST(0) = ret;
6d4a7be2
PP
381
382 XSRETURN(1);
383}
384
439cb1c4
JP
385XS(XS_version_new)
386{
97aff369 387 dVAR;
439cb1c4 388 dXSARGS;
129318bd 389 if (items > 3)
afa74d42 390 croak_xs_usage(cv, "class, version");
439cb1c4
JP
391 SP -= items;
392 {
137d6fc0
JP
393 SV *vs = ST(1);
394 SV *rv;
c4420975
AL
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));
9137345a 399
91152fc1 400 if ( items == 1 || ! SvOK(vs) ) { /* no param or explicit undef */
92dcf8ce
JP
401 /* create empty object */
402 vs = sv_newmortal();
be5574c0 403 sv_setpvs(vs, "0");
9137345a
JP
404 }
405 else if ( items == 3 ) {
406 vs = sv_newmortal();
cfd0369c 407 Perl_sv_setpvf(aTHX_ vs,"v%s",SvPV_nolen_const(ST(2)));
129318bd 408 }
439cb1c4 409
137d6fc0 410 rv = new_version(vs);
0723351e 411 if ( strcmp(classname,"version") != 0 ) /* inherited new() */
da51bb9b 412 sv_bless(rv, gv_stashpv(classname, GV_ADD));
137d6fc0 413
6e449a3a 414 mPUSHs(rv);
439cb1c4
JP
415 PUTBACK;
416 return;
417 }
418}
419
420XS(XS_version_stringify)
421{
97aff369 422 dVAR;
41be1fbd
JH
423 dXSARGS;
424 if (items < 1)
afa74d42 425 croak_xs_usage(cv, "lobj, ...");
41be1fbd
JH
426 SP -= items;
427 {
d808b681 428 SV * lobj = ST(0);
41be1fbd 429
d808b681
JP
430 if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
431 lobj = SvRV(lobj);
41be1fbd
JH
432 }
433 else
434 Perl_croak(aTHX_ "lobj is not of type version");
435
6e449a3a 436 mPUSHs(vstringify(lobj));
41be1fbd
JH
437
438 PUTBACK;
439 return;
440 }
439cb1c4
JP
441}
442
443XS(XS_version_numify)
444{
97aff369 445 dVAR;
41be1fbd
JH
446 dXSARGS;
447 if (items < 1)
afa74d42 448 croak_xs_usage(cv, "lobj, ...");
41be1fbd
JH
449 SP -= items;
450 {
d808b681 451 SV * lobj = ST(0);
41be1fbd 452
d808b681
JP
453 if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
454 lobj = SvRV(lobj);
41be1fbd
JH
455 }
456 else
457 Perl_croak(aTHX_ "lobj is not of type version");
458
6e449a3a 459 mPUSHs(vnumify(lobj));
41be1fbd
JH
460
461 PUTBACK;
462 return;
463 }
439cb1c4
JP
464}
465
9137345a
JP
466XS(XS_version_normal)
467{
97aff369 468 dVAR;
9137345a
JP
469 dXSARGS;
470 if (items < 1)
afa74d42 471 croak_xs_usage(cv, "lobj, ...");
9137345a
JP
472 SP -= items;
473 {
d808b681 474 SV * lobj = ST(0);
9137345a 475
d808b681
JP
476 if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
477 lobj = SvRV(lobj);
9137345a
JP
478 }
479 else
480 Perl_croak(aTHX_ "lobj is not of type version");
481
6e449a3a 482 mPUSHs(vnormal(lobj));
9137345a
JP
483
484 PUTBACK;
485 return;
486 }
487}
488
439cb1c4
JP
489XS(XS_version_vcmp)
490{
97aff369 491 dVAR;
41be1fbd
JH
492 dXSARGS;
493 if (items < 1)
afa74d42 494 croak_xs_usage(cv, "lobj, ...");
41be1fbd
JH
495 SP -= items;
496 {
d808b681 497 SV * lobj = ST(0);
41be1fbd 498
d808b681
JP
499 if (sv_derived_from(lobj, "version") && SvROK(lobj)) {
500 lobj = SvRV(lobj);
41be1fbd
JH
501 }
502 else
503 Perl_croak(aTHX_ "lobj is not of type version");
504
505 {
506 SV *rs;
507 SV *rvs;
508 SV * robj = ST(1);
7452cf6a 509 const IV swap = (IV)SvIV(ST(2));
41be1fbd
JH
510
511 if ( ! sv_derived_from(robj, "version") )
512 {
e3a22e3f 513 robj = new_version(SvOK(robj) ? robj : newSVpvs_flags("0", SVs_TEMP));
514 sv_2mortal(robj);
41be1fbd
JH
515 }
516 rvs = SvRV(robj);
517
518 if ( swap )
519 {
520 rs = newSViv(vcmp(rvs,lobj));
521 }
522 else
523 {
524 rs = newSViv(vcmp(lobj,rvs));
525 }
526
6e449a3a 527 mPUSHs(rs);
41be1fbd
JH
528 }
529
530 PUTBACK;
531 return;
532 }
439cb1c4
JP
533}
534
535XS(XS_version_boolean)
536{
97aff369
JH
537 dVAR;
538 dXSARGS;
539 if (items < 1)
afa74d42 540 croak_xs_usage(cv, "lobj, ...");
97aff369 541 SP -= items;
d808b681 542 if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
c4420975 543 SV * const lobj = SvRV(ST(0));
396482e1 544 SV * const rs = newSViv( vcmp(lobj,new_version(newSVpvs("0"))) );
6e449a3a 545 mPUSHs(rs);
c4420975
AL
546 PUTBACK;
547 return;
548 }
549 else
550 Perl_croak(aTHX_ "lobj is not of type version");
439cb1c4
JP
551}
552
553XS(XS_version_noop)
554{
97aff369 555 dVAR;
2dfd8427
AL
556 dXSARGS;
557 if (items < 1)
afa74d42 558 croak_xs_usage(cv, "lobj, ...");
d808b681 559 if (sv_derived_from(ST(0), "version") && SvROK(ST(0)))
2dfd8427
AL
560 Perl_croak(aTHX_ "operation not supported with version object");
561 else
562 Perl_croak(aTHX_ "lobj is not of type version");
563#ifndef HASATTRIBUTE_NORETURN
564 XSRETURN_EMPTY;
565#endif
439cb1c4
JP
566}
567
c8d69e4a
JP
568XS(XS_version_is_alpha)
569{
97aff369 570 dVAR;
c8d69e4a
JP
571 dXSARGS;
572 if (items != 1)
afa74d42 573 croak_xs_usage(cv, "lobj");
c8d69e4a 574 SP -= items;
d808b681 575 if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
c4420975 576 SV * const lobj = ST(0);
ef8f7699 577 if ( hv_exists(MUTABLE_HV(SvRV(lobj)), "alpha", 5 ) )
c4420975
AL
578 XSRETURN_YES;
579 else
580 XSRETURN_NO;
c8d69e4a
JP
581 PUTBACK;
582 return;
583 }
c4420975
AL
584 else
585 Perl_croak(aTHX_ "lobj is not of type version");
c8d69e4a
JP
586}
587
137d6fc0
JP
588XS(XS_version_qv)
589{
97aff369 590 dVAR;
137d6fc0 591 dXSARGS;
4ed3fda4 592 PERL_UNUSED_ARG(cv);
137d6fc0
JP
593 SP -= items;
594 {
f941e658
JP
595 SV * ver = ST(0);
596 SV * rv;
597 const char * classname = "";
91152fc1 598 if ( items == 2 && SvOK(ST(1)) ) {
f941e658
JP
599 /* getting called as object or class method */
600 ver = ST(1);
601 classname =
602 sv_isobject(ST(0)) /* class called as an object method */
603 ? HvNAME_get(SvSTASH(SvRV(ST(0))))
604 : (char *)SvPV_nolen(ST(0));
605 }
606 if ( !SvVOK(ver) ) { /* not already a v-string */
607 rv = sv_newmortal();
ac0e6a2f
RGS
608 sv_setsv(rv,ver); /* make a duplicate */
609 upg_version(rv, TRUE);
f941e658
JP
610 } else {
611 rv = sv_2mortal(new_version(ver));
137d6fc0 612 }
f941e658
JP
613 if ( items == 2 && strcmp(classname,"version") ) { /* inherited new() */
614 sv_bless(rv, gv_stashpv(classname, GV_ADD));
137d6fc0 615 }
f941e658
JP
616 PUSHs(rv);
617 }
618 PUTBACK;
619 return;
620}
137d6fc0 621
f941e658
JP
622XS(XS_version_is_qv)
623{
624 dVAR;
625 dXSARGS;
626 if (items != 1)
627 croak_xs_usage(cv, "lobj");
628 SP -= items;
d808b681 629 if (sv_derived_from(ST(0), "version") && SvROK(ST(0))) {
f941e658
JP
630 SV * const lobj = ST(0);
631 if ( hv_exists(MUTABLE_HV(SvRV(lobj)), "qv", 2 ) )
632 XSRETURN_YES;
633 else
634 XSRETURN_NO;
137d6fc0
JP
635 PUTBACK;
636 return;
637 }
f941e658
JP
638 else
639 Perl_croak(aTHX_ "lobj is not of type version");
137d6fc0
JP
640}
641
8800c35a
JH
642XS(XS_utf8_is_utf8)
643{
97aff369 644 dVAR;
41be1fbd
JH
645 dXSARGS;
646 if (items != 1)
afa74d42 647 croak_xs_usage(cv, "sv");
c4420975 648 else {
76f73021 649 SV * const sv = ST(0);
650 SvGETMAGIC(sv);
c4420975
AL
651 if (SvUTF8(sv))
652 XSRETURN_YES;
653 else
654 XSRETURN_NO;
41be1fbd
JH
655 }
656 XSRETURN_EMPTY;
8800c35a
JH
657}
658
1b026014
NIS
659XS(XS_utf8_valid)
660{
97aff369 661 dVAR;
41be1fbd
JH
662 dXSARGS;
663 if (items != 1)
afa74d42 664 croak_xs_usage(cv, "sv");
c4420975
AL
665 else {
666 SV * const sv = ST(0);
667 STRLEN len;
668 const char * const s = SvPV_const(sv,len);
669 if (!SvUTF8(sv) || is_utf8_string((const U8*)s,len))
670 XSRETURN_YES;
671 else
672 XSRETURN_NO;
673 }
41be1fbd 674 XSRETURN_EMPTY;
1b026014
NIS
675}
676
677XS(XS_utf8_encode)
678{
97aff369 679 dVAR;
1b026014
NIS
680 dXSARGS;
681 if (items != 1)
afa74d42 682 croak_xs_usage(cv, "sv");
c4420975 683 sv_utf8_encode(ST(0));
1b026014
NIS
684 XSRETURN_EMPTY;
685}
686
687XS(XS_utf8_decode)
688{
97aff369 689 dVAR;
1b026014
NIS
690 dXSARGS;
691 if (items != 1)
afa74d42 692 croak_xs_usage(cv, "sv");
c4420975
AL
693 else {
694 SV * const sv = ST(0);
b2b7346b
FC
695 bool RETVAL;
696 if (SvIsCOW(sv)) sv_force_normal(sv);
697 RETVAL = sv_utf8_decode(sv);
1b026014 698 ST(0) = boolSV(RETVAL);
1b026014
NIS
699 }
700 XSRETURN(1);
701}
702
703XS(XS_utf8_upgrade)
704{
97aff369 705 dVAR;
1b026014
NIS
706 dXSARGS;
707 if (items != 1)
afa74d42 708 croak_xs_usage(cv, "sv");
c4420975
AL
709 else {
710 SV * const sv = ST(0);
1b026014
NIS
711 STRLEN RETVAL;
712 dXSTARG;
713
714 RETVAL = sv_utf8_upgrade(sv);
715 XSprePUSH; PUSHi((IV)RETVAL);
716 }
717 XSRETURN(1);
718}
719
720XS(XS_utf8_downgrade)
721{
97aff369 722 dVAR;
1b026014
NIS
723 dXSARGS;
724 if (items < 1 || items > 2)
afa74d42 725 croak_xs_usage(cv, "sv, failok=0");
c4420975
AL
726 else {
727 SV * const sv = ST(0);
6867be6d
AL
728 const bool failok = (items < 2) ? 0 : (int)SvIV(ST(1));
729 const bool RETVAL = sv_utf8_downgrade(sv, failok);
1b026014 730
1b026014 731 ST(0) = boolSV(RETVAL);
1b026014
NIS
732 }
733 XSRETURN(1);
734}
735
736XS(XS_utf8_native_to_unicode)
737{
97aff369 738 dVAR;
1b026014 739 dXSARGS;
6867be6d 740 const UV uv = SvUV(ST(0));
b7953727
JH
741
742 if (items > 1)
afa74d42 743 croak_xs_usage(cv, "sv");
b7953727 744
1b026014
NIS
745 ST(0) = sv_2mortal(newSViv(NATIVE_TO_UNI(uv)));
746 XSRETURN(1);
747}
748
749XS(XS_utf8_unicode_to_native)
750{
97aff369 751 dVAR;
1b026014 752 dXSARGS;
6867be6d 753 const UV uv = SvUV(ST(0));
b7953727
JH
754
755 if (items > 1)
afa74d42 756 croak_xs_usage(cv, "sv");
b7953727 757
1b026014
NIS
758 ST(0) = sv_2mortal(newSViv(UNI_TO_NATIVE(uv)));
759 XSRETURN(1);
760}
761
14a976d6 762XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */
29569577 763{
97aff369 764 dVAR;
29569577 765 dXSARGS;
80b6a949
AB
766 SV * const svz = ST(0);
767 SV * sv;
58c0efa5 768 PERL_UNUSED_ARG(cv);
6867be6d 769
80b6a949
AB
770 /* [perl #77776] - called as &foo() not foo() */
771 if (!SvROK(svz))
772 croak_xs_usage(cv, "SCALAR[, ON]");
773
774 sv = SvRV(svz);
775
29569577 776 if (items == 1) {
3e89ba19 777 if (SvREADONLY(sv) && !SvIsCOW(sv))
29569577
JH
778 XSRETURN_YES;
779 else
780 XSRETURN_NO;
781 }
782 else if (items == 2) {
783 if (SvTRUE(ST(1))) {
3e89ba19 784 if (SvIsCOW(sv)) sv_force_normal(sv);
29569577
JH
785 SvREADONLY_on(sv);
786 XSRETURN_YES;
787 }
788 else {
14a976d6 789 /* I hope you really know what you are doing. */
3e89ba19 790 if (!SvIsCOW(sv)) SvREADONLY_off(sv);
29569577
JH
791 XSRETURN_NO;
792 }
793 }
14a976d6 794 XSRETURN_UNDEF; /* Can't happen. */
29569577
JH
795}
796
14a976d6 797XS(XS_Internals_SvREFCNT) /* This is dangerous stuff. */
29569577 798{
97aff369 799 dVAR;
29569577 800 dXSARGS;
80b6a949
AB
801 SV * const svz = ST(0);
802 SV * sv;
58c0efa5 803 PERL_UNUSED_ARG(cv);
6867be6d 804
80b6a949
AB
805 /* [perl #77776] - called as &foo() not foo() */
806 if (!SvROK(svz))
807 croak_xs_usage(cv, "SCALAR[, REFCOUNT]");
808
809 sv = SvRV(svz);
810
29569577 811 if (items == 1)
14a976d6 812 XSRETURN_IV(SvREFCNT(sv) - 1); /* Minus the ref created for us. */
29569577 813 else if (items == 2) {
14a976d6 814 /* I hope you really know what you are doing. */
29569577
JH
815 SvREFCNT(sv) = SvIV(ST(1));
816 XSRETURN_IV(SvREFCNT(sv));
817 }
14a976d6 818 XSRETURN_UNDEF; /* Can't happen. */
29569577
JH
819}
820
f044d0d1 821XS(XS_Internals_hv_clear_placehold)
dfd4ef2f 822{
97aff369 823 dVAR;
dfd4ef2f 824 dXSARGS;
6867be6d 825
80b6a949 826 if (items != 1 || !SvROK(ST(0)))
afa74d42 827 croak_xs_usage(cv, "hv");
c4420975 828 else {
ef8f7699 829 HV * const hv = MUTABLE_HV(SvRV(ST(0)));
c4420975
AL
830 hv_clear_placeholders(hv);
831 XSRETURN(0);
832 }
dfd4ef2f 833}
39f7a870
JH
834
835XS(XS_PerlIO_get_layers)
836{
97aff369 837 dVAR;
39f7a870
JH
838 dXSARGS;
839 if (items < 1 || items % 2 == 0)
afa74d42 840 croak_xs_usage(cv, "filehandle[,args]");
5fef3b4a 841#ifdef USE_PERLIO
39f7a870
JH
842 {
843 SV * sv;
844 GV * gv;
845 IO * io;
846 bool input = TRUE;
847 bool details = FALSE;
848
849 if (items > 1) {
c4420975 850 SV * const *svp;
39f7a870 851 for (svp = MARK + 2; svp <= SP; svp += 2) {
c4420975
AL
852 SV * const * const varp = svp;
853 SV * const * const valp = svp + 1;
39f7a870 854 STRLEN klen;
c4420975 855 const char * const key = SvPV_const(*varp, klen);
39f7a870
JH
856
857 switch (*key) {
858 case 'i':
859 if (klen == 5 && memEQ(key, "input", 5)) {
860 input = SvTRUE(*valp);
861 break;
862 }
863 goto fail;
864 case 'o':
865 if (klen == 6 && memEQ(key, "output", 6)) {
866 input = !SvTRUE(*valp);
867 break;
868 }
869 goto fail;
870 case 'd':
871 if (klen == 7 && memEQ(key, "details", 7)) {
872 details = SvTRUE(*valp);
873 break;
874 }
875 goto fail;
876 default:
877 fail:
878 Perl_croak(aTHX_
879 "get_layers: unknown argument '%s'",
880 key);
881 }
882 }
883
884 SP -= (items - 1);
885 }
886
887 sv = POPs;
159b6efe 888 gv = MUTABLE_GV(sv);
39f7a870
JH
889
890 if (!isGV(sv)) {
891 if (SvROK(sv) && isGV(SvRV(sv)))
159b6efe 892 gv = MUTABLE_GV(SvRV(sv));
671d49be 893 else if (SvPOKp(sv))
f776e3cd 894 gv = gv_fetchsv(sv, 0, SVt_PVIO);
39f7a870
JH
895 }
896
897 if (gv && (io = GvIO(gv))) {
c4420975 898 AV* const av = PerlIO_get_layers(aTHX_ input ?
39f7a870
JH
899 IoIFP(io) : IoOFP(io));
900 I32 i;
c4420975 901 const I32 last = av_len(av);
39f7a870
JH
902 I32 nitem = 0;
903
904 for (i = last; i >= 0; i -= 3) {
c4420975
AL
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);
39f7a870 908
c4420975
AL
909 const bool namok = namsvp && *namsvp && SvPOK(*namsvp);
910 const bool argok = argsvp && *argsvp && SvPOK(*argsvp);
911 const bool flgok = flgsvp && *flgsvp && SvIOK(*flgsvp);
39f7a870
JH
912
913 if (details) {
92e45a3e
NC
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. */
ec3bab8e 918 XPUSHs(namok
92e45a3e 919 ? sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp))
ec3bab8e
NC
920 : &PL_sv_undef);
921 XPUSHs(argok
92e45a3e
NC
922 ? newSVpvn_flags(SvPVX_const(*argsvp),
923 SvCUR(*argsvp),
924 (SvUTF8(*argsvp) ? SVf_UTF8 : 0)
925 | SVs_TEMP)
926 : &PL_sv_undef);
96ccaf53 927 XPUSHs(flgok
92e45a3e 928 ? sv_2mortal(SvREFCNT_inc_simple_NN(*flgsvp))
ec3bab8e 929 : &PL_sv_undef);
39f7a870
JH
930 nitem += 3;
931 }
932 else {
933 if (namok && argok)
1eb9e81d 934 XPUSHs(sv_2mortal(Perl_newSVpvf(aTHX_ "%"SVf"(%"SVf")",
be2597df 935 SVfARG(*namsvp),
1eb9e81d 936 SVfARG(*argsvp))));
39f7a870 937 else if (namok)
92e45a3e 938 XPUSHs(sv_2mortal(SvREFCNT_inc_simple_NN(*namsvp)));
39f7a870
JH
939 else
940 XPUSHs(&PL_sv_undef);
941 nitem++;
942 if (flgok) {
c4420975 943 const IV flags = SvIVX(*flgsvp);
39f7a870
JH
944
945 if (flags & PERLIO_F_UTF8) {
84bafc02 946 XPUSHs(newSVpvs_flags("utf8", SVs_TEMP));
39f7a870
JH
947 nitem++;
948 }
949 }
950 }
951 }
952
953 SvREFCNT_dec(av);
954
955 XSRETURN(nitem);
956 }
957 }
5fef3b4a 958#endif
39f7a870
JH
959
960 XSRETURN(0);
961}
962
9a7034eb 963XS(XS_Internals_hash_seed)
c910b28a 964{
97aff369 965 dVAR;
c85d3f85
NC
966 /* Using dXSARGS would also have dITEM and dSP,
967 * which define 2 unused local variables. */
557b887a 968 dAXMARK;
53c1dcc0 969 PERL_UNUSED_ARG(cv);
ad73156c 970 PERL_UNUSED_VAR(mark);
81eaca17 971 XSRETURN_UV(PERL_HASH_SEED);
c910b28a
JH
972}
973
008fb0c0 974XS(XS_Internals_rehash_seed)
8e90d776 975{
97aff369 976 dVAR;
8e90d776
NC
977 /* Using dXSARGS would also have dITEM and dSP,
978 * which define 2 unused local variables. */
557b887a 979 dAXMARK;
53c1dcc0 980 PERL_UNUSED_ARG(cv);
ad73156c 981 PERL_UNUSED_VAR(mark);
008fb0c0 982 XSRETURN_UV(PL_rehash_seed);
8e90d776
NC
983}
984
05619474
NC
985XS(XS_Internals_HvREHASH) /* Subject to change */
986{
97aff369 987 dVAR;
05619474 988 dXSARGS;
93c51217 989 PERL_UNUSED_ARG(cv);
05619474 990 if (SvROK(ST(0))) {
ef8f7699 991 const HV * const hv = (const HV *) SvRV(ST(0));
05619474
NC
992 if (items == 1 && SvTYPE(hv) == SVt_PVHV) {
993 if (HvREHASH(hv))
994 XSRETURN_YES;
995 else
996 XSRETURN_NO;
997 }
998 }
999 Perl_croak(aTHX_ "Internals::HvREHASH $hashref");
1000}
241d1a3b 1001
80305961
YO
1002XS(XS_re_is_regexp)
1003{
1004 dVAR;
1005 dXSARGS;
f7e71195
AB
1006 PERL_UNUSED_VAR(cv);
1007
80305961 1008 if (items != 1)
afa74d42 1009 croak_xs_usage(cv, "sv");
f7e71195 1010
f7e71195
AB
1011 if (SvRXOK(ST(0))) {
1012 XSRETURN_YES;
1013 } else {
1014 XSRETURN_NO;
80305961
YO
1015 }
1016}
1017
192b9cd1 1018XS(XS_re_regnames_count)
80305961 1019{
192b9cd1
AB
1020 REGEXP *rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
1021 SV * ret;
80305961
YO
1022 dVAR;
1023 dXSARGS;
192b9cd1
AB
1024
1025 if (items != 0)
afa74d42 1026 croak_xs_usage(cv, "");
192b9cd1
AB
1027
1028 SP -= items;
fdae9473 1029 PUTBACK;
192b9cd1
AB
1030
1031 if (!rx)
1032 XSRETURN_UNDEF;
1033
1034 ret = CALLREG_NAMED_BUFF_COUNT(rx);
1035
1036 SPAGAIN;
fdae9473
NC
1037 PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);
1038 XSRETURN(1);
192b9cd1
AB
1039}
1040
1041XS(XS_re_regname)
1042{
1043 dVAR;
1044 dXSARGS;
1045 REGEXP * rx;
1046 U32 flags;
1047 SV * ret;
1048
28d8d7f4 1049 if (items < 1 || items > 2)
afa74d42 1050 croak_xs_usage(cv, "name[, all ]");
192b9cd1 1051
80305961 1052 SP -= items;
fdae9473 1053 PUTBACK;
80305961 1054
192b9cd1
AB
1055 rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
1056
1057 if (!rx)
1058 XSRETURN_UNDEF;
1059
1060 if (items == 2 && SvTRUE(ST(1))) {
f1b875a0 1061 flags = RXapif_ALL;
192b9cd1 1062 } else {
f1b875a0 1063 flags = RXapif_ONE;
80305961 1064 }
f1b875a0 1065 ret = CALLREG_NAMED_BUFF_FETCH(rx, ST(0), (flags | RXapif_REGNAME));
192b9cd1 1066
fdae9473
NC
1067 SPAGAIN;
1068 PUSHs(ret ? sv_2mortal(ret) : &PL_sv_undef);
1069 XSRETURN(1);
80305961
YO
1070}
1071
192b9cd1 1072
80305961
YO
1073XS(XS_re_regnames)
1074{
192b9cd1 1075 dVAR;
80305961 1076 dXSARGS;
192b9cd1
AB
1077 REGEXP * rx;
1078 U32 flags;
1079 SV *ret;
1080 AV *av;
1081 I32 length;
1082 I32 i;
1083 SV **entry;
1084
1085 if (items > 1)
afa74d42 1086 croak_xs_usage(cv, "[all]");
192b9cd1
AB
1087
1088 rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
1089
1090 if (!rx)
1091 XSRETURN_UNDEF;
1092
1093 if (items == 1 && SvTRUE(ST(0))) {
f1b875a0 1094 flags = RXapif_ALL;
192b9cd1 1095 } else {
f1b875a0 1096 flags = RXapif_ONE;
192b9cd1
AB
1097 }
1098
80305961 1099 SP -= items;
fdae9473 1100 PUTBACK;
80305961 1101
f1b875a0 1102 ret = CALLREG_NAMED_BUFF_ALL(rx, (flags | RXapif_REGNAMES));
192b9cd1
AB
1103
1104 SPAGAIN;
1105
192b9cd1
AB
1106 if (!ret)
1107 XSRETURN_UNDEF;
1108
502c6561 1109 av = MUTABLE_AV(SvRV(ret));
192b9cd1
AB
1110 length = av_len(av);
1111
1112 for (i = 0; i <= length; i++) {
1113 entry = av_fetch(av, i, FALSE);
1114
1115 if (!entry)
1116 Perl_croak(aTHX_ "NULL array element in re::regnames()");
1117
ec83ea38 1118 mXPUSHs(SvREFCNT_inc_simple_NN(*entry));
80305961 1119 }
ec83ea38
MHM
1120
1121 SvREFCNT_dec(ret);
1122
192b9cd1
AB
1123 PUTBACK;
1124 return;
80305961
YO
1125}
1126
192c1e27
JH
1127XS(XS_re_regexp_pattern)
1128{
1129 dVAR;
1130 dXSARGS;
1131 REGEXP *re;
192c1e27
JH
1132
1133 if (items != 1)
afa74d42 1134 croak_xs_usage(cv, "sv");
192c1e27
JH
1135
1136 SP -= items;
1137
1138 /*
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
486ec47a 1145 to the class of the variable and any stringification overloads
192c1e27
JH
1146 on the object.
1147 */
1148
1149 if ((re = SvRX(ST(0)))) /* assign deliberate */
1150 {
22c985d5 1151 /* Houston, we have a regex! */
192c1e27 1152 SV *pattern;
192c1e27
JH
1153
1154 if ( GIMME_V == G_ARRAY ) {
9de15fec 1155 STRLEN left = 0;
a62b1201 1156 char reflags[sizeof(INT_PAT_MODS) + MAX_CHARSET_NAME_LENGTH];
69af1167
SH
1157 const char *fptr;
1158 char ch;
1159 U16 match_flags;
1160
192c1e27
JH
1161 /*
1162 we are in list context so stringify
1163 the modifiers that apply. We ignore "negative
a62b1201 1164 modifiers" in this scenario, and the default character set
192c1e27
JH
1165 */
1166
a62b1201
KW
1167 if (get_regex_charset(RX_EXTFLAGS(re)) != REGEX_DEPENDS_CHARSET) {
1168 STRLEN len;
1169 const char* const name = get_regex_charset_name(RX_EXTFLAGS(re),
1170 &len);
1171 Copy(name, reflags + left, len, char);
1172 left += len;
9de15fec 1173 }
69af1167 1174 fptr = INT_PAT_MODS;
73134a2e 1175 match_flags = (U16)((RX_EXTFLAGS(re) & RXf_PMf_COMPILETIME)
192c1e27
JH
1176 >> RXf_PMf_STD_PMMOD_SHIFT);
1177
1178 while((ch = *fptr++)) {
1179 if(match_flags & 1) {
1180 reflags[left++] = ch;
1181 }
1182 match_flags >>= 1;
1183 }
1184
fb632ce3
NC
1185 pattern = newSVpvn_flags(RX_PRECOMP(re),RX_PRELEN(re),
1186 (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP);
192c1e27
JH
1187
1188 /* return the pattern and the modifiers */
1189 XPUSHs(pattern);
fb632ce3 1190 XPUSHs(newSVpvn_flags(reflags, left, SVs_TEMP));
192c1e27
JH
1191 XSRETURN(2);
1192 } else {
1193 /* Scalar, so use the string that Perl would return */
1194 /* return the pattern in (?msix:..) format */
1195#if PERL_VERSION >= 11
daba3364 1196 pattern = sv_2mortal(newSVsv(MUTABLE_SV(re)));
192c1e27 1197#else
fb632ce3
NC
1198 pattern = newSVpvn_flags(RX_WRAPPED(re), RX_WRAPLEN(re),
1199 (RX_UTF8(re) ? SVf_UTF8 : 0) | SVs_TEMP);
192c1e27
JH
1200#endif
1201 XPUSHs(pattern);
1202 XSRETURN(1);
1203 }
1204 } else {
1205 /* It ain't a regexp folks */
1206 if ( GIMME_V == G_ARRAY ) {
1207 /* return the empty list */
1208 XSRETURN_UNDEF;
1209 } else {
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
1215 can say
1216
1217 if (regex($might_be_a_regex) eq '(?:foo)') { }
1218
1219 and not worry about undefined values.
1220 */
1221 XSRETURN_NO;
1222 }
1223 }
1224 /* NOT-REACHED */
1225}
1226
eff5b9d5
NC
1227struct xsub_details {
1228 const char *name;
1229 XSUBADDR_t xsub;
1230 const char *proto;
1231};
1232
1233struct 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, "$"},
eff5b9d5
NC
1277};
1278
1279void
1280Perl_boot_core_UNIVERSAL(pTHX)
1281{
1282 dVAR;
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]);
1287
1288 do {
1289 newXS_flags(xsub->name, xsub->xsub, file, xsub->proto, 0);
1290 } while (++xsub < end);
1291
1292 /* register the overloading (type 'A') magic */
1293 PL_amagic_generation++;
1294
1295 /* Providing a Regexp::DESTROY fixes #21347. See test in t/op/ref.t */
bad4ae38
FC
1296 {
1297 CV * const cv =
1298 newCONSTSUB(get_hv("Regexp::", GV_ADD), "DESTROY", NULL);
1299 Safefree(CvFILE(cv));
1300 CvFILE(cv) = (char *)file;
1301 CvDYNFILE_off(cv);
1302 }
eff5b9d5 1303}
80305961 1304
241d1a3b
NC
1305/*
1306 * Local variables:
1307 * c-indentation-style: bsd
1308 * c-basic-offset: 4
1309 * indent-tabs-mode: t
1310 * End:
1311 *
37442d52
RGS
1312 * ex: set ts=8 sts=4 sw=4 noet:
1313 */