X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=ext%2FB%2FB.xs;h=c3ce0ed43ec4925b1aaa4ae6572ec2d8975b1a83;hb=aefff11f7e121678e7cd0c4ebdd14e491a765ed2;hp=b111e675830efd12904d33ee1cd81cf0f65acf6e;hpb=51aa15f38ed061e162eb5fdd50db6c15d839cf32;p=p5sagit%2Fp5-mst-13.2.git diff --git a/ext/B/B.xs b/ext/B/B.xs index b111e67..c3ce0ed 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 op_name -#undef opargs -#undef op_desc -#define op_name (pPerl->Perl_get_op_names()) -#define opargs (pPerl->Perl_get_opargs()) -#define op_desc (pPerl->Perl_get_op_descs()) +#undef PL_op_name +#undef PL_opargs +#undef PL_op_desc +#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,8 +81,10 @@ static char *opclassnames[] = { static int walkoptree_debug = 0; /* Flag for walkoptree debug hook */ +static SV *specialsv_list[6]; + static opclass -cc_opclass(OP *o) +cc_opclass(pTHX_ OP *o) { if (!o) return OPc_NULL; @@ -95,7 +95,12 @@ cc_opclass(OP *o) if (o->op_type == OP_SASSIGN) return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP); - switch (opargs[o->op_type] & OA_CLASS_MASK) { +#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; @@ -108,9 +113,6 @@ cc_opclass(OP *o) case OA_LOGOP: return OPc_LOGOP; - case OA_CONDOP: - return OPc_CONDOP; - case OA_LISTOP: return OPc_LISTOP; @@ -120,11 +122,19 @@ cc_opclass(OP *o) case OA_SVOP: return OPc_SVOP; - case OA_GVOP: - return OPc_GVOP; + case OA_PADOP: + return OPc_PADOP; - case OA_PVOP: - return OPc_PVOP; + case OA_PVOP_OR_SVOP: + /* + * Character translations (tr///) are usually a PVOP, keeping a + * pointer to a table of shorts used to look up translations. + * Under utf8, however, a simple table isn't practical; instead, + * the OP is an SVOP, and the SV is a reference to a swash + * (i.e., an RV pointing to an HV). + */ + return (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF)) + ? OPc_SVOP : OPc_PVOP; case OA_LOOP: return OPc_LOOP; @@ -135,12 +145,12 @@ cc_opclass(OP *o) case OA_BASEOP_OR_UNOP: /* * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on - * whether bare parens were seen. perly.y uses OPf_SPECIAL to - * signal whether an OP or an UNOP was chosen. - * Frederic.Chauveau@pasteur.fr says we need to check for OPf_KIDS too. + * whether parens were seen. perly.y uses OPf_SPECIAL to + * signal whether a BASEOP had empty parens or none. + * Some other UNOPs are created later, though, so the best + * test is OPf_KIDS, which is set in newUNOP. */ - return ((o->op_flags & OPf_SPECIAL) ? OPc_BASEOP : - (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP); + return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP; case OA_FILESTATOP: /* @@ -150,11 +160,14 @@ cc_opclass(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 @@ -173,18 +186,18 @@ cc_opclass(OP *o) return OPc_PVOP; } warn("can't determine class of operator %s, assuming BASEOP\n", - op_name[o->op_type]); + PL_op_name[o->op_type]); return OPc_BASEOP; } static char * -cc_opclassname(OP *o) +cc_opclassname(pTHX_ OP *o) { - return opclassnames[cc_opclass(o)]; + return opclassnames[cc_opclass(aTHX_ o)]; } static SV * -make_sv_object(SV *arg, SV *sv) +make_sv_object(pTHX_ SV *arg, SV *sv) { char *type = 0; IV iv; @@ -197,23 +210,23 @@ make_sv_object(SV *arg, SV *sv) } if (!type) { type = svclassnames[SvTYPE(sv)]; - iv = (IV)sv; + iv = PTR2IV(sv); } sv_setiv(newSVrv(arg, type), iv); return arg; } static SV * -make_mg_object(SV *arg, MAGIC *mg) +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; } static SV * -cstring(SV *sv) +cstring(pTHX_ SV *sv) { - SV *sstr = newSVpv("", 0); + SV *sstr = newSVpvn("", 0); STRLEN len; char *s; @@ -264,10 +277,11 @@ cstring(SV *sv) } static SV * -cchar(SV *sv) +cchar(pTHX_ SV *sv) { - SV *sstr = newSVpv("'", 0); - char *s = SvPV(sv, na); + SV *sstr = newSVpvn("'", 1); + STRLEN n_a; + char *s = SvPV(sv, n_a); if (*s == '\'') sv_catpv(sstr, "\\'"); @@ -302,76 +316,8 @@ cchar(SV *sv) return sstr; } -#ifdef INDIRECT_BGET_MACROS -void freadpv(U32 len, void *data) -{ - New(666, pv.xpv_pv, len, char); - fread(pv.xpv_pv, 1, len, (FILE*)data); - pv.xpv_len = len; - pv.xpv_cur = len - 1; -} - -void byteload_fh(InputStream fp) -{ - struct bytestream bs; - bs.data = fp; - bs.fgetc = (int(*) _((void*)))fgetc; - bs.fread = (int(*) _((char*,size_t,size_t,void*)))fread; - bs.freadpv = freadpv; - byterun(bs); -} - -static int fgetc_fromstring(void *data) -{ - char **strp = (char **)data; - return *(*strp)++; -} - -static int fread_fromstring(char *argp, size_t elemsize, size_t nelem, - void *data) -{ - char **strp = (char **)data; - size_t len = elemsize * nelem; - - memcpy(argp, *strp, len); - *strp += len; - return (int)len; -} - -static void freadpv_fromstring(U32 len, void *data) -{ - char **strp = (char **)data; - - New(666, pv.xpv_pv, len, char); - memcpy(pv.xpv_pv, *strp, len); - pv.xpv_len = len; - pv.xpv_cur = len - 1; - *strp += len; -} - -void byteload_string(char *str) -{ - struct bytestream bs; - bs.data = &str; - bs.fgetc = fgetc_fromstring; - bs.fread = fread_fromstring; - bs.freadpv = freadpv_fromstring; - byterun(bs); -} -#else -void byteload_fh(InputStream fp) -{ - byterun(fp); -} - -void byteload_string(char *str) -{ - croak("Must compile with -DINDIRECT_BGET_MACROS for byteload_string"); -} -#endif /* INDIRECT_BGET_MACROS */ - void -walkoptree(SV *opsv, char *method) +walkoptree(pTHX_ SV *opsv, char *method) { dSP; OP *o; @@ -379,7 +325,7 @@ walkoptree(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); @@ -394,8 +340,8 @@ walkoptree(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(kid)), (IV)kid); - walkoptree(opsv, method); + sv_setiv(newSVrv(opsv, cc_opclassname(aTHX_ kid)), PTR2IV(kid)); + walkoptree(aTHX_ opsv, method); } } } @@ -404,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; @@ -434,15 +379,38 @@ MODULE = B PACKAGE = B PREFIX = B_ PROTOTYPES: DISABLE BOOT: - INIT_SPECIALSV_LIST; +{ + HV *stash = gv_stashpvn("B", 1, TRUE); + AV *export_ok = perl_get_av("B::EXPORT_OK",TRUE); + specialsv_list[0] = Nullsv; + 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() main_cv -#define B_main_root() main_root -#define B_main_start() main_start -#define B_comppadlist() (main_cv ? CvPADLIST(main_cv) : CvPADLIST(compcv)) -#define B_sv_undef() &sv_undef -#define B_sv_yes() &sv_yes -#define B_sv_no() &sv_no +#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 +#define B_comppadlist() (PL_main_cv ? CvPADLIST(PL_main_cv) : CvPADLIST(PL_compcv)) +#define B_sv_undef() &PL_sv_undef +#define B_sv_yes() &PL_sv_yes +#define B_sv_no() &PL_sv_no + +B::AV +B_init_av() + +B::AV +B_begin_av() + +B::AV +B_end_av() B::CV B_main_cv() @@ -453,6 +421,9 @@ B_main_root() B::OP B_main_start() +long +B_amagic_generation() + B::AV B_comppadlist() @@ -472,6 +443,8 @@ void walkoptree(opsv, method) SV * opsv char * method + CODE: + walkoptree(aTHX_ opsv, method); int walkoptree_debug(...) @@ -482,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) @@ -509,16 +469,37 @@ svref_2object(sv) croak("argument is not a reference"); RETVAL = (SV*)SvRV(sv); OUTPUT: - RETVAL + RETVAL + +void +opnumber(name) +char * name +CODE: +{ + int i; + IV result = -1; + ST(0) = sv_newmortal(); + if (strncmp(name,"pp_",3) == 0) + name += 3; + for (i = 0; i < PL_maxo; i++) + { + if (strcmp(name, PL_op_name[i]) == 0) + { + result = i; + break; + } + } + sv_setiv(ST(0),result); +} void ppname(opnum) int opnum CODE: ST(0) = sv_newmortal(); - if (opnum >= 0 && opnum < maxo) { + if (opnum >= 0 && opnum < PL_maxo) { sv_setpvn(ST(0), "pp_", 3); - sv_catpv(ST(0), op_name[opnum]); + sv_catpv(ST(0), PL_op_name[opnum]); } void @@ -528,11 +509,10 @@ hash(sv) char *s; STRLEN len; U32 hash = 0; - char hexhash[11]; /* must fit "0xffffffff" plus trailing \0 */ + char hexhash[19]; /* must fit "0xffffffffffffffff" plus trailing \0 */ s = SvPV(sv, len); - while (len--) - hash = hash * 33 + *s++; - sprintf(hexhash, "0x%x", hash); + PERL_HASH(hash, s, len); + sprintf(hexhash, "0x%"UVxf, (UV)hash); ST(0) = sv_2mortal(newSVpv(hexhash, 0)); #define cast_I32(foo) (I32)foo @@ -543,32 +523,45 @@ cast_I32(i) void minus_c() CODE: - minus_c = TRUE; + PL_minus_c = TRUE; + +void +save_BEGINs() + CODE: + PL_savebegin = TRUE; SV * cstring(sv) SV * sv + CODE: + RETVAL = cstring(aTHX_ sv); + OUTPUT: + RETVAL SV * cchar(sv) SV * sv + CODE: + RETVAL = cchar(aTHX_ sv); + OUTPUT: + RETVAL void threadsv_names() PPCODE: #ifdef USE_THREADS int i; - STRLEN len = strlen(threadsv_names); + STRLEN len = strlen(PL_threadsv_names); EXTEND(sp, len); for (i = 0; i < len; i++) - PUSHs(sv_2mortal(newSVpv(&threadsv_names[i], 1))); + PUSHs(sv_2mortal(newSVpvn(&PL_threadsv_names[i], 1))); #endif #define OP_next(o) o->op_next #define OP_sibling(o) o->op_sibling -#define OP_desc(o) op_desc[o->op_type] +#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 @@ -586,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), 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 #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 @@ -682,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(root)), (IV)root); + sv_setiv(newSVrv(ST(0), cc_opclassname(aTHX_ root)), PTR2IV(root)); } B::OP @@ -710,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_ @@ -739,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 @@ -765,11 +793,13 @@ 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_ @@ -777,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 @@ -797,6 +831,10 @@ U16 COP_line(o) B::COP o +B::SV +COP_warnings(o) + B::COP o + MODULE = B PACKAGE = B::SV PREFIX = Sv U32 @@ -817,6 +855,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)) @@ -839,21 +882,25 @@ 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(newSVpv((char *)wp, 8)); + ST(0) = sv_2mortal(newSVpvn((char *)wp, 8)); } else { U32 w = htonl((U32)SvIVX(sv)); - ST(0) = sv_2mortal(newSVpv((char *)&w, 4)); + ST(0) = sv_2mortal(newSVpvn((char *)&w, 4)); } MODULE = B PACKAGE = B::NV PREFIX = Sv -double +NV SvNV(sv) B::NV sv -double +NV SvNVX(sv) B::NV sv @@ -865,12 +912,25 @@ 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) + B::PV sv + +STRLEN +SvCUR(sv) + B::PV sv MODULE = B PACKAGE = B::PVMG PREFIX = Sv @@ -880,7 +940,7 @@ SvMAGIC(sv) MAGIC * mg = NO_INIT PPCODE: for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) - XPUSHs(make_mg_object(sv_newmortal(), mg)); + XPUSHs(make_mg_object(aTHX_ sv_newmortal(), mg)); MODULE = B PACKAGE = B::PVMG @@ -893,6 +953,7 @@ SvSTASH(sv) #define MgTYPE(mg) mg->mg_type #define MgFLAGS(mg) mg->mg_flags #define MgOBJ(mg) mg->mg_obj +#define MgLENGTH(mg) mg->mg_len MODULE = B PACKAGE = B::MAGIC PREFIX = Mg @@ -916,13 +977,23 @@ B::SV MgOBJ(mg) B::MAGIC mg +I32 +MgLENGTH(mg) + B::MAGIC mg + void MgPTR(mg) B::MAGIC mg CODE: ST(0) = sv_newmortal(); - if (mg->mg_ptr) - sv_setpvn(ST(0), mg->mg_ptr, mg->mg_len); + if (mg->mg_ptr){ + if (mg->mg_len >= 0){ + sv_setpvn(ST(0), mg->mg_ptr, mg->mg_len); + } else { + if (mg->mg_len == HEf_SVKEY) + sv_setsv(ST(0),newRV((SV*)mg->mg_ptr)); + } + } MODULE = B PACKAGE = B::PVLV PREFIX = Lv @@ -964,7 +1035,7 @@ BmTABLE(sv) CODE: str = SvPV(sv, len); /* Boyer-Moore table is just after string and its safety-margin \0 */ - ST(0) = sv_2mortal(newSVpv(str + len + 1, 256)); + ST(0) = sv_2mortal(newSVpvn(str + len + 1, 256)); MODULE = B PACKAGE = B::GV PREFIX = Gv @@ -972,7 +1043,15 @@ void GvNAME(gv) B::GV gv CODE: - ST(0) = sv_2mortal(newSVpv(GvNAME(gv), GvNAMELEN(gv))); + 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) @@ -1014,6 +1093,10 @@ U16 GvLINE(gv) B::GV gv +char * +GvFILE(gv) + B::GV gv + B::GV GvFILEGV(gv) B::GV gv @@ -1108,7 +1191,7 @@ AvARRAY(av) SV **svp = AvARRAY(av); I32 i; for (i = 0; i <= AvFILL(av); i++) - XPUSHs(make_sv_object(sv_newmortal(), svp[i])); + XPUSHs(make_sv_object(aTHX_ sv_newmortal(), svp[i])); } MODULE = B PACKAGE = B::AV @@ -1135,8 +1218,8 @@ B::GV CvGV(cv) B::CV cv -B::GV -CvFILEGV(cv) +char * +CvFILE(cv) B::CV cv long @@ -1155,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 @@ -1164,6 +1247,19 @@ CvXSUBANY(cv) CODE: ST(0) = sv_2mortal(newSViv(CvXSUBANY(cv).any_iv)); +MODULE = B PACKAGE = B::CV + +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 STRLEN @@ -1200,8 +1296,8 @@ HvARRAY(hv) I32 len; (void)hv_iterinit(hv); EXTEND(sp, HvKEYS(hv) * 2); - while (sv = hv_iternextsv(hv, &key, &len)) { - PUSHs(newSVpv(key, len)); - PUSHs(make_sv_object(sv_newmortal(), sv)); + while ((sv = hv_iternextsv(hv, &key, &len))) { + PUSHs(newSVpvn(key, len)); + PUSHs(make_sv_object(aTHX_ sv_newmortal(), sv)); } }