view release on metacpan or  search on metacpan

Alias.xs  view on Meta::CPAN

PROTOTYPES: DISABLE

BOOT:
	{
	dDA;
	DA_INIT;
	da_cv = get_cv("Data::Alias::alias", TRUE);
	da_cvc = get_cv("Data::Alias::copy", TRUE);
	wrap_op_checker(OP_RV2CV, da_ck_rv2cv, &da_old_ck_rv2cv);
	wrap_op_checker(OP_ENTERSUB, da_ck_entersub, &da_old_ck_entersub);
#if (PERL_COMBI_VERSION >= 5021007)
	{
		/*
		 * The multideref peep-time optimisation, introduced in
		 * Perl 5.21.7, is liable to incorporate into a multideref
		 * op aelem/helem ops that we need to modify.  Because our
		 * modification of those ops gets applied late at peep
		 * time, after the main peeper, the specialness of the
		 * ops doesn't get a chance to inhibit incorporation
		 * into a multideref.  As an ugly hack, we disable the
		 * multideref optimisation entirely for these op types
		 * by hooking their checking (and not actually doing
		 * anything in the checker).
		 *
		 * The multideref peep-time code has no logical
		 * reason to look at whether the op checking is in a
		 * non-default state.  It deals with already-checked ops,
		 * so a check hook cannot make any difference to the
		 * future behaviour of those ops.  Rather, it should,
		 * but currently (5.23.4) doesn't, check that op_ppaddr
		 * of the op to be incorporated has the standard value.
		 * If the superfluous PL_check[] check goes away, this
		 * hack will break.
		 *
		 * The proper fix for this problem would be to move our op
		 * munging from peep time to op check time.  When ops are
		 * placed into an alias() wrapper they should be walked,
		 * and the contained assignments and lvalues modified.
		 * The modified lvalue aelem/helem ops would thereby be
		 * made visibly non-standard in plenty of time for the
		 * multideref peep-time code to avoid replacing them.
		 * If the multideref code is changed to look at op_ppaddr
		 * then that change alone will be sufficient; failing
		 * that the op_type can be changed to OP_CUSTOM.
		 */
		wrap_op_checker(OP_AELEM, da_ck_aelem, &da_old_ck_aelem);
		wrap_op_checker(OP_HELEM, da_ck_helem, &da_old_ck_helem);
	}
#endif
	CvLVALUE_on(get_cv("Data::Alias::deref", TRUE));
	da_old_peepp = PL_peepp;
	PL_peepp = da_peep;
	}

void
deref(...)
    PREINIT:
	I32 i, n = 0;
	SV *sv;
    PPCODE:
	for (i = 0; i < items; i++) {
		if (!SvROK(ST(i))) {
			STRLEN z;
			if (SvOK(ST(i)))
				Perl_croak(aTHX_ DA_DEREF_ERR, SvPV(ST(i), z));
			if (ckWARN(WARN_UNINITIALIZED))
				Perl_warner(aTHX_ packWARN(WARN_UNINITIALIZED),
					"Use of uninitialized value in deref");
			continue;
		}
		sv = SvRV(ST(i));
		switch (SvTYPE(sv)) {
			I32 x;
		case SVt_PVAV:
			if (!(x = av_len((AV *) sv) + 1))
				continue;
			SP += x;
			break;
		case SVt_PVHV:
			if (!(x = HvKEYS(sv)))
				continue;
			SP += x * 2;
			break;
		case SVt_PVCV:
			Perl_croak(aTHX_ "Can't deref subroutine reference");
		case SVt_PVFM:
			Perl_croak(aTHX_ "Can't deref format reference");
		case SVt_PVIO:
			Perl_croak(aTHX_ "Can't deref filehandle reference");
		default:
			SP++;
		}
		ST(n++) = ST(i);
	}
	EXTEND(SP, 0);
	for (i = 0; n--; ) {
		SV *sv = SvRV(ST(n));
		I32 x = SvTYPE(sv);
		if (x == SVt_PVAV) {
			i -= x = AvFILL((AV *) sv) + 1;
			Copy(AvARRAY((AV *) sv), SP + i + 1, INT2SIZE(x), SV *);
		} else if (x == SVt_PVHV) {
			HE *entry;
			HV *hv = (HV *) sv;
			i -= x = hv_iterinit(hv) * 2;
			PUTBACK;
			while ((entry = hv_iternext(hv))) {
				sv = hv_iterkeysv(entry);
				SvREADONLY_on(sv);
				SPAGAIN;
				SP[++i] = sv;
				sv = hv_iterval(hv, entry);
				SPAGAIN;
				SP[++i] = sv;
			}
			i -= x;
		} else {
			SP[i--] = sv;
		}
	}