Misapplied regex optimizations when \C is present.
[p5sagit/p5-mst-13.2.git] / ext / B / B.xs
index 570b001..25d69e9 100644 (file)
@@ -56,7 +56,7 @@ typedef enum {
     OPc_LISTOP,        /* 5 */
     OPc_PMOP,  /* 6 */
     OPc_SVOP,  /* 7 */
-    OPc_GVOP,  /* 8 */
+    OPc_PADOP, /* 8 */
     OPc_PVOP,  /* 9 */
     OPc_CVOP,  /* 10 */
     OPc_LOOP,  /* 11 */
@@ -72,7 +72,7 @@ static char *opclassnames[] = {
     "B::LISTOP",
     "B::PMOP",
     "B::SVOP",
-    "B::GVOP",
+    "B::PADOP",
     "B::PVOP",
     "B::CVOP",
     "B::LOOP",
@@ -81,7 +81,7 @@ static char *opclassnames[] = {
 
 static int walkoptree_debug = 0;       /* Flag for walkoptree debug hook */
 
-static SV *specialsv_list[4];
+static SV *specialsv_list[6];
 
 static opclass
 cc_opclass(pTHX_ OP *o)
@@ -95,6 +95,11 @@ cc_opclass(pTHX_ OP *o)
     if (o->op_type == OP_SASSIGN)
        return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
 
+#ifdef USE_ITHREADS
+    if (o->op_type == OP_GV || o->op_type == OP_GVSV || o->op_type == OP_AELEMFAST)
+       return OPc_PADOP;
+#endif
+
     switch (PL_opargs[o->op_type] & OA_CLASS_MASK) {
     case OA_BASEOP:
        return OPc_BASEOP;
@@ -117,8 +122,8 @@ cc_opclass(pTHX_ OP *o)
     case OA_SVOP:
        return OPc_SVOP;
 
-    case OA_GVOP:
-       return OPc_GVOP;
+    case OA_PADOP:
+       return OPc_PADOP;
 
     case OA_PVOP_OR_SVOP:
         /*
@@ -155,11 +160,14 @@ cc_opclass(pTHX_ OP *o)
         * return OPc_UNOP so that walkoptree can find our children. If
         * OPf_KIDS is not set then we check OPf_REF. Without OPf_REF set
         * (no argument to the operator) it's an OP; with OPf_REF set it's
-        * a GVOP (and op_gv is the GV for the filehandle argument).
+        * an SVOP (and op_sv is the GV for the filehandle argument).
         */
        return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
-               (o->op_flags & OPf_REF) ? OPc_GVOP : OPc_BASEOP);
-
+#ifdef USE_ITHREADS
+               (o->op_flags & OPf_REF) ? OPc_PADOP : OPc_BASEOP);
+#else
+               (o->op_flags & OPf_REF) ? OPc_SVOP : OPc_BASEOP);
+#endif
     case OA_LOOPEXOP:
        /*
         * next, last, redo, dump and goto use OPf_SPECIAL to indicate that a
@@ -202,7 +210,7 @@ make_sv_object(pTHX_ SV *arg, SV *sv)
     }
     if (!type) {
        type = svclassnames[SvTYPE(sv)];
-       iv = (IV)sv;
+       iv = PTR2IV(sv);
     }
     sv_setiv(newSVrv(arg, type), iv);
     return arg;
@@ -211,7 +219,7 @@ make_sv_object(pTHX_ SV *arg, SV *sv)
 static SV *
 make_mg_object(pTHX_ SV *arg, MAGIC *mg)
 {
-    sv_setiv(newSVrv(arg, "B::MAGIC"), (IV)mg);
+    sv_setiv(newSVrv(arg, "B::MAGIC"), PTR2IV(mg));
     return arg;
 }
 
@@ -317,7 +325,7 @@ walkoptree(pTHX_ SV *opsv, char *method)
     if (!SvROK(opsv))
        croak("opsv is not a reference");
     opsv = sv_mortalcopy(opsv);
-    o = (OP*)SvIV((SV*)SvRV(opsv));
+    o = INT2PTR(OP*,SvIV((SV*)SvRV(opsv)));
     if (walkoptree_debug) {
        PUSHMARK(sp);
        XPUSHs(opsv);
@@ -332,7 +340,7 @@ walkoptree(pTHX_ SV *opsv, char *method)
        OP *kid;
        for (kid = ((UNOP*)o)->op_first; kid; kid = kid->op_sibling) {
            /* Use the same opsv. Rely on methods not to mess it up. */
-           sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), (IV)kid);
+           sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid));
            walkoptree(aTHX_ opsv, method);
        }
     }
@@ -345,7 +353,7 @@ typedef LOGOP       *B__LOGOP;
 typedef LISTOP *B__LISTOP;
 typedef PMOP   *B__PMOP;
 typedef SVOP   *B__SVOP;
-typedef GVOP   *B__GVOP;
+typedef PADOP  *B__PADOP;
 typedef PVOP   *B__PVOP;
 typedef LOOP   *B__LOOP;
 typedef COP    *B__COP;
@@ -378,11 +386,15 @@ BOOT:
     specialsv_list[1] = &PL_sv_undef;
     specialsv_list[2] = &PL_sv_yes;
     specialsv_list[3] = &PL_sv_no;
+    specialsv_list[4] = pWARN_ALL;
+    specialsv_list[5] = pWARN_NONE;
 #include "defsubs.h"
 }
 
 #define B_main_cv()    PL_main_cv
 #define B_init_av()    PL_initav
+#define B_begin_av()   PL_beginav_save
+#define B_end_av()     PL_endav
 #define B_main_root()  PL_main_root
 #define B_main_start() PL_main_start
 #define B_amagic_generation()  PL_amagic_generation
@@ -394,6 +406,12 @@ BOOT:
 B::AV
 B_init_av()
 
+B::AV
+B_begin_av()
+
+B::AV
+B_end_av()
+
 B::CV
 B_main_cv()
 
@@ -437,7 +455,7 @@ walkoptree_debug(...)
     OUTPUT:
        RETVAL
 
-#define address(sv) (IV)sv
+#define address(sv) PTR2IV(sv)
 
 IV
 address(sv)
@@ -491,10 +509,10 @@ hash(sv)
        char *s;
        STRLEN len;
        U32 hash = 0;
-       char hexhash[19]; /* must fit "0xffffffff" plus trailing \0 */
+       char hexhash[19]; /* must fit "0xffffffffffffffff" plus trailing \0 */
        s = SvPV(sv, len);
        PERL_HASH(hash, s, len);
-       sprintf(hexhash, "0x%x", hash);
+       sprintf(hexhash, "0x%"UVxf, (UV)hash);
        ST(0) = sv_2mortal(newSVpv(hexhash, 0));
 
 #define cast_I32(foo) (I32)foo
@@ -507,6 +525,11 @@ minus_c()
     CODE:
        PL_minus_c = TRUE;
 
+void
+save_BEGINs()
+    CODE:
+       PL_minus_c |= 0x10;
+
 SV *
 cstring(sv)
        SV *    sv
@@ -566,16 +589,22 @@ OP_name(o)
 char *
 OP_ppaddr(o)
        B::OP           o
+    PREINIT:
+       int i;
+       SV *sv = sv_newmortal();
     CODE:
-       ST(0) = sv_newmortal();
-       sv_setpvn(ST(0), "Perl_pp_", 8);
-       sv_catpv(ST(0), PL_op_name[o->op_type]);
+       sv_setpvn(sv, "PL_ppaddr[OP_", 13);
+       sv_catpv(sv, PL_op_name[o->op_type]);
+       for (i=13; i<SvCUR(sv); ++i)
+           SvPVX(sv)[i] = toUPPER(SvPVX(sv)[i]);
+       sv_catpv(sv, "]");
+       ST(0) = sv;
 
 char *
 OP_desc(o)
        B::OP           o
 
-U16
+PADOFFSET
 OP_targ(o)
        B::OP           o
 
@@ -619,13 +648,19 @@ B::OP
 LOGOP_other(o)
        B::LOGOP        o
 
-#define LISTOP_children(o)     o->op_children
-
 MODULE = B     PACKAGE = B::LISTOP             PREFIX = LISTOP_
 
 U32
 LISTOP_children(o)
        B::LISTOP       o
+       OP *            kid = NO_INIT
+       int             i = NO_INIT
+    CODE:
+       ST(0) = sv_newmortal();
+       i = 0;
+       for (kid = o->op_first; kid; kid = kid->op_sibling)
+           i++;
+       sv_setiv(ST(0), i);
 
 #define PMOP_pmreplroot(o)     o->op_pmreplroot
 #define PMOP_pmreplstart(o)    o->op_pmreplstart
@@ -647,10 +682,10 @@ PMOP_pmreplroot(o)
        if (o->op_type == OP_PUSHRE) {
            sv_setiv(newSVrv(ST(0), root ?
                             svclassnames[SvTYPE((SV*)root)] : "B::SV"),
-                    (IV)root);
+                    PTR2IV(root));
        }
        else {
-           sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), (IV)root);
+           sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), PTR2IV(root));
        }
 
 B::OP
@@ -679,23 +714,38 @@ PMOP_precomp(o)
        if (rx)
            sv_setpvn(ST(0), rx->precomp, rx->prelen);
 
-#define SVOP_sv(o)     o->op_sv
+#define SVOP_sv(o)     cSVOPo->op_sv
+#define SVOP_gv(o)     ((GV*)cSVOPo->op_sv)
 
 MODULE = B     PACKAGE = B::SVOP               PREFIX = SVOP_
 
-
 B::SV
 SVOP_sv(o)
        B::SVOP o
 
-#define GVOP_gv(o)     o->op_gv
+B::GV
+SVOP_gv(o)
+       B::SVOP o
 
-MODULE = B     PACKAGE = B::GVOP               PREFIX = GVOP_
+#define PADOP_padix(o) o->op_padix
+#define PADOP_sv(o)    (o->op_padix ? PL_curpad[o->op_padix] : Nullsv)
+#define PADOP_gv(o)    ((o->op_padix \
+                         && SvTYPE(PL_curpad[o->op_padix]) == SVt_PVGV) \
+                        ? (GV*)PL_curpad[o->op_padix] : Nullgv)
 
+MODULE = B     PACKAGE = B::PADOP              PREFIX = PADOP_
+
+PADOFFSET
+PADOP_padix(o)
+       B::PADOP o
+
+B::SV
+PADOP_sv(o)
+       B::PADOP o
 
 B::GV
-GVOP_gv(o)
-       B::GVOP o
+PADOP_gv(o)
+       B::PADOP o
 
 MODULE = B     PACKAGE = B::PVOP               PREFIX = PVOP_
 
@@ -730,11 +780,12 @@ LOOP_lastop(o)
        B::LOOP o
 
 #define COP_label(o)   o->cop_label
-#define COP_stash(o)   o->cop_stash
-#define COP_filegv(o)  o->cop_filegv
+#define COP_stashpv(o) CopSTASHPV(o)
+#define COP_stash(o)   CopSTASH(o)
+#define COP_file(o)    CopFILE(o)
 #define COP_cop_seq(o) o->cop_seq
 #define COP_arybase(o) o->cop_arybase
-#define COP_line(o)    o->cop_line
+#define COP_line(o)    CopLINE(o)
 #define COP_warnings(o)        o->cop_warnings
 
 MODULE = B     PACKAGE = B::COP                PREFIX = COP_
@@ -743,12 +794,16 @@ char *
 COP_label(o)
        B::COP  o
 
+char *
+COP_stashpv(o)
+       B::COP  o
+
 B::HV
 COP_stash(o)
        B::COP  o
 
-B::GV
-COP_filegv(o)
+char *
+COP_file(o)
        B::COP  o
 
 U32
@@ -814,7 +869,11 @@ packiv(sv)
             * reach this code anyway (unless sizeof(IV) > 8 but then
             * everything else breaks too so I'm not fussed at the moment).
             */
-           wp[0] = htonl(((U32)iv) >> (sizeof(IV)*4));
+#ifdef UV_IS_QUAD
+           wp[0] = htonl(((UV)iv) >> (sizeof(UV)*4));
+#else
+           wp[0] = htonl(((U32)iv) >> (sizeof(UV)*4));
+#endif
            wp[1] = htonl(iv & 0xffffffff);
            ST(0) = sv_2mortal(newSVpvn((char *)wp, 8));
        } else {
@@ -968,6 +1027,14 @@ GvNAME(gv)
     CODE:
        ST(0) = sv_2mortal(newSVpvn(GvNAME(gv), GvNAMELEN(gv)));
 
+bool
+is_empty(gv)
+        B::GV   gv
+    CODE:
+        RETVAL = GvGP(gv) == Null(GP*);
+    OUTPUT:
+        RETVAL
+
 B::HV
 GvSTASH(gv)
        B::GV   gv
@@ -1008,6 +1075,10 @@ U16
 GvLINE(gv)
        B::GV   gv
 
+char *
+GvFILE(gv)
+       B::GV   gv
+
 B::GV
 GvFILEGV(gv)
        B::GV   gv
@@ -1129,8 +1200,8 @@ B::GV
 CvGV(cv)
        B::CV   cv
 
-B::GV
-CvFILEGV(cv)
+char *
+CvFILE(cv)
        B::CV   cv
 
 long
@@ -1149,7 +1220,7 @@ void
 CvXSUB(cv)
        B::CV   cv
     CODE:
-       ST(0) = sv_2mortal(newSViv((IV)CvXSUB(cv)));
+       ST(0) = sv_2mortal(newSViv(PTR2IV(CvXSUB(cv))));
 
 
 void
@@ -1160,10 +1231,16 @@ CvXSUBANY(cv)
 
 MODULE = B    PACKAGE = B::CV
 
-U8
+U16
 CvFLAGS(cv)
       B::CV   cv
 
+MODULE = B     PACKAGE = B::CV         PREFIX = cv_
+
+B::SV
+cv_const_sv(cv)
+       B::CV   cv
+
 
 MODULE = B     PACKAGE = B::HV         PREFIX = Hv