view release on metacpan or  search on metacpan

lib/Sub/Filter.xs  view on Meta::CPAN

	if(op->op_flags & OPf_KIDS) {
		OP *kid;
		for(kid = cUNOPx(op)->op_first; kid; kid = kid->op_sibling) {
			apply_retfilter_to_psub_relink_ops(kid, opmap);
		}
	}
}

#define apply_retfilter_to_psub(target, filter) \
	THX_apply_retfilter_to_psub(aTHX_ target, filter)
static void THX_apply_retfilter_to_psub(pTHX_ CV *target, CV *filter)
{
	OP *root, *blockmarkop;
	PTR_TBL_t *opmap;
	if(CvDEPTH(target)) croak("can't modify active subroutine");
	root = CvROOT(target);
	OP_REFCNT_LOCK;
	if(OpREFCNT(root) > 1) {
		OP_REFCNT_UNLOCK;
		croak("can't modify shared code%s",
			CvCLONED(target) ?
				" (closure sharing with its prototype?)"
			: CvCLONE(target) ?
				" (closure prototype sharing with closures?)"
			: "");
	}
	blockmarkop = newOP(OP_PUSHMARK, 0);
	blockmarkop->op_ppaddr = pp_blockmark;
	blockmarkop->op_next = CvSTART(target);
	link_op(root, blockmarkop);
	CvSTART(target) = blockmarkop;
	opmap = ptr_table_new();
	apply_retfilter_to_psub_gen_calls(root, filter, root, opmap);
	apply_retfilter_to_psub_relink_ops(root, opmap);
	OP_REFCNT_UNLOCK;
	ptr_table_free(opmap);
}

MODULE = Sub::Filter PACKAGE = Sub::Filter

PROTOTYPES: DISABLE

void
mutate_sub_filter_return(CV *target, CV *filter)
PROTOTYPE: $$
CODE:
	if(!CvROOT(target) && !CvXSUB(target))
		croak("can't apply return filter to undefined subroutine");
	if(CvISXSUB(target)) {
		apply_retfilter_to_xsub(target, filter);
	} else {
		apply_retfilter_to_psub(target, filter);
	}

void
_test_xs(...)
PROTOTYPE: @
PREINIT:
	AV *av;
	I32 i, len;
PPCODE:
	av = get_av("Sub::Filter::got_in", 1);
	av_clear(av);
	for(i = 0; i != items; i++)
		av_store(av, i, SvREFCNT_inc(ST(i)));
	av = get_av("Sub::Filter::want_out", 1);
	len = av_len(av) + 1;
	for(i = 0; i != len; i++)
		XPUSHs(sv_2mortal(SvREFCNT_inc(*av_fetch(av, i, 0))));