RMG - Remove out-of-date instruction about epigraph link

[perl5.git] / universal.c

diff --git a/universal.c b/universal.c
index ad5b504..94169a6 100644 (file)
--- a/universal.c
+++ b/universal.c
@@ -41,7 +41,6 @@
 STATIC bool
 S_isa_lookup(pTHX_ HV *stash, const char * const name, STRLEN len, U32 flags)
 {
-    dVAR;
     const struct mro_meta *const meta = HvMROMETA(stash);
     HV *isa = meta->isa;
     const HV *our_stash;
@@ -67,7 +66,7 @@ S_isa_lookup(pTHX_ HV *stash, const char * const name, STRLEN len, U32 flags)
     if (our_stash) {
        HEK *canon_name = HvENAME_HEK(our_stash);
        if (!canon_name) canon_name = HvNAME_HEK(our_stash);
-
+       assert(canon_name);
        if (hv_common(isa, NULL, HEK_KEY(canon_name), HEK_LEN(canon_name),
                      HEK_FLAGS(canon_name),
                      HV_FETCH_ISEXISTS, NULL, HEK_HASH(canon_name))) {
@@ -147,7 +146,6 @@ Perl_sv_derived_from_pv(pTHX_ SV *sv, const char *const name, U32 flags)
 bool
 Perl_sv_derived_from_pvn(pTHX_ SV *sv, const char *const name, const STRLEN len, U32 flags)
 {
-    dVAR;
     HV *stash;
 
     PERL_ARGS_ASSERT_SV_DERIVED_FROM_PVN;
@@ -304,11 +302,12 @@ C<croak()>.  Hence if C<cv> is C<&ouch::awk>, it would call C<croak> as:
 void
 Perl_croak_xs_usage(const CV *const cv, const char *const params)
 {
-    const GV *const gv = CvGV(cv);
+    /* Avoid CvGV as it requires aTHX.  */
+    const GV *gv = CvNAMED(cv) ? NULL : cv->sv_any->xcv_gv_u.xcv_gv;
 
     PERL_ARGS_ASSERT_CROAK_XS_USAGE;
 
-    if (gv) {
+    if (gv) got_gv: {
        const HV *const stash = GvSTASH(gv);
 
        if (HvNAME_get(stash))
@@ -322,16 +321,18 @@ Perl_croak_xs_usage(const CV *const cv, const char *const params)
            Perl_croak_nocontext("Usage: %"HEKf"(%s)",
                                 HEKfARG(GvNAME_HEK(gv)), params);
     } else {
+        dTHX;
+        if ((gv = CvGV(cv))) goto got_gv;
+
        /* Pants. I don't think that it should be possible to get here. */
        /* diag_listed_as: SKIPME */
-       Perl_croak_nocontext("Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
+       Perl_croak(aTHX_ "Usage: CODE(0x%"UVxf")(%s)", PTR2UV(cv), params);
     }
 }
 
 XS(XS_UNIVERSAL_isa); /* prototype to pass -Wmissing-prototypes */
 XS(XS_UNIVERSAL_isa)
 {
-    dVAR;
     dXSARGS;
 
     if (items != 2)
@@ -352,7 +353,6 @@ XS(XS_UNIVERSAL_isa)
 XS(XS_UNIVERSAL_can); /* prototype to pass -Wmissing-prototypes */
 XS(XS_UNIVERSAL_can)
 {
-    dVAR;
     dXSARGS;
     SV   *sv;
     SV   *rv;
@@ -388,7 +388,7 @@ XS(XS_UNIVERSAL_can)
     else {
         pkg = gv_stashsv(sv, 0);
         if (!pkg)
-            pkg = gv_stashpv("UNIVERSAL", 0);
+            pkg = gv_stashpvs("UNIVERSAL", 0);
     }
 
     if (pkg) {
@@ -404,7 +404,6 @@ XS(XS_UNIVERSAL_can)
 XS(XS_UNIVERSAL_DOES); /* prototype to pass -Wmissing-prototypes */
 XS(XS_UNIVERSAL_DOES)
 {
-    dVAR;
     dXSARGS;
     PERL_UNUSED_ARG(cv);
 
@@ -422,7 +421,6 @@ XS(XS_UNIVERSAL_DOES)
 XS(XS_utf8_is_utf8); /* prototype to pass -Wmissing-prototypes */
 XS(XS_utf8_is_utf8)
 {
-     dVAR;
      dXSARGS;
      if (items != 1)
         croak_xs_usage(cv, "sv");
@@ -440,7 +438,6 @@ XS(XS_utf8_is_utf8)
 XS(XS_utf8_valid); /* prototype to pass -Wmissing-prototypes */
 XS(XS_utf8_valid)
 {
-     dVAR;
      dXSARGS;
      if (items != 1)
         croak_xs_usage(cv, "sv");
@@ -459,7 +456,6 @@ XS(XS_utf8_valid)
 XS(XS_utf8_encode); /* prototype to pass -Wmissing-prototypes */
 XS(XS_utf8_encode)
 {
-    dVAR;
     dXSARGS;
     if (items != 1)
        croak_xs_usage(cv, "sv");
@@ -471,7 +467,6 @@ XS(XS_utf8_encode)
 XS(XS_utf8_decode); /* prototype to pass -Wmissing-prototypes */
 XS(XS_utf8_decode)
 {
-    dVAR;
     dXSARGS;
     if (items != 1)
        croak_xs_usage(cv, "sv");
@@ -489,7 +484,6 @@ XS(XS_utf8_decode)
 XS(XS_utf8_upgrade); /* prototype to pass -Wmissing-prototypes */
 XS(XS_utf8_upgrade)
 {
-    dVAR;
     dXSARGS;
     if (items != 1)
        croak_xs_usage(cv, "sv");
@@ -507,13 +501,12 @@ XS(XS_utf8_upgrade)
 XS(XS_utf8_downgrade); /* prototype to pass -Wmissing-prototypes */
 XS(XS_utf8_downgrade)
 {
-    dVAR;
     dXSARGS;
     if (items < 1 || items > 2)
        croak_xs_usage(cv, "sv, failok=0");
     else {
        SV * const sv = ST(0);
-        const bool failok = (items < 2) ? 0 : (int)SvIV(ST(1));
+        const bool failok = (items < 2) ? 0 : SvTRUE(ST(1)) ? 1 : 0;
         const bool RETVAL = sv_utf8_downgrade(sv, failok);
 
        ST(0) = boolSV(RETVAL);
@@ -524,7 +517,6 @@ XS(XS_utf8_downgrade)
 XS(XS_utf8_native_to_unicode); /* prototype to pass -Wmissing-prototypes */
 XS(XS_utf8_native_to_unicode)
 {
- dVAR;
  dXSARGS;
  const UV uv = SvUV(ST(0));
 
@@ -538,7 +530,6 @@ XS(XS_utf8_native_to_unicode)
 XS(XS_utf8_unicode_to_native); /* prototype to pass -Wmissing-prototypes */
 XS(XS_utf8_unicode_to_native)
 {
- dVAR;
  dXSARGS;
  const UV uv = SvUV(ST(0));
 
@@ -552,7 +543,6 @@ XS(XS_utf8_unicode_to_native)
 XS(XS_Internals_SvREADONLY); /* prototype to pass -Wmissing-prototypes */
 XS(XS_Internals_SvREADONLY)    /* This is dangerous stuff. */
 {
-    dVAR;
     dXSARGS;
     SV * const svz = ST(0);
     SV * sv;
@@ -575,12 +565,12 @@ XS(XS_Internals_SvREADONLY)       /* This is dangerous stuff. */
 #ifdef PERL_OLD_COPY_ON_WRITE
            if (SvIsCOW(sv)) sv_force_normal(sv);
 #endif
-           SvREADONLY_on(sv);
+           SvFLAGS(sv) |= SVf_READONLY;
            XSRETURN_YES;
        }
        else {
            /* I hope you really know what you are doing. */
-           SvREADONLY_off(sv);
+           SvFLAGS(sv) &=~ SVf_READONLY;
            XSRETURN_NO;
        }
     }
@@ -590,7 +580,6 @@ XS(XS_Internals_SvREADONLY) /* This is dangerous stuff. */
 XS(XS_constant__make_const); /* prototype to pass -Wmissing-prototypes */
 XS(XS_constant__make_const)    /* This is dangerous stuff. */
 {
-    dVAR;
     dXSARGS;
     SV * const svz = ST(0);
     SV * sv;
@@ -621,7 +610,6 @@ XS(XS_constant__make_const) /* This is dangerous stuff. */
 XS(XS_Internals_SvREFCNT); /* prototype to pass -Wmissing-prototypes */
 XS(XS_Internals_SvREFCNT)      /* This is dangerous stuff. */
 {
-    dVAR;
     dXSARGS;
     SV * const svz = ST(0);
     SV * sv;
@@ -647,7 +635,6 @@ XS(XS_Internals_SvREFCNT)   /* This is dangerous stuff. */
 XS(XS_Internals_hv_clear_placehold); /* prototype to pass -Wmissing-prototypes */
 XS(XS_Internals_hv_clear_placehold)
 {
-    dVAR;
     dXSARGS;
 
     if (items != 1 || !SvROK(ST(0)))
@@ -662,7 +649,6 @@ XS(XS_Internals_hv_clear_placehold)
 XS(XS_PerlIO_get_layers); /* prototype to pass -Wmissing-prototypes */
 XS(XS_PerlIO_get_layers)
 {
-    dVAR;
     dXSARGS;
     if (items < 1 || items % 2 == 0)
        croak_xs_usage(cv, "filehandle[,args]");
@@ -722,7 +708,7 @@ XS(XS_PerlIO_get_layers)
             AV* const av = PerlIO_get_layers(aTHX_ input ?
                                        IoIFP(io) : IoOFP(io));
             SSize_t i;
-            const SSize_t last = av_len(av);
+            const SSize_t last = av_tindex(av);
             SSize_t nitem = 0;
             
             for (i = last; i >= 0; i -= 3) {
@@ -789,7 +775,6 @@ XS(XS_PerlIO_get_layers)
 XS(XS_re_is_regexp); /* prototype to pass -Wmissing-prototypes */
 XS(XS_re_is_regexp)
 {
-    dVAR; 
     dXSARGS;
     PERL_UNUSED_VAR(cv);
 
@@ -808,7 +793,6 @@ XS(XS_re_regnames_count)
 {
     REGEXP *rx = PL_curpm ? PM_GETRE(PL_curpm) : NULL;
     SV * ret;
-    dVAR; 
     dXSARGS;
 
     if (items != 0)
@@ -830,7 +814,6 @@ XS(XS_re_regnames_count)
 XS(XS_re_regname); /* prototype to pass -Wmissing-prototypes */
 XS(XS_re_regname)
 {
-    dVAR;
     dXSARGS;
     REGEXP * rx;
     U32 flags;
@@ -863,7 +846,6 @@ XS(XS_re_regname)
 XS(XS_re_regnames); /* prototype to pass -Wmissing-prototypes */
 XS(XS_re_regnames)
 {
-    dVAR;
     dXSARGS;
     REGEXP * rx;
     U32 flags;
@@ -898,7 +880,7 @@ XS(XS_re_regnames)
         XSRETURN_UNDEF;
 
     av = MUTABLE_AV(SvRV(ret));
-    length = av_len(av);
+    length = av_tindex(av);
 
     EXTEND(SP, length+1); /* better extend stack just once */
     for (i = 0; i <= length; i++) {
@@ -919,7 +901,6 @@ XS(XS_re_regnames)
 XS(XS_re_regexp_pattern); /* prototype to pass -Wmissing-prototypes */
 XS(XS_re_regexp_pattern)
 {
-    dVAR;
     dXSARGS;
     REGEXP *re;
 
@@ -1056,11 +1037,9 @@ static const struct xsub_details details[] = {
 void
 Perl_boot_core_UNIVERSAL(pTHX)
 {
-    dVAR;
     static const char file[] = __FILE__;
     const struct xsub_details *xsub = details;
-    const struct xsub_details *end
-       = details + sizeof(details) / sizeof(details[0]);
+    const struct xsub_details *end = C_ARRAY_END(details);
 
     do {
        newXS_flags(xsub->name, xsub->xsub, file, xsub->proto, 0);