No more late changes, dammit

[p5sagit/p5-mst-13.2.git] / ext / B / B.xs

diff --git a/ext/B/B.xs b/ext/B/B.xs
index 868f15b..63f5a99 100644 (file)
--- a/ext/B/B.xs
+++ b/ext/B/B.xs
@@ -29,11 +29,16 @@ static char *svclassnames[] = {
     "B::PVNV",
     "B::PVMG",
     "B::BM",
+#if PERL_VERSION >= 9
+    "B::GV",
+#endif
     "B::PVLV",
     "B::AV",
     "B::HV",
     "B::CV",
+#if PERL_VERSION <= 8
     "B::GV",
+#endif
     "B::FM",
     "B::IO",
 };
@@ -411,6 +416,50 @@ walkoptree(pTHX_ SV *opsv, char *method)
     }
 }
 
+SV **
+oplist(pTHX_ OP *o, SV **SP)
+{
+    for(; o; o = o->op_next) {
+       SV *opsv;
+#if PERL_VERSION >= 9
+       if (o->op_opt == 0)
+           break;
+       o->op_opt = 0;
+#else
+       if (o->op_seq == 0)
+           break;
+       o->op_seq = 0;
+#endif
+       opsv = sv_newmortal();
+       sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ (OP*)o)), PTR2IV(o));
+       XPUSHs(opsv);
+        switch (o->op_type) {
+       case OP_SUBST:
+            SP = oplist(aTHX_ cPMOPo->op_pmreplstart, SP);
+            continue;
+       case OP_SORT:
+           if (o->op_flags & OPf_STACKED && o->op_flags & OPf_SPECIAL) {
+               OP *kid = cLISTOPo->op_first->op_sibling;   /* pass pushmark */
+               kid = kUNOP->op_first;                      /* pass rv2gv */
+               kid = kUNOP->op_first;                      /* pass leave */
+               SP = oplist(aTHX_ kid->op_next, SP);
+           }
+           continue;
+        }
+       switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
+       case OA_LOGOP:
+           SP = oplist(aTHX_ cLOGOPo->op_other, SP);
+           break;
+       case OA_LOOP:
+           SP = oplist(aTHX_ cLOOPo->op_lastop, SP);
+           SP = oplist(aTHX_ cLOOPo->op_nextop, SP);
+           SP = oplist(aTHX_ cLOOPo->op_redoop, SP);
+           break;
+       }
+    }
+    return SP;
+}
+
 typedef OP     *B__OP;
 typedef UNOP   *B__UNOP;
 typedef BINOP  *B__BINOP;
@@ -431,6 +480,7 @@ typedef SV  *B__PVMG;
 typedef SV     *B__PVLV;
 typedef SV     *B__BM;
 typedef SV     *B__RV;
+typedef SV     *B__FM;
 typedef AV     *B__AV;
 typedef HV     *B__HV;
 typedef CV     *B__CV;
@@ -455,6 +505,9 @@ BOOT:
     specialsv_list[4] = pWARN_ALL;
     specialsv_list[5] = pWARN_NONE;
     specialsv_list[6] = pWARN_STD;
+#if PERL_VERSION <= 8
+#  define CVf_ASSERTION        0
+#endif
 #include "defsubs.h"
 }
 
@@ -474,6 +527,7 @@ BOOT:
 #define B_sv_undef()   &PL_sv_undef
 #define B_sv_yes()     &PL_sv_yes
 #define B_sv_no()      &PL_sv_no
+#define B_formfeed()   PL_formfeed
 #ifdef USE_ITHREADS
 #define B_regex_padav()        PL_regex_padav
 #endif
@@ -533,6 +587,9 @@ B_defstash()
 U8
 B_dowarn()
 
+B::SV
+B_formfeed()
+
 void
 B_warnhook()
     CODE:
@@ -664,16 +721,31 @@ cchar(sv)
 void
 threadsv_names()
     PPCODE:
+#if PERL_VERSION <= 8
+# ifdef USE_5005THREADS
+       int i;
+       STRLEN len = strlen(PL_threadsv_names);
 
+       EXTEND(sp, len);
+       for (i = 0; i < len; i++)
+           PUSHs(sv_2mortal(newSVpvn(&PL_threadsv_names[i], 1)));
+# endif
+#endif
 
 #define OP_next(o)     o->op_next
 #define OP_sibling(o)  o->op_sibling
 #define OP_desc(o)     PL_op_desc[o->op_type]
 #define OP_targ(o)     o->op_targ
 #define OP_type(o)     o->op_type
-#define OP_seq(o)      o->op_seq
+#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
 #define OP_flags(o)    o->op_flags
 #define OP_private(o)  o->op_private
+#define OP_spare(o)    o->op_spare
 
 MODULE = B     PACKAGE = B::OP         PREFIX = OP_
 
@@ -728,10 +800,24 @@ U16
 OP_type(o)
        B::OP           o
 
+#if PERL_VERSION >= 9
+
+U8
+OP_opt(o)
+       B::OP           o
+
+U8
+OP_static(o)
+       B::OP           o
+
+#else
+
 U16
 OP_seq(o)
        B::OP           o
 
+#endif
+
 U8
 OP_flags(o)
        B::OP           o
@@ -740,6 +826,20 @@ U8
 OP_private(o)
        B::OP           o
 
+#if PERL_VERSION >= 9
+
+U8
+OP_spare(o)
+       B::OP           o
+
+#endif
+
+void
+OP_oplist(o)
+       B::OP           o
+    PPCODE:
+       SP = oplist(aTHX_ o, SP);
+
 #define UNOP_first(o)  o->op_first
 
 MODULE = B     PACKAGE = B::UNOP               PREFIX = UNOP_
@@ -944,6 +1044,7 @@ LOOP_lastop(o)
 #define COP_stashpv(o) CopSTASHPV(o)
 #define COP_stash(o)   CopSTASH(o)
 #define COP_file(o)    CopFILE(o)
+#define COP_filegv(o)  CopFILEGV(o)
 #define COP_cop_seq(o) o->cop_seq
 #define COP_arybase(o) o->cop_arybase
 #define COP_line(o)    CopLINE(o)
@@ -968,6 +1069,11 @@ char *
 COP_file(o)
        B::COP  o
 
+B::GV
+COP_filegv(o)
+       B::COP  o
+
+
 U32
 COP_cop_seq(o)
        B::COP  o
@@ -976,7 +1082,7 @@ I32
 COP_arybase(o)
        B::COP  o
 
-U16
+U32
 COP_line(o)
        B::COP  o
 
@@ -994,6 +1100,13 @@ U32
 SvTYPE(sv)
        B::SV   sv
 
+#define object_2svref(sv)      sv
+#define SVREF SV *
+       
+SVREF
+object_2svref(sv)
+       B::SV   sv
+
 MODULE = B     PACKAGE = B::SV         PREFIX = Sv
 
 U32
@@ -1307,9 +1420,13 @@ B::IO
 GvIO(gv)
        B::GV   gv
 
-B::CV
+B::FM
 GvFORM(gv)
        B::GV   gv
+    CODE:
+       RETVAL = (SV*)GvFORM(gv);
+    OUTPUT:
+       RETVAL
 
 B::AV
 GvAV(gv)
@@ -1331,7 +1448,7 @@ U32
 GvCVGEN(gv)
        B::GV   gv
 
-U16
+U32
 GvLINE(gv)
        B::GV   gv
 
@@ -1459,12 +1576,29 @@ AvARRAY(av)
                XPUSHs(make_sv_object(aTHX_ sv_newmortal(), svp[i]));
        }
 
+void
+AvARRAYelt(av, idx)
+       B::AV   av
+       int     idx
+    PPCODE:
+       if (idx >= 0 && AvFILL(av) >= 0 && idx <= AvFILL(av))
+           XPUSHs(make_sv_object(aTHX_ sv_newmortal(), (AvARRAY(av)[idx])));
+       else
+           XPUSHs(make_sv_object(aTHX_ sv_newmortal(), NULL));
+
+                                  
 MODULE = B     PACKAGE = B::AV
 
 U8
 AvFLAGS(av)
        B::AV   av
 
+MODULE = B     PACKAGE = B::FM         PREFIX = Fm
+
+IV
+FmLINES(form)
+       B::FM   form
+
 MODULE = B     PACKAGE = B::CV         PREFIX = Cv
 
 U32