B && BEGIN handling
[p5sagit/p5-mst-13.2.git] / ext / B / B.xs
index 570b001..c3ce0ed 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_savebegin = TRUE;
+
 SV *
 cstring(sv)
        SV *    sv
@@ -559,23 +582,30 @@ char *
 OP_name(o)
        B::OP           o
     CODE:
-       ST(0) = sv_newmortal();
-       sv_setpv(ST(0), PL_op_name[o->op_type]);
+       RETVAL = PL_op_name[o->op_type];
+    OUTPUT:
+       RETVAL
 
 
-char *
+void
 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,18 +649,25 @@ 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:
+       i = 0;
+       for (kid = o->op_first; kid; kid = kid->op_sibling)
+           i++;
+       RETVAL = i;
+    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)       o->op_pmregexp
+#define PMOP_pmregexp(o)       PM_GETRE(o)
 #define PMOP_pmflags(o)                o->op_pmflags
 #define PMOP_pmpermflags(o)    o->op_pmpermflags
 
@@ -647,10 +684,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
@@ -675,27 +712,42 @@ PMOP_precomp(o)
        REGEXP *        rx = NO_INIT
     CODE:
        ST(0) = sv_newmortal();
-       rx = o->op_pmregexp;
+       rx = PM_GETRE(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
+
+#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_
 
-MODULE = B     PACKAGE = B::GVOP               PREFIX = GVOP_
+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_
 
@@ -704,11 +756,22 @@ PVOP_pv(o)
        B::PVOP o
     CODE:
        /*
-        * OP_TRANS uses op_pv to point to a table of 256 shorts
+        * OP_TRANS uses op_pv to point to a table of 256 or >=258 shorts
         * whereas other PVOPs point to a null terminated string.
         */
-       ST(0) = sv_2mortal(newSVpv(o->op_pv, (o->op_type == OP_TRANS) ?
-                                  256 * sizeof(short) : 0));
+       if (o->op_type == OP_TRANS &&
+               (o->op_private & OPpTRANS_COMPLEMENT) &&
+               !(o->op_private & OPpTRANS_DELETE))
+       {
+           short* tbl = (short*)o->op_pv;
+           short entries = 257 + tbl[256];
+           ST(0) = sv_2mortal(newSVpv(o->op_pv, entries * sizeof(short)));
+       }
+       else if (o->op_type == OP_TRANS) {
+           ST(0) = sv_2mortal(newSVpv(o->op_pv, 256 * sizeof(short)));
+       }
+       else
+           ST(0) = sv_2mortal(newSVpv(o->op_pv, 0));
 
 #define LOOP_redoop(o) o->op_redoop
 #define LOOP_nextop(o) o->op_nextop
@@ -730,11 +793,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 +807,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 +882,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 {
@@ -824,11 +896,11 @@ packiv(sv)
 
 MODULE = B     PACKAGE = B::NV         PREFIX = Sv
 
-double
+NV
 SvNV(sv)
        B::NV   sv
 
-double
+NV
 SvNVX(sv)
        B::NV   sv
 
@@ -840,12 +912,17 @@ SvRV(sv)
 
 MODULE = B     PACKAGE = B::PV         PREFIX = Sv
 
+char*
+SvPVX(sv)
+       B::PV   sv
+
 void
 SvPV(sv)
        B::PV   sv
     CODE:
        ST(0) = sv_newmortal();
        sv_setpvn(ST(0), SvPVX(sv), SvCUR(sv));
+       SvFLAGS(ST(0)) |= SvUTF8(sv);
 
 STRLEN
 SvLEN(sv)
@@ -968,6 +1045,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 +1093,10 @@ U16
 GvLINE(gv)
        B::GV   gv
 
+char *
+GvFILE(gv)
+       B::GV   gv
+
 B::GV
 GvFILEGV(gv)
        B::GV   gv
@@ -1129,8 +1218,8 @@ B::GV
 CvGV(cv)
        B::CV   cv
 
-B::GV
-CvFILEGV(cv)
+char *
+CvFILE(cv)
        B::CV   cv
 
 long
@@ -1149,7 +1238,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 +1249,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
 
@@ -1201,7 +1296,7 @@ HvARRAY(hv)
            I32 len;
            (void)hv_iterinit(hv);
            EXTEND(sp, HvKEYS(hv) * 2);
-           while (sv = hv_iternextsv(hv, &key, &len)) {
+           while ((sv = hv_iternextsv(hv, &key, &len))) {
                PUSHs(newSVpvn(key, len));
                PUSHs(make_sv_object(aTHX_ sv_newmortal(), sv));
            }