view release on metacpan or  search on metacpan

Var.xs  view on Meta::CPAN

#ifndef SvRV_set
# define SvRV_set(SV, VAL) (SvRV(SV) = (VAL))
#endif /* !SvRV_set */

#ifndef newSV_type
# define newSV_type(type) THX_newSV_type(aTHX_ type)
static SV *THX_newSV_type(pTHX_ svtype type)
{
	SV *sv = newSV(0);
	(void) SvUPGRADE(sv, type);
	return sv;
}
#endif /* !newSV_type */

#ifndef SVfARG
# define SVfARG(p) ((void *)p)
#endif /* !SVfARG */

#ifndef GV_NOTQUAL
# define GV_NOTQUAL 0
#endif /* !GV_NOTQUAL */

#ifndef padnamelist_store
 /* Note that the return values are different.  If we ever call it in non-
    void context, we would have to change it to *av_store.  */
# define padnamelist_store av_store
#endif

/*
 * scalar classification
 *
 * Logic borrowed from Params::Classify.
 */

#define sv_is_glob(sv) (SvTYPE(sv) == SVt_PVGV)

#if PERL_VERSION_GE(5,11,0)
# define sv_is_regexp(sv) (SvTYPE(sv) == SVt_REGEXP)
#else /* <5.11.0 */
# define sv_is_regexp(sv) 0
#endif /* <5.11.0 */

#define sv_is_string(sv) \
	(!sv_is_glob(sv) && !sv_is_regexp(sv) && \
	 (SvFLAGS(sv) & (SVf_IOK|SVf_NOK|SVf_POK|SVp_IOK|SVp_NOK|SVp_POK)))

/*
 * gen_const_identity_op()
 *
 * This function generate op that evaluates to a fixed object identity
 * and can also participate in constant folding.
 *
 * Lexical::Var generally needs to make ops that evaluate to fixed
 * identities, that being what a name that it handles represents.
 * Normally it can do this by means of an rv2xv op applied to a const op,
 * where the const op holds an RV that references the object of interest.
 * However, rv2xv can't undergo constant folding.  Where the object is
 * a readonly scalar, we'd like it to take part in constant folding.
 * The obvious way to make it work as a constant for folding is to use a
 * const op that directly holds the object.  However, in a Perl built for
 * ithreads, the value in a const op gets moved into the pad to achieve
 * clonability, and in the process the value may be copied rather than the
 * object merely rereferenced.  Generally, the const op only guarantees
 * to provide a fixed *value*, not a fixed object identity.
 *
 * Where a const op might not preserve object identity, we can achieve
 * preservation by means of a customised variant of the const op.  The op
 * directly holds an RV that references the object of interest, and its
 * variant pp function dereferences it (as rv2sv would).  The pad logic
 * operates on the op structure as normal, and may copy the RV without
 * preserving its identity, which is OK because the RV isn't what we
 * need to preserve.  Being labelled as a const op, it is eligible for
 * constant folding.  When actually executed, it evaluates to the object
 * of interest, providing both fixed value and fixed identity.
 */

#ifdef USE_ITHREADS
# define Q_USE_ITHREADS 1
#else /* !USE_ITHREADS */
# define Q_USE_ITHREADS 0
#endif /* !USE_ITHREADS */

#define Q_CONST_COPIES Q_USE_ITHREADS

#if Q_CONST_COPIES
static OP *pp_const_via_ref(pTHX)
{
	dSP;
	SV *reference_sv = cSVOPx_sv(PL_op);
	SV *referent_sv = SvRV(reference_sv);
	PUSHs(referent_sv);
	RETURN;
}
#endif /* Q_CONST_COPIES */

#define gen_const_identity_op(sv) THX_gen_const_identity_op(aTHX_ sv)
static OP *THX_gen_const_identity_op(pTHX_ SV *sv)
{
#if Q_CONST_COPIES
	OP *op = newSVOP(OP_CONST, 0, newRV_noinc(sv));
	op->op_ppaddr = pp_const_via_ref;
	return op;
#else /* !Q_CONST_COPIES */
	return newSVOP(OP_CONST, 0, sv);
#endif /* !Q_CONST_COPIES */
}

/*
 * %^H key names
 */

#define KEYPREFIX "Lexical::Var/"
#define KEYPREFIXLEN (sizeof(KEYPREFIX)-1)

#define LEXPADPREFIX "Lexical::Var::<LEX>"
#define LEXPADPREFIXLEN (sizeof(LEXPADPREFIX)-1)

#define CHAR_IDSTART 0x01
#define CHAR_IDCONT  0x02
#define CHAR_SIGIL   0x10
#define CHAR_USEPAD  0x20