X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FB%2FB.xs;h=25d69e97bd671395c9b4284e0c673d258112ed16;hb=3baa4c62cda542368be1e7e1f7af8bd8257c2ff4;hp=39e381d6f569a7d1c16eec246cc159c6bbf7a5ef;hpb=445a12f622bad7d38f7d9dd52674ccc07f19205c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/B/B.xs b/ext/B/B.xs index 39e381d..25d69e9 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -7,6 +7,7 @@ * */ +#define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" #include "XSUB.h" @@ -55,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 */ @@ -71,7 +72,7 @@ static char *opclassnames[] = { "B::LISTOP", "B::PMOP", "B::SVOP", - "B::GVOP", + "B::PADOP", "B::PVOP", "B::CVOP", "B::LOOP", @@ -80,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) @@ -94,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; @@ -116,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: /* @@ -154,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 @@ -201,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; @@ -210,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; } @@ -316,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); @@ -331,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); } } @@ -344,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; @@ -377,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 @@ -393,6 +406,12 @@ BOOT: B::AV B_init_av() +B::AV +B_begin_av() + +B::AV +B_end_av() + B::CV B_main_cv() @@ -436,7 +455,7 @@ walkoptree_debug(...) OUTPUT: RETVAL -#define address(sv) (IV)sv +#define address(sv) PTR2IV(sv) IV address(sv) @@ -490,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 @@ -506,6 +525,11 @@ minus_c() CODE: PL_minus_c = TRUE; +void +save_BEGINs() + CODE: + PL_minus_c |= 0x10; + SV * cstring(sv) SV * sv @@ -555,18 +579,32 @@ OP_sibling(o) B::OP o char * -OP_ppaddr(o) +OP_name(o) B::OP o CODE: ST(0) = sv_newmortal(); - sv_setpvn(ST(0), "pp_", 3); - sv_catpv(ST(0), PL_op_name[o->op_type]); + sv_setpv(ST(0), PL_op_name[o->op_type]); + + +char * +OP_ppaddr(o) + B::OP o + PREINIT: + int i; + SV *sv = sv_newmortal(); + CODE: + sv_setpvn(sv, "PL_ppaddr[OP_", 13); + sv_catpv(sv, PL_op_name[o->op_type]); + for (i=13; iop_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 @@ -638,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 @@ -670,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 + +#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::GVOP PREFIX = GVOP_ +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_ @@ -721,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_ @@ -734,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 @@ -805,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 { @@ -959,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 @@ -999,6 +1075,10 @@ U16 GvLINE(gv) B::GV gv +char * +GvFILE(gv) + B::GV gv + B::GV GvFILEGV(gv) B::GV gv @@ -1120,8 +1200,8 @@ B::GV CvGV(cv) B::CV cv -B::GV -CvFILEGV(cv) +char * +CvFILE(cv) B::CV cv long @@ -1140,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 @@ -1151,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