X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FB%2FB.xs;h=39b579f51b4ccf25d562e7685e971cb89d2f05f8;hb=0a1f2d144e4463451f8627bd1c6ca420a59b01b0;hp=f9193ae692f936992afbd49152a1940bc46e6ed4;hpb=cea2e8a9dd23747fd2b66edc86c58c64e9970321;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/B/B.xs b/ext/B/B.xs index f9193ae..39b579f 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -7,18 +7,18 @@ * */ +#define PERL_NO_GET_CONTEXT #include "EXTERN.h" #include "perl.h" #include "XSUB.h" -#include "INTERN.h" #ifdef PERL_OBJECT #undef PL_op_name #undef PL_opargs #undef PL_op_desc -#define PL_op_name (pPerl->Perl_get_op_names()) -#define PL_opargs (pPerl->Perl_get_opargs()) -#define PL_op_desc (pPerl->Perl_get_op_descs()) +#define PL_op_name (get_op_names()) +#define PL_opargs (get_opargs()) +#define PL_op_desc (get_op_descs()) #endif #ifdef PerlIO @@ -53,15 +53,14 @@ typedef enum { OPc_UNOP, /* 2 */ OPc_BINOP, /* 3 */ OPc_LOGOP, /* 4 */ - OPc_CONDOP, /* 5 */ - OPc_LISTOP, /* 6 */ - OPc_PMOP, /* 7 */ - OPc_SVOP, /* 8 */ - OPc_GVOP, /* 9 */ - OPc_PVOP, /* 10 */ - OPc_CVOP, /* 11 */ - OPc_LOOP, /* 12 */ - OPc_COP /* 13 */ + OPc_LISTOP, /* 5 */ + OPc_PMOP, /* 6 */ + OPc_SVOP, /* 7 */ + OPc_PADOP, /* 8 */ + OPc_PVOP, /* 9 */ + OPc_CVOP, /* 10 */ + OPc_LOOP, /* 11 */ + OPc_COP /* 12 */ } opclass; static char *opclassnames[] = { @@ -70,11 +69,10 @@ static char *opclassnames[] = { "B::UNOP", "B::BINOP", "B::LOGOP", - "B::CONDOP", "B::LISTOP", "B::PMOP", "B::SVOP", - "B::GVOP", + "B::PADOP", "B::PVOP", "B::CVOP", "B::LOOP", @@ -83,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) @@ -97,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; @@ -110,9 +113,6 @@ cc_opclass(pTHX_ OP *o) case OA_LOGOP: return OPc_LOGOP; - case OA_CONDOP: - return OPc_CONDOP; - case OA_LISTOP: return OPc_LISTOP; @@ -122,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: /* @@ -160,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 @@ -207,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; @@ -216,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; } @@ -322,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); @@ -337,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); } } @@ -347,11 +350,10 @@ typedef OP *B__OP; typedef UNOP *B__UNOP; typedef BINOP *B__BINOP; typedef LOGOP *B__LOGOP; -typedef CONDOP *B__CONDOP; 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; @@ -384,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 @@ -400,6 +406,12 @@ BOOT: B::AV B_init_av() +B::AV +B_begin_av() + +B::AV +B_end_av() + B::CV B_main_cv() @@ -443,20 +455,7 @@ walkoptree_debug(...) OUTPUT: RETVAL -int -byteload_fh(fp) - InputStream fp - CODE: - byteload_fh(fp); - RETVAL = 1; - OUTPUT: - RETVAL - -void -byteload_string(str) - char * str - -#define address(sv) (IV)sv +#define address(sv) PTR2IV(sv) IV address(sv) @@ -510,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 @@ -526,6 +525,11 @@ minus_c() CODE: PL_minus_c = TRUE; +void +save_BEGINs() + CODE: + PL_minus_c |= 0x10; + SV * cstring(sv) SV * sv @@ -575,18 +579,33 @@ OP_sibling(o) B::OP o char * +OP_name(o) + B::OP o + CODE: + RETVAL = PL_op_name[o->op_type]; + OUTPUT: + RETVAL + + +void OP_ppaddr(o) B::OP o + PREINIT: + int i; + SV *sv = sv_newmortal(); CODE: - ST(0) = sv_newmortal(); - sv_setpvn(ST(0), "pp_", 3); - 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; iop_true -#define CONDOP_false(o) o->op_false - -MODULE = B PACKAGE = B::CONDOP PREFIX = CONDOP_ - -B::OP -CONDOP_true(o) - B::CONDOP o - -B::OP -CONDOP_false(o) - B::CONDOP 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 @@ -671,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 @@ -703,23 +716,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_ @@ -754,11 +782,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_ @@ -767,12 +796,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 @@ -811,6 +844,11 @@ IV SvIVX(sv) B::IV sv +UV +SvUVX(sv) + B::IV sv + + MODULE = B PACKAGE = B::IV #define needs64bits(sv) ((I32)SvIVX(sv) != SvIVX(sv)) @@ -833,7 +871,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 { @@ -843,11 +885,11 @@ packiv(sv) MODULE = B PACKAGE = B::NV PREFIX = Sv -double +NV SvNV(sv) B::NV sv -double +NV SvNVX(sv) B::NV sv @@ -859,6 +901,10 @@ SvRV(sv) MODULE = B PACKAGE = B::PV PREFIX = Sv +char* +SvPVX(sv) + B::PV sv + void SvPV(sv) B::PV sv @@ -866,6 +912,14 @@ SvPV(sv) ST(0) = sv_newmortal(); sv_setpvn(ST(0), SvPVX(sv), SvCUR(sv)); +STRLEN +SvLEN(sv) + B::PV sv + +STRLEN +SvCUR(sv) + B::PV sv + MODULE = B PACKAGE = B::PVMG PREFIX = Sv void @@ -979,6 +1033,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 @@ -1019,6 +1081,10 @@ U16 GvLINE(gv) B::GV gv +char * +GvFILE(gv) + B::GV gv + B::GV GvFILEGV(gv) B::GV gv @@ -1140,8 +1206,8 @@ B::GV CvGV(cv) B::CV cv -B::GV -CvFILEGV(cv) +char * +CvFILE(cv) B::CV cv long @@ -1160,7 +1226,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 @@ -1171,10 +1237,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 @@ -1212,7 +1284,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)); }