B-C
view release on metacpan or search on metacpan
op->op_first = NULL;
op->op_last = NULL;
#if PERL_VERSION < 10
op->op_pmreplroot = NULL;
op->op_pmreplstart = NULL;
op->op_pmnext = NULL;
#endif
#if defined(USE_ITHREADS) && (PERL_VERSION > 7)
op->op_pmoffset = 0;
#else
op->op_pmregexp = 0;
#endif
sv_setiv( key, PTR2IV( rx ) );
sv_setref_iv( rv, "B::PMOP", PTR2IV( op ) );
#if defined(DEBUGGING) && (PERL_VERSION > 7)
if (DEBUG_D_TEST_) fprintf(stderr, "pmop %p => rx %s %p 0x%x %s\n",
op, PL_op_name[type], rx, (unsigned)op->op_pmflags,
RX_WRAPPED(rx));
#endif
hv_store_ent( regexp_hv, key, rv, 0 );
}
} while ((PL_op = CALL_FPTR(PL_op->op_ppaddr)(aTHX)));
SvREFCNT_dec( key );
TAINT_NOT;
return 0;
}
MODULE = B__MAGIC PACKAGE = B::MAGIC
#if PERL_VERSION < 7
SV*
precomp(mg)
B::MAGIC mg
CODE:
if (mg->mg_type == 'r') {
REGEXP* rx = (REGEXP*)mg->mg_obj;
RETVAL = Nullsv;
if (rx)
RETVAL = newSVpvn( rx->precomp, rx->prelen );
}
else {
croak( "precomp is only meaningful on r-magic" );
}
OUTPUT:
RETVAL
#endif
MODULE = B PACKAGE = B::PMOP
#if defined(RX_UTF8) && PERL_VERSION < 20
SV*
precomp(o)
B::OP o
PPCODE:
{
if (SvROK(ST(0))) {
IV tmp = SvIV((SV*)SvRV(ST(0)));
o = INT2PTR(B__OP,tmp);
}
else
croak("precomp(o) argument is not a reference");
if (o) {
REGEXP *rx = PM_GETRE(cPMOPo);
if (!rx)
XSRETURN_UNDEF;
ST(0) = sv_2mortal(newSVpvn_flags(RX_PRECOMP(rx), RX_PRELEN(rx), RX_UTF8(rx) ? SVf_UTF8 : 0));
XSRETURN(1);
} else {
XSRETURN_UNDEF;
}
}
#endif
MODULE = B PACKAGE = B::HV
IV
Gv_AMG(stash)
B::HV stash
CODE:
RETVAL = (!SvREADONLY(stash) && Gv_AMG(stash)) ? 1 : 0;
OUTPUT:
RETVAL
#if PERL_VERSION > 13
# returns a single or multiple ENAME(s), since 5.14
void
ENAMES(hv)
B::HV hv
PPCODE:
if (SvOOK(hv)) {
if (HvENAME_HEK(hv)) {
I32 i = 0;
const I32 count = HvAUX(hv)->xhv_name_count;
if (count) {
HEK** names = HvAUX(hv)->xhv_name_u.xhvnameu_names;
HEK *const *hekp = names + (count < 0 ? 1 : 0);
HEK *const *const endp = names + (count < 0 ? -count : count);
while (hekp < endp) {
assert(*hekp);
PUSHs(newSVpvn_flags(HEK_KEY(*hekp), HEK_LEN(*hekp),
HEK_UTF8(*hekp) ? SVf_UTF8|SVs_TEMP : SVs_TEMP));
++hekp;
i++;
}
XSRETURN(i);
}
else {
HEK *const hek = HvENAME_HEK_NN(hv);
ST(0) = newSVpvn_flags(HEK_KEY(hek), HEK_LEN(hek),
HEK_UTF8(hek) ? SVf_UTF8|SVs_TEMP : SVs_TEMP);
XSRETURN(1);
}
}
}
XSRETURN_UNDEF;
I32
name_count(hv)
B::HV hv
PPCODE:
PERL_UNUSED_VAR(RETVAL);
PERL_UNUSED_VAR(TARG);
if (SvOOK(hv))
mPUSHi(HvAUX(hv)->xhv_name_count);
else
mPUSHi(0);
XSRETURN(1);
#endif
MODULE = B PACKAGE = B::UNOP_AUX
#if PERL_VERSION > 21
SV*
aux(o)
B::OP o
CODE:
{
UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
UV len = items[-1].uv;
RETVAL = newSVpvn_flags((char*)&items[-1], (1+len) * sizeof(UNOP_AUX_item), 0);
}
OUTPUT:
RETVAL
# Needed only for the ill-designed perl5 signatures: argelem
SV*
aux_ptr2iv(o)
B::OP o
CODE:
RETVAL = newSViv(PTR2IV(cUNOP_AUXo->op_aux));
OUTPUT:
RETVAL
# Return the contents of the op_aux array as a list of IV/SV/GV/PADOFFSET objects.
# This version here returns the padoffset of SV/GV under ithreads, and not the
# SV/GV itself. It also uses simplified mPUSH macros.
# With MCONCAT contrary to B::aux_list always return both slots, binary and utf8.
# The design of the upstream aux_list method deviates significantly from proper B design.
void
aux_list_thr(o)
B::OP o
PPCODE:
PERL_UNUSED_VAR(cv); /* not needed on unthreaded builds */
switch (o->op_type) {
default:
XSRETURN(0); /* by default, an empty list */
case OP_MULTIDEREF:
#ifdef USE_ITHREADS
# define PUSH_SV(item) mPUSHu((item)->pad_offset)
#else
# define PUSH_SV(item) PUSHs(make_sv_object(aTHX_ (item)->sv))
#endif
{
UNOP_AUX_item *items = cUNOP_AUXo->op_aux;
UV actions = items->uv;
UV len = items[-1].uv;
bool last = 0;
bool is_hash = FALSE;
assert(len <= SSize_t_MAX);
EXTEND(SP, (SSize_t)len);
mPUSHu(actions);
while (!last) {
switch (actions & MDEREF_ACTION_MASK) {
case MDEREF_reload:
actions = (++items)->uv;
mPUSHu(actions);
continue;
NOT_REACHED; /* NOTREACHED */
case MDEREF_HV_padhv_helem:
is_hash = TRUE;
/* FALLTHROUGH */
case MDEREF_AV_padav_aelem:
mPUSHu((++items)->pad_offset);
goto do_elem;
NOT_REACHED; /* NOTREACHED */
case MDEREF_HV_gvhv_helem:
is_hash = TRUE;
/* FALLTHROUGH */
case MDEREF_AV_gvav_aelem:
PUSH_SV(++items);
goto do_elem;
NOT_REACHED; /* NOTREACHED */
case MDEREF_HV_gvsv_vivify_rv2hv_helem:
is_hash = TRUE;
/* FALLTHROUGH */
case MDEREF_AV_gvsv_vivify_rv2av_aelem:
PUSH_SV(++items);
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:
mPUSHu((++items)->pad_offset);
nargs++; /* loop (nargs+1) times */
while (nargs--) {
mPUSHi(lens->ssize);
lens++;
}
break;
}
#endif
} /* switch */
XSRETURN(0); /* force removal of PUTBACK, return */
#endif
#if PERL_VERSION > 21
MODULE = B PACKAGE = B::PADNAME PREFIX = Padname
int
PadnameGEN(padn)
B::PADNAME padn
CODE:
RETVAL = padn->xpadn_gen;
OUTPUT:
RETVAL
MODULE = B PACKAGE = B::PADNAMELIST PREFIX = Padnamelist
size_t
PadnamelistMAXNAMED(padnl)
B::PADNAMELIST padnl
#endif
MODULE = B PACKAGE = B::REGEXP PREFIX = RX_
#if PERL_VERSION > 10
U32
RX_EXTFLAGS(rx)
B::REGEXP rx
#endif
MODULE = B PACKAGE = B::COP PREFIX = COP_
#ifdef need_COP_stashflags
#define COP_stashflags(o) CopSTASH_flags(o)
U32
COP_stashflags(o)
B::COP o
#endif
#ifdef CopLABEL_len_flags
SV*
COP_label(o)
B::OP o
PPCODE:
{
STRLEN len;
U32 flags;
const char *pv = CopLABEL_len_flags(cCOPo, &len, &flags);
PERL_UNUSED_VAR(RETVAL);
ST(0) = pv ? sv_2mortal(newSVpvn_flags(pv, len, flags))
: &PL_sv_undef;
}
XSRETURN(1);
#endif
MODULE = B__CC PACKAGE = B::CC
PROTOTYPES: DISABLE
# Perl_ck_null is not exported on Windows, so disable autovivification
# optimizations there
U32
_autovivification(cop)
B::COP cop
CODE:
{
SV *hint;
IV h;
RETVAL = 1;
if (PL_check[OP_PADSV] != PL_check[0]) {
/*char *package = CopSTASHPV(cop);*/
#ifdef cop_hints_fetch_pvn
hint = cop_hints_fetch_pvn(cop, "autovivification", strlen("autovivification"), a_hash, 0);
#elif PERL_VERSION > 9
hint = Perl_refcounted_he_fetch(aTHX_ cop->cop_hints_hash,
NULL, "autovivification", strlen("autovivification"), 0, a_hash);
#else
SV **val = hv_fetch(GvHV(PL_hintgv), "autovivification", strlen("autovivification"), 0);
if (!val)
return;
hint = *val;
#endif
if (!(hint && SvIOK(hint)))
return;
h = SvIVX(hint);
if (h & 4) /* A_HINT_FETCH 4 */
RETVAL = 0;
}
}
OUTPUT:
RETVAL
MODULE = B__OP PACKAGE = B::OP PREFIX = op_
#ifdef need_op_slabbed
I32
op_slabbed(op)
B::OP op
PPCODE:
mPUSHi(op->op_slabbed);
I32
op_savefree(op)
B::OP op
PPCODE:
mPUSHi(op->op_savefree);
I32
op_static(op)
B::OP op
PPCODE:
mPUSHi(op->op_static);
#endif
#ifdef need_op_folded
I32
op_folded(op)
B::OP op
PPCODE:
mPUSHi(op->op_folded);
#endif
MODULE = B PACKAGE = B::HV PREFIX = Hv
#ifdef need_HvARRAY_utf8
void
HvARRAY_utf8(hv)
B::HV hv
PPCODE:
if (HvKEYS(hv) > 0) {
HE *he;
(void)hv_iterinit(hv);
EXTEND(sp, HvKEYS(hv) * 2);
while ((he = hv_iternext(hv))) {
if (HeSVKEY(he)) {
mPUSHs(HeSVKEY(he));
} else if (HeKUTF8(he)) {
PUSHs(newSVpvn_flags(HeKEY(he), HeKLEN(he), SVf_UTF8|SVs_TEMP));
} else {
mPUSHp(HeKEY(he), HeKLEN(he));
}
PUSHs(make_sv_object(aTHX_ HeVAL(he)));
}
}
#endif
MODULE = B__C PACKAGE = B::C
#if PERL_VERSION >= 10
SV*
get_linear_isa(classname)
SV* classname;
CODE:
{
HV *class_stash = gv_stashsv(classname, 0);
if (!class_stash) {
/* No stash exists yet, give them just the classname */
AV* isalin = newAV();
av_push(isalin, newSVsv(classname));
RETVAL = newRV(MUTABLE_SV(isalin));
}
else { /* just dfs */
RETVAL = newRV(MUTABLE_SV(Perl_mro_get_linear_isa(aTHX_ class_stash)));
}
}
OUTPUT:
RETVAL
#endif
BOOT:
#if PERL_VERSION >= 10
{
MY_CXT_INIT;
#endif
PL_runops = my_runops;
#if PERL_VERSION >= 10
{
dMY_CXT;
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] = (SV *) pWARN_ALL;
specialsv_list[5] = (SV *) pWARN_NONE;
specialsv_list[6] = (SV *) pWARN_STD;
( run in 0.942 second using v1.01-cache-2.11-cpan-71847e10f99 )