This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Merge the implementation of B::COP::{io,warnings} using ALIAS.
[perl5.git] / ext / B / B.xs
index fb450ef..06d89b1 100644 (file)
@@ -291,8 +291,9 @@ make_temp_object(pTHX_ SV *temp)
 }
 
 static SV *
-make_warnings_object(pTHX_ STRLEN *warnings)
+make_warnings_object(pTHX_ const COP *const cop)
 {
+    const STRLEN *const warnings = cop->cop_warnings;
     const char *type = 0;
     dMY_CXT;
     IV iv = sizeof(specialsv_list)/sizeof(SV*);
@@ -894,10 +895,10 @@ threadsv_names()
 #define COP_filegv_ix          SVp | offsetof(struct cop, cop_filegv)
 #endif
 
-MODULE = B     PACKAGE = B::OP         PREFIX = OP_
+MODULE = B     PACKAGE = B::OP
 
 size_t
-OP_size(o)
+size(o)
        B::OP           o
     CODE:
        RETVAL = opsizes[cc_opclass(aTHX_ o)];
@@ -971,7 +972,7 @@ next(o)
        XSRETURN(1);
 
 char *
-OP_name(o)
+name(o)
        B::OP           o
     ALIAS:
        desc = 1
@@ -981,7 +982,7 @@ OP_name(o)
        RETVAL
 
 void
-OP_ppaddr(o)
+ppaddr(o)
        B::OP           o
     PREINIT:
        int i;
@@ -996,7 +997,7 @@ OP_ppaddr(o)
 #if PERL_VERSION >= 9
 #  These 3 are all bitfields, so we can't take their addresses.
 UV
-OP_type(o)
+type(o)
        B::OP           o
     ALIAS:
        opt = 1
@@ -1018,7 +1019,7 @@ OP_type(o)
 #else
 
 UV
-OP_type(o)
+type(o)
        B::OP           o
     ALIAS:
        seq = 1
@@ -1036,15 +1037,15 @@ OP_type(o)
 #endif
 
 void
-OP_oplist(o)
+oplist(o)
        B::OP           o
     PPCODE:
        SP = oplist(aTHX_ o, SP);
 
-MODULE = B     PACKAGE = B::LISTOP             PREFIX = LISTOP_
+MODULE = B     PACKAGE = B::LISTOP
 
 U32
-LISTOP_children(o)
+children(o)
        B::LISTOP       o
        OP *            kid = NO_INIT
        int             i = NO_INIT
@@ -1203,10 +1204,10 @@ sv(o)
     OUTPUT:
        RETVAL
 
-MODULE = B     PACKAGE = B::PVOP               PREFIX = PVOP_
+MODULE = B     PACKAGE = B::PVOP
 
 void
-PVOP_pv(o)
+pv(o)
        B::PVOP o
     CODE:
        /*
@@ -1242,28 +1243,28 @@ COP_label(o)
 # above (B::OP::next)
  
 #ifdef USE_ITHREADS
-#define COP_stash(o)   CopSTASH(o)
-#define COP_filegv(o)  CopFILEGV(o)
 
-B::HV
+B::SV
 COP_stash(o)
        B::COP  o
-
-B::GV
-COP_filegv(o)
-       B::COP  o
+    ALIAS:
+       filegv = 1
+    CODE:
+       RETVAL = ix ? (SV *)CopFILEGV(o) : (SV *)CopSTASH(o);
+    OUTPUT:
+       RETVAL
 
 #else
-#define COP_stashpv(o) CopSTASHPV(o)
-#define COP_file(o)    CopFILE(o)
 
 char *
 COP_stashpv(o)
        B::COP  o
-
-char *
-COP_file(o)
-       B::COP  o
+    ALIAS:
+       file = 1
+    CODE:
+       RETVAL = ix ? CopFILE(o) : CopSTASHPV(o);
+    OUTPUT:
+       RETVAL
 
 #endif
 
@@ -1274,22 +1275,13 @@ COP_arybase(o)
 void
 COP_warnings(o)
        B::COP  o
-       PPCODE:
-#if PERL_VERSION >= 9
-       ST(0) = make_warnings_object(aTHX_ o->cop_warnings);
-#else
-       ST(0) = make_sv_object(aTHX_ NULL, o->cop_warnings);
-#endif
-       XSRETURN(1);
-
-void
-COP_io(o)
-       B::COP  o
-       PPCODE:
+    ALIAS:
+       io = 1
+    PPCODE:
 #if PERL_VERSION >= 9
-       ST(0) = make_cop_io_object(aTHX_ o);
+       ST(0) = ix ? make_cop_io_object(aTHX_ o) : make_warnings_object(aTHX_ o);
 #else
-       ST(0) = make_sv_object(aTHX_ NULL, o->cop_io);
+       ST(0) = make_sv_object(aTHX_ NULL, ix ? o->cop_io : o->cop_warnings);
 #endif
        XSRETURN(1);
 
@@ -1578,16 +1570,30 @@ B::SV
 SvRV(sv)
        B::RV   sv
 
-#endif
+#else
 
-MODULE = B     PACKAGE = B::PV         PREFIX = Sv
+MODULE = B     PACKAGE = B::REGEXP
 
-char*
-SvPVX(sv)
-       B::PV   sv
+void
+REGEX(sv)
+       B::REGEXP       sv
+    ALIAS:
+       precomp = 1
+    PPCODE:
+       if (ix) {
+           PUSHs(newSVpvn_flags(RX_PRECOMP(sv), RX_PRELEN(sv), SVs_TEMP));
+       } else {
+           dXSTARG;
+           /* FIXME - can we code this method more efficiently?  */
+           PUSHi(PTR2IV(sv));
+       }
+
+#endif
+
+MODULE = B     PACKAGE = B::PV
 
 B::SV
-SvRV(sv)
+RV(sv)
         B::PV   sv
     CODE:
         if( SvROK(sv) ) {
@@ -1600,12 +1606,39 @@ SvRV(sv)
         RETVAL
 
 void
-SvPV(sv)
+PV(sv)
        B::PV   sv
+    ALIAS:
+       PVX = 1
+       PVBM = 2
+       B::BM::TABLE = 3
+    PREINIT:
+       const char *p;
+       STRLEN len = 0;
+       U32 utf8 = 0;
     CODE:
-        if( SvPOK(sv) ) {
-           STRLEN len = SvCUR(sv);
-           const char *p = SvPVX_const(sv);
+       if (ix == 3) {
+           p = SvPV(sv, len);
+           /* Boyer-Moore table is just after string and its safety-margin \0 */
+           p += len + PERL_FBM_TABLE_OFFSET;
+           len = 256;
+       } else if (ix == 2) {
+           /* This used to read 257. I think that that was buggy - should have
+              been 258. (The "\0", the flags byte, and 256 for the table.  Not
+              that anything anywhere calls this method.  NWC.  */
+           /* Also, the start pointer has always been SvPVX(sv). Surely it
+              should be SvPVX(sv) + SvCUR(sv)?  The code has faithfully been
+              refactored with this behaviour, since PVBM was added in
+              651aa52ea1faa806.  */
+           p = SvPVX_const(sv);
+           len = SvCUR(sv) + (SvVALID(sv) ? 256 + PERL_FBM_TABLE_OFFSET : 0);
+       } else if (ix) {
+           p = SvPVX(sv);
+           len = strlen(p);
+       } else if (SvPOK(sv)) {
+           len = SvCUR(sv);
+           p = SvPVX_const(sv);
+           utf8 = SvUTF8(sv);
 #if PERL_VERSION < 10
            /* Before 5.10 (well 931b58fb28fa5ca7), PAD_COMPNAME_GEN was stored
               in SvCUR(), which meant we had to attempt this special casing
@@ -1616,58 +1649,24 @@ SvPV(sv)
                len = strlen(p);
            }
 #endif
-           ST(0) = newSVpvn_flags(p, len, SVs_TEMP | SvUTF8(sv));
         }
         else {
             /* XXX for backward compatibility, but should fail */
             /* croak( "argument is not SvPOK" ); */
-            ST(0) = sv_newmortal();
+           p = NULL;
         }
+       ST(0) = newSVpvn_flags(p, len, SVs_TEMP | utf8);
 
-# This used to read 257. I think that that was buggy - should have been 258.
-# (The "\0", the flags byte, and 256 for the table.  Not that anything
-# anywhere calls this method.  NWC.
-void
-SvPVBM(sv)
-       B::PV   sv
-    CODE:
-        ST(0) = newSVpvn_flags(SvPVX_const(sv),
-           SvCUR(sv) + (SvVALID(sv) ? 256 + PERL_FBM_TABLE_OFFSET : 0),
-           SVs_TEMP);
-
-MODULE = B     PACKAGE = B::PVMG       PREFIX = Sv
+MODULE = B     PACKAGE = B::PVMG
 
 void
-SvMAGIC(sv)
+MAGIC(sv)
        B::PVMG sv
        MAGIC * mg = NO_INIT
     PPCODE:
        for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic)
            XPUSHs(make_mg_object(aTHX_ mg));
 
-MODULE = B     PACKAGE = B::REGEXP
-
-#if PERL_VERSION >= 11
-
-IV
-REGEX(sv)
-       B::REGEXP       sv
-    CODE:
-       /* FIXME - can we code this method more efficiently?  */
-       RETVAL = PTR2IV(sv);
-    OUTPUT:
-        RETVAL
-
-SV*
-precomp(sv)
-       B::REGEXP       sv
-    CODE:
-       RETVAL = newSVpvn( RX_PRECOMP(sv), RX_PRELEN(sv) );
-    OUTPUT:
-        RETVAL
-
-#endif
-
 MODULE = B     PACKAGE = B::MAGIC
 
 void
@@ -1732,18 +1731,6 @@ MOREMAGIC(mg)
            break;
        }
 
-MODULE = B     PACKAGE = B::BM         PREFIX = Bm
-
-void
-BmTABLE(sv)
-       B::BM   sv
-       STRLEN  len = NO_INIT
-       char *  str = NO_INIT
-    CODE:
-       str = SvPV(sv, len);
-       /* Boyer-Moore table is just after string and its safety-margin \0 */
-       ST(0) = newSVpvn_flags(str + len + PERL_FBM_TABLE_OFFSET, 256, SVs_TEMP);
-
 MODULE = B     PACKAGE = B::GV         PREFIX = Gv
 
 void
@@ -1999,12 +1986,12 @@ U32
 HeHASH(he)
        B::HE he
 
-MODULE = B     PACKAGE = B::RHE        PREFIX = RHE_
+MODULE = B     PACKAGE = B::RHE
 
 #if PERL_VERSION >= 9
 
 SV*
-RHE_HASH(h)
+HASH(h)
        B::RHE h
     CODE:
        RETVAL = newRV( (SV*)cophh_2hv(h, 0) );