Upgrade to Win32API-File 0.1101
[p5sagit/p5-mst-13.2.git] / ext / B / B.xs
index 6fdac03..eca6f08 100644 (file)
@@ -26,7 +26,9 @@ static const char* const svclassnames[] = {
 #endif
     "B::IV",
     "B::NV",
+#if PERL_VERSION <= 10
     "B::RV",
+#endif
     "B::PV",
     "B::PVIV",
     "B::PVNV",
@@ -34,6 +36,9 @@ static const char* const svclassnames[] = {
 #if PERL_VERSION <= 8
     "B::BM",
 #endif
+#if PERL_VERSION >= 11
+    "B::REGEXP",
+#endif
 #if PERL_VERSION >= 9
     "B::GV",
 #endif
@@ -458,6 +463,16 @@ cchar(pTHX_ SV *sv)
     return sstr;
 }
 
+#if PERL_VERSION >= 9
+#  define PMOP_pmreplstart(o)  o->op_pmstashstartu.op_pmreplstart
+#  define PMOP_pmreplroot(o)   o->op_pmreplrootu.op_pmreplroot
+#else
+#  define PMOP_pmreplstart(o)  o->op_pmreplstart
+#  define PMOP_pmreplroot(o)   o->op_pmreplroot
+#  define PMOP_pmpermflags(o)  o->op_pmpermflags
+#  define PMOP_pmdynflags(o)      o->op_pmdynflags
+#endif
+
 static void
 walkoptree(pTHX_ SV *opsv, const char *method)
 {
@@ -487,7 +502,7 @@ walkoptree(pTHX_ SV *opsv, const char *method)
        }
     }
     if (o && (cc_opclass(aTHX_ o) == OPc_PMOP) && o->op_type != OP_PUSHRE
-           && (kid = cPMOPo->op_pmreplroot))
+           && (kid = PMOP_pmreplroot(cPMOPo)))
     {
        sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid));
        walkoptree(aTHX_ opsv, method);
@@ -513,7 +528,7 @@ oplist(pTHX_ OP *o, SV **SP)
        XPUSHs(opsv);
         switch (o->op_type) {
        case OP_SUBST:
-            SP = oplist(aTHX_ cPMOPo->op_pmreplstart, SP);
+            SP = oplist(aTHX_ PMOP_pmreplstart(cPMOPo), SP);
             continue;
        case OP_SORT:
            if (o->op_flags & OPf_STACKED && o->op_flags & OPf_SPECIAL) {
@@ -555,6 +570,9 @@ typedef SV  *B__IV;
 typedef SV     *B__PV;
 typedef SV     *B__NV;
 typedef SV     *B__PVMG;
+#if PERL_VERSION >= 11
+typedef SV     *B__REGEXP;
+#endif
 typedef SV     *B__PVLV;
 typedef SV     *B__BM;
 typedef SV     *B__RV;
@@ -588,7 +606,6 @@ BOOT:
     specialsv_list[5] = (SV *) pWARN_NONE;
     specialsv_list[6] = (SV *) pWARN_STD;
 #if PERL_VERSION <= 8
-#  define CVf_ASSERTION        0
 #  define OPpPAD_STATE 0
 #endif
 #include "defsubs.h"
@@ -837,7 +854,6 @@ threadsv_names()
 #define OP_type(o)     o->op_type
 #if PERL_VERSION >= 9
 #  define OP_opt(o)    o->op_opt
-#  define OP_static(o) o->op_static
 #else
 #  define OP_seq(o)    o->op_seq
 #endif
@@ -900,14 +916,10 @@ OP_type(o)
 
 #if PERL_VERSION >= 9
 
-U8
+U16
 OP_opt(o)
        B::OP           o
 
-U8
-OP_static(o)
-       B::OP           o
-
 #else
 
 U16
@@ -926,7 +938,7 @@ OP_private(o)
 
 #if PERL_VERSION >= 9
 
-U8
+U16
 OP_spare(o)
        B::OP           o
 
@@ -977,22 +989,20 @@ LISTOP_children(o)
     OUTPUT:
         RETVAL
 
-#define PMOP_pmreplroot(o)     o->op_pmreplroot
-#define PMOP_pmreplstart(o)    o->op_pmreplstart
 #define PMOP_pmnext(o)         o->op_pmnext
 #define PMOP_pmregexp(o)       PM_GETRE(o)
 #ifdef USE_ITHREADS
 #define PMOP_pmoffset(o)       o->op_pmoffset
-#define PMOP_pmstashpv(o)      o->op_pmstashpv
+#define PMOP_pmstashpv(o)      PmopSTASHPV(o);
 #else
-#define PMOP_pmstash(o)                o->op_pmstash
+#define PMOP_pmstash(o)                PmopSTASH(o);
 #endif
 #define PMOP_pmflags(o)                o->op_pmflags
-#define PMOP_pmpermflags(o)    o->op_pmpermflags
-#define PMOP_pmdynflags(o)      o->op_pmdynflags
 
 MODULE = B     PACKAGE = B::PMOP               PREFIX = PMOP_
 
+#if PERL_VERSION <= 8
+
 void
 PMOP_pmreplroot(o)
        B::PMOP         o
@@ -1002,26 +1012,55 @@ PMOP_pmreplroot(o)
        root = o->op_pmreplroot;
        /* OP_PUSHRE stores an SV* instead of an OP* in op_pmreplroot */
        if (o->op_type == OP_PUSHRE) {
-#ifdef USE_ITHREADS
+#  ifdef USE_ITHREADS
             sv_setiv(ST(0), INT2PTR(PADOFFSET,root) );
-#else
+#  else
            sv_setiv(newSVrv(ST(0), root ?
                             svclassnames[SvTYPE((SV*)root)] : "B::SV"),
                     PTR2IV(root));
-#endif
+#  endif
        }
        else {
            sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), PTR2IV(root));
        }
 
+#else
+
+void
+PMOP_pmreplroot(o)
+       B::PMOP         o
+    CODE:
+       ST(0) = sv_newmortal();
+       if (o->op_type == OP_PUSHRE) {
+#  ifdef USE_ITHREADS
+            sv_setiv(ST(0), o->op_pmreplrootu.op_pmtargetoff);
+#  else
+           GV *const target = o->op_pmreplrootu.op_pmtargetgv;
+           sv_setiv(newSVrv(ST(0), target ?
+                            svclassnames[SvTYPE((SV*)target)] : "B::SV"),
+                    PTR2IV(target));
+#  endif
+       }
+       else {
+           OP *const root = o->op_pmreplrootu.op_pmreplroot; 
+           sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)),
+                    PTR2IV(root));
+       }
+
+#endif
+
 B::OP
 PMOP_pmreplstart(o)
        B::PMOP         o
 
+#if PERL_VERSION < 9
+
 B::PMOP
 PMOP_pmnext(o)
        B::PMOP         o
 
+#endif
+
 #ifdef USE_ITHREADS
 
 IV
@@ -1044,6 +1083,8 @@ U32
 PMOP_pmflags(o)
        B::PMOP         o
 
+#if PERL_VERSION < 9
+
 U32
 PMOP_pmpermflags(o)
        B::PMOP         o
@@ -1052,6 +1093,8 @@ U8
 PMOP_pmdynflags(o)
         B::PMOP         o
 
+#endif
+
 void
 PMOP_precomp(o)
        B::PMOP         o
@@ -1060,7 +1103,21 @@ PMOP_precomp(o)
        ST(0) = sv_newmortal();
        rx = PM_GETRE(o);
        if (rx)
-           sv_setpvn(ST(0), rx->precomp, rx->prelen);
+           sv_setpvn(ST(0), RX_PRECOMP(rx), RX_PRELEN(rx));
+
+#if PERL_VERSION >= 9
+
+void
+PMOP_reflags(o)
+       B::PMOP         o
+       REGEXP *        rx = NO_INIT
+    CODE:
+       ST(0) = sv_newmortal();
+       rx = PM_GETRE(o);
+       if (rx)
+           sv_setuv(ST(0), RX_EXTFLAGS(rx));
+
+#endif
 
 #define SVOP_sv(o)     cSVOPo->op_sv
 #define SVOP_gv(o)     ((GV*)cSVOPo->op_sv)
@@ -1079,7 +1136,7 @@ SVOP_gv(o)
 #define PADOP_sv(o)    (o->op_padix ? PAD_SVl(o->op_padix) : Nullsv)
 #define PADOP_gv(o)    ((o->op_padix \
                          && SvTYPE(PAD_SVl(o->op_padix)) == SVt_PVGV) \
-                        ? (GV*)PAD_SVl(o->op_padix) : Nullgv)
+                        ? (GV*)PAD_SVl(o->op_padix) : (GV *)NULL)
 
 MODULE = B     PACKAGE = B::PADOP              PREFIX = PADOP_
 
@@ -1138,7 +1195,7 @@ B::OP
 LOOP_lastop(o)
        B::LOOP o
 
-#define COP_label(o)   o->cop_label
+#define COP_label(o)   CopLABEL(o)
 #define COP_stashpv(o) CopSTASHPV(o)
 #define COP_stash(o)   CopSTASH(o)
 #define COP_file(o)    CopFILE(o)
@@ -1154,10 +1211,20 @@ LOOP_lastop(o)
 
 MODULE = B     PACKAGE = B::COP                PREFIX = COP_
 
+#if PERL_VERSION >= 11
+
+const char *
+COP_label(o)
+       B::COP  o
+
+#else
+
 char *
 COP_label(o)
        B::COP  o
 
+#endif
+
 char *
 COP_stashpv(o)
        B::COP  o
@@ -1311,6 +1378,24 @@ packiv(sv)
            ST(0) = sv_2mortal(newSVpvn((char *)&w, 4));
        }
 
+
+#if PERL_VERSION >= 11
+
+B::SV
+RV(sv)
+        B::IV   sv
+    CODE:
+        if( SvROK(sv) ) {
+            RETVAL = SvRV(sv);
+        }
+        else {
+            croak( "argument is not SvROK" );
+        }
+    OUTPUT:
+        RETVAL
+
+#endif
+
 MODULE = B     PACKAGE = B::NV         PREFIX = Sv
 
 NV
@@ -1337,12 +1422,16 @@ U32
 PARENT_FAKELEX_FLAGS(sv)
        B::NV   sv
 
+#if PERL_VERSION < 11
+
 MODULE = B     PACKAGE = B::RV         PREFIX = Sv
 
 B::SV
 SvRV(sv)
        B::RV   sv
 
+#endif
+
 MODULE = B     PACKAGE = B::PV         PREFIX = Sv
 
 char*
@@ -1421,6 +1510,29 @@ B::HV
 SvSTASH(sv)
        B::PVMG sv
 
+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
+
 #define MgMOREMAGIC(mg) mg->mg_moremagic
 #define MgPRIVATE(mg) mg->mg_private
 #define MgTYPE(mg) mg->mg_type
@@ -1481,7 +1593,7 @@ precomp(mg)
             REGEXP* rx = (REGEXP*)mg->mg_obj;
             RETVAL = Nullsv;
             if( rx )
-                RETVAL = newSVpvn( rx->precomp, rx->prelen );
+                RETVAL = newSVpvn( RX_PRECOMP(rx), RX_PRELEN(rx) );
         }
         else {
             croak( "precomp is only meaningful on r-magic" );
@@ -1565,6 +1677,18 @@ is_empty(gv)
     OUTPUT:
         RETVAL
 
+bool
+isGV_with_GP(gv)
+       B::GV   gv
+    CODE:
+#if PERL_VERSION >= 9
+       RETVAL = isGV_with_GP(gv) ? TRUE : FALSE;
+#else
+       RETVAL = TRUE; /* In 5.8 and earlier they all are.  */
+#endif
+    OUTPUT:
+       RETVAL
+
 void*
 GvGP(gv)
        B::GV   gv
@@ -1673,10 +1797,14 @@ B::GV
 IoBOTTOM_GV(io)
        B::IO   io
 
+#if PERL_VERSION <= 8
+
 short
 IoSUBPROCESS(io)
        B::IO   io
 
+#endif
+
 bool
 IsSTD(io,name)
        B::IO   io
@@ -1887,7 +2015,7 @@ HvARRAY(hv)
            (void)hv_iterinit(hv);
            EXTEND(sp, HvKEYS(hv) * 2);
            while ((sv = hv_iternextsv(hv, &key, &len))) {
-               PUSHs(newSVpvn(key, len));
+               mPUSHp(key, len);
                PUSHs(make_sv_object(aTHX_ sv_newmortal(), sv));
            }
        }