static const char* const svclassnames[] = {
"B::NULL",
-#if PERL_VERSION < 19
- "B::BIND",
-#endif
"B::IV",
"B::NV",
-#if PERL_VERSION <= 10
- "B::RV",
-#endif
"B::PV",
-#if PERL_VERSION >= 19
"B::INVLIST",
-#endif
"B::PVIV",
"B::PVNV",
"B::PVMG",
-#if PERL_VERSION >= 11
"B::REGEXP",
-#endif
"B::GV",
"B::PVLV",
"B::AV",
"B::IO",
};
-typedef enum {
- OPc_NULL, /* 0 */
- OPc_BASEOP, /* 1 */
- OPc_UNOP, /* 2 */
- OPc_BINOP, /* 3 */
- OPc_LOGOP, /* 4 */
- OPc_LISTOP, /* 5 */
- OPc_PMOP, /* 6 */
- OPc_SVOP, /* 7 */
- OPc_PADOP, /* 8 */
- OPc_PVOP, /* 9 */
- OPc_LOOP, /* 10 */
- OPc_COP, /* 11 */
- OPc_METHOP, /* 12 */
- OPc_UNOP_AUX /* 13 */
-} opclass;
static const char* const opclassnames[] = {
"B::NULL",
#define MY_CXT_KEY "B::_guts" XS_VERSION
typedef struct {
- SV * x_specialsv_list[7];
+ SV * x_specialsv_list[8];
int x_walkoptree_debug; /* Flag for walkoptree debug hook */
} my_cxt_t;
cxt->x_specialsv_list[4] = (SV *) pWARN_ALL;
cxt->x_specialsv_list[5] = (SV *) pWARN_NONE;
cxt->x_specialsv_list[6] = (SV *) pWARN_STD;
+ cxt->x_specialsv_list[7] = &PL_sv_zero;
}
-static opclass
-cc_opclass(pTHX_ const OP *o)
-{
- bool custom = 0;
-
- if (!o)
- return OPc_NULL;
-
- if (o->op_type == 0) {
- if (o->op_targ == OP_NEXTSTATE || o->op_targ == OP_DBSTATE)
- return OPc_COP;
- return (o->op_flags & OPf_KIDS) ? OPc_UNOP : OPc_BASEOP;
- }
-
- if (o->op_type == OP_SASSIGN)
- return ((o->op_private & OPpASSIGN_BACKWARDS) ? OPc_UNOP : OPc_BINOP);
-
- if (o->op_type == OP_AELEMFAST) {
-#if PERL_VERSION <= 14
- if (o->op_flags & OPf_SPECIAL)
- return OPc_BASEOP;
- else
-#endif
-#ifdef USE_ITHREADS
- return OPc_PADOP;
-#else
- return OPc_SVOP;
-#endif
- }
-
-#ifdef USE_ITHREADS
- if (o->op_type == OP_GV || o->op_type == OP_GVSV ||
- o->op_type == OP_RCATLINE)
- return OPc_PADOP;
-#endif
-
- if (o->op_type == OP_CUSTOM)
- custom = 1;
-
- switch (OP_CLASS(o)) {
- case OA_BASEOP:
- return OPc_BASEOP;
-
- case OA_UNOP:
- return OPc_UNOP;
-
- case OA_BINOP:
- return OPc_BINOP;
-
- case OA_LOGOP:
- return OPc_LOGOP;
-
- case OA_LISTOP:
- return OPc_LISTOP;
-
- case OA_PMOP:
- return OPc_PMOP;
-
- case OA_SVOP:
- return OPc_SVOP;
-
- case OA_PADOP:
- return OPc_PADOP;
-
- 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 (or, under threads, a PADOP),
- * and the SV is a reference to a swash
- * (i.e., an RV pointing to an HV).
- */
- return (!custom &&
- (o->op_private & (OPpTRANS_TO_UTF|OPpTRANS_FROM_UTF))
- )
-#if defined(USE_ITHREADS)
- ? OPc_PADOP : OPc_PVOP;
-#else
- ? OPc_SVOP : OPc_PVOP;
-#endif
-
- case OA_LOOP:
- return OPc_LOOP;
-
- case OA_COP:
- return OPc_COP;
-
- case OA_BASEOP_OR_UNOP:
- /*
- * UNI(OP_foo) in toke.c returns token UNI or FUNC1 depending on
- * 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_KIDS) ? OPc_UNOP : OPc_BASEOP;
-
- case OA_FILESTATOP:
- /*
- * The file stat OPs are created via UNI(OP_foo) in toke.c but use
- * the OPf_REF flag to distinguish between OP types instead of the
- * usual OPf_SPECIAL flag. As usual, if OPf_KIDS is set, then we
- * 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
- * an SVOP (and op_sv is the GV for the filehandle argument).
- */
- return ((o->op_flags & OPf_KIDS) ? OPc_UNOP :
-#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
- * label was omitted (in which case it's a BASEOP) or else a term was
- * seen. In this last case, all except goto are definitely PVOP but
- * goto is either a PVOP (with an ordinary constant label), an UNOP
- * with OPf_STACKED (with a non-constant non-sub) or an UNOP for
- * OP_REFGEN (with goto &sub) in which case OPf_STACKED also seems to
- * get set.
- */
- if (o->op_flags & OPf_STACKED)
- return OPc_UNOP;
- else if (o->op_flags & OPf_SPECIAL)
- return OPc_BASEOP;
- else
- return OPc_PVOP;
- case OA_METHOP:
- return OPc_METHOP;
- case OA_UNOP_AUX:
- return OPc_UNOP_AUX;
- }
- warn("can't determine class of operator %s, assuming BASEOP\n",
- OP_NAME(o));
- return OPc_BASEOP;
-}
static SV *
make_op_object(pTHX_ const OP *o)
{
SV *opsv = sv_newmortal();
- sv_setiv(newSVrv(opsv, opclassnames[cc_opclass(aTHX_ o)]), PTR2IV(o));
+ sv_setiv(newSVrv(opsv, opclassnames[op_class(o)]), PTR2IV(o));
return opsv;
}
dSP;
OP *kid;
SV *object;
- const char *const classname = opclassnames[cc_opclass(aTHX_ o)];
+ const char *const classname = opclassnames[op_class(o)];
dMY_CXT;
/* Check that no-one has changed our reference, or is holding a reference
ref = walkoptree(aTHX_ kid, method, ref);
}
}
- if (o && (cc_opclass(aTHX_ o) == OPc_PMOP) && o->op_type != OP_PUSHRE
+ if (o && (op_class(o) == OPclass_PMOP) && o->op_type != OP_SPLIT
&& (kid = PMOP_pmreplroot(cPMOPo)))
{
ref = walkoptree(aTHX_ kid, method, ref);
typedef SV *B__PV;
typedef SV *B__NV;
typedef SV *B__PVMG;
-#if PERL_VERSION >= 11
typedef SV *B__REGEXP;
-#endif
typedef SV *B__PVLV;
typedef SV *B__BM;
typedef SV *B__RV;
typedef MAGIC *B__MAGIC;
typedef HE *B__HE;
typedef struct refcounted_he *B__RHE;
-#ifdef PadlistARRAY
typedef PADLIST *B__PADLIST;
-#endif
typedef PADNAMELIST *B__PADNAMELIST;
typedef PADNAME *B__PADNAME;
/* table that drives most of the B::*OP methods */
-const struct OP_methods {
+static const struct OP_methods {
const char *name;
U8 namelen;
U8 type; /* if op_offset_special, access is handled on a case-by-case basis */
{ STR_WITH_LEN("nextop"), OPp, STRUCT_OFFSET(struct loop, op_nextop), },/*10*/
{ STR_WITH_LEN("lastop"), OPp, STRUCT_OFFSET(struct loop, op_lastop), },/*11*/
{ STR_WITH_LEN("pmflags"), U32p, STRUCT_OFFSET(struct pmop, op_pmflags),},/*12*/
-#if PERL_VERSION >= 17
{ STR_WITH_LEN("code_list"),OPp, STRUCT_OFFSET(struct pmop, op_code_list),},/*13*/
-#else
- { STR_WITH_LEN("code_list"),op_offset_special, 0, }, /*13*/
-#endif
{ STR_WITH_LEN("sv"), SVp, STRUCT_OFFSET(struct svop, op_sv), },/*14*/
{ STR_WITH_LEN("gv"), SVp, STRUCT_OFFSET(struct svop, op_sv), },/*15*/
{ STR_WITH_LEN("padix"), PADOFFSETp,STRUCT_OFFSET(struct padop, op_padix),},/*16*/
{ STR_WITH_LEN("filegv"), op_offset_special, 0, },/*21*/
{ STR_WITH_LEN("file"), char_pp, STRUCT_OFFSET(struct cop, cop_file), },/*22*/
{ STR_WITH_LEN("stash"), op_offset_special, 0, },/*23*/
-# if PERL_VERSION < 17
- { STR_WITH_LEN("stashpv"), char_pp, STRUCT_OFFSET(struct cop, cop_stashpv),}, /*24*/
- { STR_WITH_LEN("stashoff"),op_offset_special, 0, },/*25*/
-# else
{ STR_WITH_LEN("stashpv"), op_offset_special, 0, },/*24*/
{ STR_WITH_LEN("stashoff"),PADOFFSETp,STRUCT_OFFSET(struct cop,cop_stashoff),},/*25*/
-# endif
#else
{ STR_WITH_LEN("pmoffset"),op_offset_special, 0, },/*20*/
{ STR_WITH_LEN("filegv"), SVp, STRUCT_OFFSET(struct cop, cop_filegv),},/*21*/
{ STR_WITH_LEN("warnings"),op_offset_special, 0, },/*44*/
{ STR_WITH_LEN("io"), op_offset_special, 0, },/*45*/
{ STR_WITH_LEN("hints_hash"),op_offset_special, 0, },/*46*/
-#if PERL_VERSION >= 17
{ STR_WITH_LEN("slabbed"), op_offset_special, 0, },/*47*/
{ STR_WITH_LEN("savefree"),op_offset_special, 0, },/*48*/
{ STR_WITH_LEN("static"), op_offset_special, 0, },/*49*/
-# if PERL_VERSION >= 19
{ STR_WITH_LEN("folded"), op_offset_special, 0, },/*50*/
- { STR_WITH_LEN("lastsib"), op_offset_special, 0, },/*51*/
+ { STR_WITH_LEN("moresib"), op_offset_special, 0, },/*51*/
{ STR_WITH_LEN("parent"), op_offset_special, 0, },/*52*/
-# endif
-#endif
-#if PERL_VERSION >= 21
{ STR_WITH_LEN("first"), op_offset_special, 0, },/*53*/
{ STR_WITH_LEN("meth_sv"), op_offset_special, 0, },/*54*/
{ STR_WITH_LEN("pmregexp"),op_offset_special, 0, },/*55*/
# else
{ STR_WITH_LEN("rclass"), op_offset_special, 0, },/*56*/
# endif
-#endif
};
#include "const-c.inc"
ASSIGN_COMMON_ALIAS(I, defstash);
cv = newXS("B::curstash", intrpvar_sv_common, file);
ASSIGN_COMMON_ALIAS(I, curstash);
-#ifdef PL_formfeed
- cv = newXS("B::formfeed", intrpvar_sv_common, file);
- ASSIGN_COMMON_ALIAS(I, formfeed);
-#endif
#ifdef USE_ITHREADS
cv = newXS("B::regex_padav", intrpvar_sv_common, file);
ASSIGN_COMMON_ALIAS(I, regex_padav);
#endif
}
-#ifndef PL_formfeed
-
void
formfeed()
PPCODE:
PUSHs(make_sv_object(aTHX_ GvSV(gv_fetchpvs("\f", GV_ADD, SVt_PV))));
-#endif
-
long
amagic_generation()
CODE:
PREINIT:
PADLIST *padlist = CvPADLIST(PL_main_cv ? PL_main_cv : PL_compcv);
PPCODE:
-#ifdef PadlistARRAY
{
SV * const rv = sv_newmortal();
sv_setiv(newSVrv(rv, padlist ? "B::PADLIST" : "B::NULL"),
PTR2IV(padlist));
PUSHs(rv);
}
-#else
- PUSHs(make_sv_object(aTHX_ (SV *)padlist));
-#endif
void
sv_undef()
int i;
IV result = -1;
ST(0) = sv_newmortal();
- if (strncmp(name,"pp_",3) == 0)
+ if (strBEGINs(name,"pp_"))
name += 3;
for (i = 0; i < PL_maxo; i++)
{
- if (strcmp(name, PL_op_name[i]) == 0)
+ if (strEQ(name, PL_op_name[i]))
{
result = i;
break;
U32 hash = 0;
const char *s = SvPVbyte(sv, len);
PERL_HASH(hash, s, len);
- ST(0) = sv_2mortal(Perl_newSVpvf(aTHX_ "0x%"UVxf, (UV)hash));
+ ST(0) = sv_2mortal(Perl_newSVpvf(aTHX_ "0x%" UVxf, (UV)hash));
#define cast_I32(foo) (I32)foo
IV
B::OP::savefree = 48
B::OP::static = 49
B::OP::folded = 50
- B::OP::lastsib = 51
+ B::OP::moresib = 51
B::OP::parent = 52
B::METHOP::first = 53
B::METHOP::meth_sv = 54
ret = make_sv_object(aTHX_ (SV *)CopSTASH((COP*)o));
break;
#endif
-#if PERL_VERSION >= 17 || !defined USE_ITHREADS
case 24: /* B::COP::stashpv */
-# if PERL_VERSION >= 17
ret = sv_2mortal(CopSTASH((COP*)o)
&& SvTYPE(CopSTASH((COP*)o)) == SVt_PVHV
? newSVhek(HvNAME_HEK(CopSTASH((COP*)o)))
: &PL_sv_undef);
-# else
- ret = sv_2mortal(newSVpv(CopSTASHPV((COP*)o), 0));
-# endif
break;
-#endif
case 26: /* B::OP::size */
- ret = sv_2mortal(newSVuv((UV)(opsizes[cc_opclass(aTHX_ o)])));
+ ret = sv_2mortal(newSVuv((UV)(opsizes[op_class(o)])));
break;
case 27: /* B::OP::name */
case 28: /* B::OP::desc */
case 30: /* B::OP::type */
case 31: /* B::OP::opt */
case 32: /* B::OP::spare */
-#if PERL_VERSION >= 17
case 47: /* B::OP::slabbed */
case 48: /* B::OP::savefree */
case 49: /* B::OP::static */
-#if PERL_VERSION >= 19
case 50: /* B::OP::folded */
- case 51: /* B::OP::lastsib */
-#endif
-#endif
+ case 51: /* B::OP::moresib */
/* These are all bitfields, so we can't take their addresses */
ret = sv_2mortal(newSVuv((UV)(
ix == 30 ? o->op_type
: ix == 48 ? o->op_savefree
: ix == 49 ? o->op_static
: ix == 50 ? o->op_folded
- : ix == 51 ? o->op_lastsib
+ : ix == 51 ? o->op_moresib
: o->op_spare)));
break;
case 33: /* B::LISTOP::children */
}
break;
case 34: /* B::PMOP::pmreplroot */
- if (cPMOPo->op_type == OP_PUSHRE) {
-#ifdef USE_ITHREADS
- ret = sv_newmortal();
- sv_setiv(ret, cPMOPo->op_pmreplrootu.op_pmtargetoff);
-#else
- GV *const target = cPMOPo->op_pmreplrootu.op_pmtargetgv;
+ if (cPMOPo->op_type == OP_SPLIT) {
ret = sv_newmortal();
- sv_setiv(newSVrv(ret, target ?
- svclassnames[SvTYPE((SV*)target)] : "B::SV"),
- PTR2IV(target));
+#ifndef USE_ITHREADS
+ if (o->op_private & OPpSPLIT_LEX)
+#endif
+ sv_setiv(ret, cPMOPo->op_pmreplrootu.op_pmtargetoff);
+#ifndef USE_ITHREADS
+ else {
+ GV *const target = cPMOPo->op_pmreplrootu.op_pmtargetgv;
+ sv_setiv(newSVrv(ret, target ?
+ svclassnames[SvTYPE((SV*)target)] : "B::SV"),
+ PTR2IV(target));
+ }
#endif
}
else {
ret = make_sv_object(aTHX_ NULL);
break;
case 41: /* B::PVOP::pv */
- /* OP_TRANS uses op_pv to point to a table of 256 or >=258
- * shorts whereas other PVOPs point to a null terminated
- * string. */
- if ( (cPVOPo->op_type == OP_TRANS
- || cPVOPo->op_type == OP_TRANSR) &&
- (cPVOPo->op_private & OPpTRANS_COMPLEMENT) &&
- !(cPVOPo->op_private & OPpTRANS_DELETE))
- {
- const short* const tbl = (short*)cPVOPo->op_pv;
- const short entries = 257 + tbl[256];
- ret = newSVpvn_flags(cPVOPo->op_pv, entries * sizeof(short), SVs_TEMP);
- }
- else if (cPVOPo->op_type == OP_TRANS || cPVOPo->op_type == OP_TRANSR) {
- ret = newSVpvn_flags(cPVOPo->op_pv, 256 * sizeof(short), SVs_TEMP);
+ /* OP_TRANS uses op_pv to point to a OPtrans_map struct,
+ * whereas other PVOPs point to a null terminated string.
+ * For trans, for now just return the whole struct as a
+ * string and let the caller unpack() it */
+ if ( cPVOPo->op_type == OP_TRANS
+ || cPVOPo->op_type == OP_TRANSR)
+ {
+ const OPtrans_map *const tbl = (OPtrans_map*)cPVOPo->op_pv;
+ ret = newSVpvn_flags(cPVOPo->op_pv,
+ (char*)(&tbl->map[tbl->size + 1])
+ - (char*)tbl,
+ SVs_TEMP);
}
else
ret = newSVpvn_flags(cPVOPo->op_pv, strlen(cPVOPo->op_pv), SVs_TEMP);
PTR2IV(CopHINTHASH_get(cCOPo)));
break;
case 52: /* B::OP::parent */
+#ifdef PERL_OP_PARENT
ret = make_op_object(aTHX_ op_parent(o));
+#else
+ ret = make_op_object(aTHX_ NULL);
+#endif
break;
case 53: /* B::METHOP::first */
/* METHOP struct has an op_first/op_meth_sv union
B::CV cv
PREINIT:
SV *ret;
+ UNOP_AUX_item *aux;
PPCODE:
+ aux = cUNOP_AUXo->op_aux;
switch (o->op_type) {
+ case OP_MULTICONCAT:
+ ret = multiconcat_stringify(o);
+ break;
+
case OP_MULTIDEREF:
ret = multideref_stringify(o, cv);
break;
+
+ case OP_ARGELEM:
+ ret = sv_2mortal(Perl_newSVpvf(aTHX_ "%" IVdf,
+ PTR2IV(aux)));
+ break;
+
+ case OP_ARGCHECK:
+ ret = Perl_newSVpvf(aTHX_ "%" IVdf ",%" IVdf, aux[0].iv, aux[1].iv);
+ if (aux[2].iv)
+ Perl_sv_catpvf(aTHX_ ret, ",%c", (char)aux[2].iv);
+ ret = sv_2mortal(ret);
+ break;
+
default:
ret = sv_2mortal(newSVpvn("", 0));
}
+
ST(0) = ret;
XSRETURN(1);
aux_list(o, cv)
B::OP o
B::CV cv
+ PREINIT:
+ UNOP_AUX_item *aux;
PPCODE:
PERL_UNUSED_VAR(cv); /* not needed on unthreaded builds */
+ aux = cUNOP_AUXo->op_aux;
switch (o->op_type) {
default:
XSRETURN(0); /* by default, an empty list */
+ case OP_ARGELEM:
+ XPUSHs(sv_2mortal(newSViv(PTR2IV(aux))));
+ XSRETURN(1);
+ break;
+
+ case OP_ARGCHECK:
+ EXTEND(SP, 3);
+ PUSHs(sv_2mortal(newSViv(aux[0].iv)));
+ PUSHs(sv_2mortal(newSViv(aux[1].iv)));
+ PUSHs(sv_2mortal(aux[2].iv ? Perl_newSVpvf(aTHX_ "%c",
+ (char)aux[2].iv) : &PL_sv_no));
+ break;
+
+ case OP_MULTICONCAT:
+ {
+ SSize_t nargs;
+ char *p;
+ STRLEN len;
+ U32 utf8 = 0;
+ SV *sv;
+ UNOP_AUX_item *lens;
+
+ /* return (nargs, const string, segment len 0, 1, 2, ...) */
+
+ /* if this changes, this block of code probably needs fixing */
+ assert(PERL_MULTICONCAT_HEADER_SIZE == 5);
+ nargs = aux[PERL_MULTICONCAT_IX_NARGS].ssize;
+ EXTEND(SP, ((SSize_t)(2 + (nargs+1))));
+ PUSHs(sv_2mortal(newSViv((IV)nargs)));
+
+ p = aux[PERL_MULTICONCAT_IX_PLAIN_PV].pv;
+ len = aux[PERL_MULTICONCAT_IX_PLAIN_LEN].ssize;
+ if (!p) {
+ p = aux[PERL_MULTICONCAT_IX_UTF8_PV].pv;
+ len = aux[PERL_MULTICONCAT_IX_UTF8_LEN].ssize;
+ utf8 = SVf_UTF8;
+ }
+ sv = newSVpvn(p, len);
+ SvFLAGS(sv) |= utf8;
+ PUSHs(sv_2mortal(sv));
+
+ lens = aux + PERL_MULTICONCAT_IX_LENGTHS;
+ nargs++; /* loop (nargs+1) times */
+ if (utf8) {
+ U8 *p = (U8*)SvPVX(sv);
+ while (nargs--) {
+ SSize_t bytes = lens->ssize;
+ SSize_t chars;
+ if (bytes <= 0)
+ chars = bytes;
+ else {
+ /* return char lengths rather than byte lengths */
+ chars = utf8_length(p, p + bytes);
+ p += bytes;
+ }
+ lens++;
+ PUSHs(sv_2mortal(newSViv(chars)));
+ }
+ }
+ else {
+ while (nargs--) {
+ PUSHs(sv_2mortal(newSViv(lens->ssize)));
+ lens++;
+ }
+ }
+ break;
+ }
+
case OP_MULTIDEREF:
#ifdef USE_ITHREADS
# define ITEM_SV(item) *av_fetch(comppad, (item)->pad_offset, FALSE);
PAD *comppad = PadlistARRAY(padlist)[1];
#endif
- EXTEND(SP, len);
+ /* len should never be big enough to truncate or wrap */
+ assert(len <= SSize_t_MAX);
+ EXTEND(SP, (SSize_t)len);
PUSHs(sv_2mortal(newSViv(actions)));
while (!last) {
actions = (++items)->uv;
PUSHs(sv_2mortal(newSVuv(actions)));
continue;
+ NOT_REACHED; /* NOTREACHED */
case MDEREF_HV_padhv_helem:
is_hash = TRUE;
+ /* FALLTHROUGH */
case MDEREF_AV_padav_aelem:
PUSHs(sv_2mortal(newSVuv((++items)->pad_offset)));
goto do_elem;
+ NOT_REACHED; /* NOTREACHED */
case MDEREF_HV_gvhv_helem:
is_hash = TRUE;
+ /* FALLTHROUGH */
case MDEREF_AV_gvav_aelem:
sv = ITEM_SV(++items);
PUSHs(make_sv_object(aTHX_ sv));
goto do_elem;
+ NOT_REACHED; /* NOTREACHED */
case MDEREF_HV_gvsv_vivify_rv2hv_helem:
is_hash = TRUE;
+ /* FALLTHROUGH */
case MDEREF_AV_gvsv_vivify_rv2av_aelem:
sv = ITEM_SV(++items);
PUSHs(make_sv_object(aTHX_ sv));
goto do_vivify_rv2xv_elem;
+ NOT_REACHED; /* NOTREACHED */
case MDEREF_HV_padsv_vivify_rv2hv_helem:
is_hash = TRUE;
+ /* FALLTHROUGH */
case MDEREF_AV_padsv_vivify_rv2av_aelem:
PUSHs(sv_2mortal(newSVuv((++items)->pad_offset)));
goto do_vivify_rv2xv_elem;
+ NOT_REACHED; /* NOTREACHED */
case MDEREF_HV_pop_rv2hv_helem:
case MDEREF_HV_vivify_rv2hv_helem:
is_hash = TRUE;
+ /* FALLTHROUGH */
do_vivify_rv2xv_elem:
case MDEREF_AV_pop_rv2av_aelem:
case MDEREF_AV_vivify_rv2av_aelem:
#define PVMG_stash_ix sv_SVp | STRUCT_OFFSET(struct xpvmg, xmg_stash)
-#if PERL_VERSION > 18
-# define PVBM_useful_ix sv_IVp | STRUCT_OFFSET(struct xpviv, xiv_u.xivu_iv)
-#elif PERL_VERSION > 14
-# define PVBM_useful_ix sv_I32p | STRUCT_OFFSET(struct xpvgv, xnv_u.xbm_s.xbm_useful)
-#else
-#define PVBM_useful_ix sv_I32p | STRUCT_OFFSET(struct xpvgv, xiv_u.xivu_i32)
-#endif
+#define PVBM_useful_ix sv_IVp | STRUCT_OFFSET(struct xpviv, xiv_u.xivu_iv)
#define PVLV_targoff_ix sv_U32p | STRUCT_OFFSET(struct xpvlv, xlv_targoff)
#define PVLV_targlen_ix sv_U32p | STRUCT_OFFSET(struct xpvlv, xlv_targlen)
#define PVAV_max_ix sv_SSize_tp | STRUCT_OFFSET(struct xpvav, xav_max)
#define PVCV_stash_ix sv_SVp | STRUCT_OFFSET(struct xpvcv, xcv_stash)
-#if PERL_VERSION > 17 || (PERL_VERSION == 17 && PERL_SUBVERSION >= 3)
-# define PVCV_gv_ix sv_SVp | STRUCT_OFFSET(struct xpvcv, xcv_gv_u.xcv_gv)
-#else
-# define PVCV_gv_ix sv_SVp | STRUCT_OFFSET(struct xpvcv, xcv_gv)
-#endif
+#define PVCV_gv_ix sv_SVp | STRUCT_OFFSET(struct xpvcv, xcv_gv_u.xcv_gv)
#define PVCV_file_ix sv_char_pp | STRUCT_OFFSET(struct xpvcv, xcv_file)
#define PVCV_outside_ix sv_SVp | STRUCT_OFFSET(struct xpvcv, xcv_outside)
#define PVCV_outside_seq_ix sv_U32p | STRUCT_OFFSET(struct xpvcv, xcv_outside_seq)
#define PVCV_flags_ix sv_U32p | STRUCT_OFFSET(struct xpvcv, xcv_flags)
#define PVHV_max_ix sv_STRLENp | STRUCT_OFFSET(struct xpvhv, xhv_max)
-
-#if PERL_VERSION > 12
#define PVHV_keys_ix sv_STRLENp | STRUCT_OFFSET(struct xpvhv, xhv_keys)
-#else
-#define PVHV_keys_ix sv_IVp | STRUCT_OFFSET(struct xpvhv, xhv_keys)
-#endif
# The type checking code in B has always been identical for all SV types,
# irrespective of whether the action is actually defined on that SV.
SvNV(sv)
B::NV sv
-#if PERL_VERSION < 11
-
-MODULE = B PACKAGE = B::RV PREFIX = Sv
-
-void
-SvRV(sv)
- B::RV sv
- PPCODE:
- PUSHs(make_sv_object(aTHX_ SvRV(sv)));
-
-#else
-
MODULE = B PACKAGE = B::REGEXP
void
PUSHi(PTR2IV(sv));
}
-#endif
-
MODULE = B PACKAGE = B::PV
void
U32 utf8 = 0;
CODE:
if (ix == 3) {
-#ifndef PERL_FBM_TABLE_OFFSET
const MAGIC *const mg = mg_find(sv, PERL_MAGIC_bm);
if (!mg)
croak("argument to B::BM::TABLE is not a PVBM");
p = mg->mg_ptr;
len = mg->mg_len;
-#else
- p = SvPV(sv, len);
- /* Boyer-Moore table is just after string and its safety-margin \0 */
- p += len + PERL_FBM_TABLE_OFFSET;
- len = 256;
-#endif
} else if (ix == 2) {
/* This used to read 257. I think that that was buggy - should have
been 258. (The "\0", the flags byte, and 256 for the table.)
5.15 and later store the BM table via MAGIC, so the compiler
should handle this just fine without changes if PVBM now
always returns the SvPVX() buffer. */
-#ifdef isREGEXP
p = isREGEXP(sv)
? RX_WRAPPED_const((REGEXP*)sv)
: SvPVX_const(sv);
-#else
- p = SvPVX_const(sv);
-#endif
-#ifdef PERL_FBM_TABLE_OFFSET
- len = SvCUR(sv) + (SvVALID(sv) ? 256 + PERL_FBM_TABLE_OFFSET : 0);
-#else
len = SvCUR(sv);
-#endif
} else if (ix) {
-#ifdef isREGEXP
p = isREGEXP(sv) ? RX_WRAPPED((REGEXP*)sv) : SvPVX(sv);
-#else
- p = SvPVX(sv);
-#endif
len = strlen(p);
} else if (SvPOK(sv)) {
len = SvCUR(sv);
p = SvPVX_const(sv);
utf8 = SvUTF8(sv);
- }
-#ifdef isREGEXP
- else if (isREGEXP(sv)) {
+ } else if (isREGEXP(sv)) {
len = SvCUR(sv);
p = RX_WRAPPED_const((REGEXP*)sv);
utf8 = SvUTF8(sv);
- }
-#endif
- else {
+ } else {
/* XXX for backward compatibility, but should fail */
/* croak( "argument is not SvPOK" ); */
p = NULL;
BmPREVIOUS(sv)
B::BM sv
CODE:
-#if PERL_VERSION >= 19
PERL_UNUSED_VAR(sv);
-#endif
RETVAL = BmPREVIOUS(sv);
OUTPUT:
RETVAL
BmRARE(sv)
B::BM sv
CODE:
-#if PERL_VERSION >= 19
PERL_UNUSED_VAR(sv);
-#endif
RETVAL = BmRARE(sv);
OUTPUT:
RETVAL
isGV_with_GP = 1
CODE:
if (ix) {
- RETVAL = isGV_with_GP(gv) ? TRUE : FALSE;
+ RETVAL = cBOOL(isGV_with_GP(gv));
} else {
RETVAL = GvGP(gv) == Null(GP*);
}
CvDEPTH(cv)
B::CV cv
-#ifdef PadlistARRAY
-
B::PADLIST
CvPADLIST(cv)
B::CV cv
OUTPUT:
RETVAL
-#else
-
-B::AV
-CvPADLIST(cv)
- B::CV cv
- PPCODE:
- PUSHs(make_sv_object(aTHX_ (SV *)CvPADLIST(cv)));
-
-
-#endif
-
SV *
CvHSCXT(cv)
B::CV cv
CODE:
ST(0) = make_sv_object(aTHX_ (SV*)CvGV(cv));
-#if PERL_VERSION > 17
-
SV *
NAME_HEK(cv)
B::CV cv
OUTPUT:
RETVAL
-#endif
-
MODULE = B PACKAGE = B::HV PREFIX = Hv
STRLEN
PPCODE:
if (HvUSEDKEYS(hv) > 0) {
HE *he;
+ SSize_t extend_size;
(void)hv_iterinit(hv);
- EXTEND(sp, HvUSEDKEYS(hv) * 2);
+ /* 2*HvUSEDKEYS() should never be big enough to truncate or wrap */
+ assert(HvUSEDKEYS(hv) <= (SSize_t_MAX >> 1));
+ extend_size = (SSize_t)HvUSEDKEYS(hv) * 2;
+ EXTEND(sp, extend_size);
while ((he = hv_iternext(hv))) {
if (HeSVKEY(he)) {
mPUSHs(HeSVKEY(he));
HASH(h)
B::RHE h
CODE:
- RETVAL = newRV( (SV*)cophh_2hv(h, 0) );
+ RETVAL = newRV_noinc( (SV*)cophh_2hv(h, 0) );
OUTPUT:
RETVAL
-#ifdef PadlistARRAY
-
MODULE = B PACKAGE = B::PADLIST PREFIX = Padlist
SSize_t
OUTPUT:
RETVAL
-#endif
-
MODULE = B PACKAGE = B::PADNAMELIST PREFIX = Padnamelist
void