#define SvFLAGS(sv) (sv)->sv_flags
#define SvREFCNT(sv) (sv)->sv_refcnt
-#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-# define SvREFCNT_inc(sv) \
- ({ \
- SV * const _sv = MUTABLE_SV(sv); \
- if (_sv) \
- (SvREFCNT(_sv))++; \
- _sv; \
- })
-# define SvREFCNT_inc_simple(sv) \
- ({ \
- if (sv) \
- (SvREFCNT(sv))++; \
- MUTABLE_SV(sv); \
- })
-# define SvREFCNT_inc_NN(sv) \
- ({ \
- SV * const _sv = MUTABLE_SV(sv); \
- SvREFCNT(_sv)++; \
- _sv; \
- })
-# define SvREFCNT_inc_void(sv) \
- ({ \
- SV * const _sv = MUTABLE_SV(sv); \
- if (_sv) \
- (void)(SvREFCNT(_sv)++); \
- })
-#else
-# define SvREFCNT_inc(sv) \
- ((PL_Sv=MUTABLE_SV(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
-# define SvREFCNT_inc_simple(sv) \
- ((sv) ? (SvREFCNT(sv)++,MUTABLE_SV(sv)) : NULL)
-# define SvREFCNT_inc_NN(sv) \
- (PL_Sv=MUTABLE_SV(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
-# define SvREFCNT_inc_void(sv) \
- (void)((PL_Sv=MUTABLE_SV(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
-#endif
+#define SvREFCNT_inc(sv) S_SvREFCNT_inc(MUTABLE_SV(sv))
+#define SvREFCNT_inc_simple(sv) SvREFCNT_inc(sv)
+#define SvREFCNT_inc_NN(sv) S_SvREFCNT_inc_NN(MUTABLE_SV(sv))
+#define SvREFCNT_inc_void(sv) S_SvREFCNT_inc_void(MUTABLE_SV(sv))
/* These guys don't need the curly blocks */
#define SvREFCNT_inc_simple_void(sv) STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
#define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT(MUTABLE_SV(sv)))
#define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT(MUTABLE_SV(sv)))
-#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-# define SvREFCNT_dec(sv) \
- ({ \
- SV * const _sv = MUTABLE_SV(sv); \
- if (_sv) { \
- if (SvREFCNT(_sv)) { \
- if (--(SvREFCNT(_sv)) == 0) \
- Perl_sv_free2(aTHX_ _sv); \
- } else { \
- sv_free(_sv); \
- } \
- } \
- })
-#else
-#define SvREFCNT_dec(sv) sv_free(MUTABLE_SV(sv))
-#endif
+#define SvREFCNT_dec(sv) S_SvREFCNT_dec(aTHX_ MUTABLE_SV(sv))
#define SVTYPEMASK 0xff
#define SvTYPE(sv) ((svtype)((sv)->sv_flags & SVTYPEMASK))
-#define SVf_THINKFIRST (SVf_READONLY|SVf_ROK|SVf_FAKE)
+#define SVf_THINKFIRST (SVf_READONLY|SVf_ROK|SVf_FAKE|SVs_RMG)
#define SVf_OK (SVf_IOK|SVf_NOK|SVf_POK|SVf_ROK| \
SVp_IOK|SVp_NOK|SVp_POK|SVpgv_GP)
/* pad name vars only */
#define SVpad_STATE 0x80000000 /* pad name is a "state" var */
+/* MSVC6 generates "error C2099: initializer is not a constant" when
+ * initializing bodies_by_type in sv.c. Workaround the compiler bug by
+ * using an anonymous union, but only for MSVC6 since that isn't C89.
+ */
+#if defined(_MSC_VER) && _MSC_VER < 1300
+# define _XPV_CUR_U_NAME
+# define xpv_cur xpvcuru_cur
+# define xpv_fmdepth xpvcuru_fmdepth
+#else
+# define _XPV_CUR_U_NAME xpv_cur_u
+# define xpv_cur xpv_cur_u.xpvcuru_cur
+# define xpv_fmdepth xpv_cur_u.xpvcuru_fmdepth
+#endif
#define _XPV_HEAD \
HV* xmg_stash; /* class package */ \
union _xmgu xmg_u; \
- STRLEN xpv_cur; /* length of svu_pv as a C string */ \
+ union { \
+ STRLEN xpvcuru_cur; /* length of svu_pv as a C string */ \
+ I32 xpvcuru_fmdepth; \
+ } _XPV_CUR_U_NAME; \
STRLEN xpv_len /* allocated size */
union _xnvu {
} xcv_root_u; \
GV * xcv_gv; \
char * xcv_file; \
- AV * xcv_padlist; \
+ PADLIST * xcv_padlist; \
CV * xcv_outside; \
U32 xcv_outside_seq; /* the COP sequence (at the point of our \
* compilation) in the lexically enclosing \
struct xpvfm {
_XPV_HEAD;
_XPVCV_COMMON;
- IV xfm_lines;
};
#define SvNIOK_off(sv) (SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK| \
SVp_IOK|SVp_NOK|SVf_IVisUV))
-#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-#define assert_not_ROK(sv) ({assert(!SvROK(sv) || !SvRV(sv));}),
-#define assert_not_glob(sv) ({assert(!isGV_with_GP(sv));}),
-#else
-#define assert_not_ROK(sv)
-#define assert_not_glob(sv)
-#endif
+#define assert_not_ROK(sv) assert_(!SvROK(sv) || !SvRV(sv))
+#define assert_not_glob(sv) assert_(!isGV_with_GP(sv))
#define SvOK(sv) ((SvTYPE(sv) == SVt_BIND) \
? (SvFLAGS(SvRV(sv)) & SVf_OK) \
#define SvAMAGIC(sv) (SvROK(sv) && SvOBJECT(SvRV(sv)) && \
HvAMAGIC(SvSTASH(SvRV(sv))))
-#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-# define SvAMAGIC_on(sv) ({ SV * const kloink = sv; \
- assert(SvROK(kloink)); \
- if (SvOBJECT(SvRV(kloink))) \
- HvAMAGIC_on(SvSTASH(SvRV(kloink))); \
- })
-# define SvAMAGIC_off(sv) ({ SV * const kloink = sv; \
- if(SvROK(kloink) \
- && SvOBJECT(SvRV(kloink))) \
- HvAMAGIC_off(SvSTASH(SvRV(kloink))); \
- })
-#else
-# define SvAMAGIC_on(sv) \
- SvOBJECT(SvRV(sv)) && (SvFLAGS(SvSTASH(SvRV(sv))) |= SVf_AMAGIC)
-# define SvAMAGIC_off(sv) \
- (SvROK(sv) && SvOBJECT(SvRV(sv)) \
- && (SvFLAGS(SvSTASH(SvRV(sv))) &= ~SVf_AMAGIC))
-#endif
/* To be used on the stashes themselves: */
#define HvAMAGIC(hv) (SvFLAGS(hv) & SVf_AMAGIC)
#define SvPOK_byte_nog(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVs_GMG)) == SVf_POK)
#define SvPOK_byte_nogthink(sv) ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST|SVs_GMG)) == SVf_POK)
+#define SvPOK_pure_nogthink(sv) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_IOK|SVf_NOK|SVf_ROK|SVpgv_GP|SVf_THINKFIRST|SVs_GMG)) == SVf_POK)
+#define SvPOK_utf8_pure_nogthink(sv) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_IOK|SVf_NOK|SVf_ROK|SVpgv_GP|SVf_THINKFIRST|SVs_GMG)) == (SVf_POK|SVf_UTF8))
+#define SvPOK_byte_pure_nogthink(sv) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_IOK|SVf_NOK|SVf_ROK|SVpgv_GP|SVf_THINKFIRST|SVs_GMG)) == SVf_POK)
+
/*
=for apidoc Am|U32|SvGAMAGIC|SV* sv
#define SvPCS_IMPORTED_on(sv) (SvFLAGS(sv) |= (SVf_ROK|SVprv_PCS_IMPORTED))
#define SvPCS_IMPORTED_off(sv) (SvFLAGS(sv) &= ~(SVf_ROK|SVprv_PCS_IMPORTED))
+/*
+=for apidoc m|U32|SvTHINKFIRST|SV *sv
+
+A quick flag check to see whether an sv should be passed to sv_force_normal
+to be "downgraded" before SvIVX or SvPVX can be modified directly.
+
+For example, if your scalar is a reference and you want to modify the SvIVX
+slot, you can't just do SvROK_off, as that will leak the referent.
+
+This is used internally by various sv-modifying functions, such as
+sv_setsv, sv_setiv and sv_pvn_force.
+
+One case that this does not handle is a gv without SvFAKE set. After
+
+ if (SvTHINKFIRST(gv)) sv_force_normal(gv);
+
+it will still be a gv.
+
+SvTHINKFIRST sometimes produces false positives. In those cases
+sv_force_normal does nothing.
+
+=cut
+*/
+
#define SvTHINKFIRST(sv) (SvFLAGS(sv) & SVf_THINKFIRST)
#define SvPADMY(sv) (SvFLAGS(sv) & SVs_PADMY)
#define SvPADSTALE(sv) ((SvFLAGS(sv) & (SVs_PADMY|SVs_PADSTALE)) \
== (SVs_PADMY|SVs_PADSTALE))
-#if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-# define SvPADTMP_on(sv) ({ \
- SV *const _svpad = MUTABLE_SV(sv); \
- assert(!(SvFLAGS(_svpad) & SVs_PADMY)); \
- SvFLAGS(_svpad) |= SVs_PADTMP; \
- })
-# define SvPADTMP_off(sv) ({ \
- SV *const _svpad = MUTABLE_SV(sv); \
- assert(!(SvFLAGS(_svpad) & SVs_PADMY)); \
- SvFLAGS(_svpad) &= ~SVs_PADTMP; \
- })
-# define SvPADSTALE_on(sv) ({ \
- SV *const _svpad = MUTABLE_SV(sv); \
- assert(SvFLAGS(_svpad) & SVs_PADMY); \
- SvFLAGS(_svpad) |= SVs_PADSTALE; \
- })
-# define SvPADSTALE_off(sv) ({ \
- SV *const _svpad = MUTABLE_SV(sv); \
- assert(SvFLAGS(_svpad) & SVs_PADMY); \
- SvFLAGS(_svpad) &= ~SVs_PADSTALE; \
- })
-#else
-# define SvPADTMP_on(sv) (SvFLAGS(sv) |= SVs_PADTMP)
-# define SvPADTMP_off(sv) (SvFLAGS(sv) &= ~SVs_PADTMP)
-# define SvPADSTALE_on(sv) (SvFLAGS(sv) |= SVs_PADSTALE)
-# define SvPADSTALE_off(sv) (SvFLAGS(sv) &= ~SVs_PADSTALE)
-#endif
+#define SvPADTMP_on(sv) S_SvPADTMP_on(MUTABLE_SV(sv))
+#define SvPADTMP_off(sv) S_SvPADTMP_off(MUTABLE_SV(sv))
+#define SvPADSTALE_on(sv) S_SvPADSTALE_on(MUTABLE_SV(sv))
+#define SvPADSTALE_off(sv) S_SvPADSTALE_off(MUTABLE_SV(sv))
#define SvTEMP(sv) (SvFLAGS(sv) & SVs_TEMP)
#define SvTEMP_on(sv) (SvFLAGS(sv) |= SVs_TEMP)
# define SvRV_const(sv) (0 + (sv)->sv_u.svu_rv)
/* Don't test the core XS code yet. */
# if defined (PERL_CORE) && PERL_DEBUG_COW > 1
-# define SvPVX(sv) (0 + (assert(!SvREADONLY(sv)), (sv)->sv_u.svu_pv))
+# define SvPVX(sv) (0 + (assert_(!SvREADONLY(sv)) (sv)->sv_u.svu_pv))
# else
# define SvPVX(sv) SvPVX_mutable(sv)
# endif
# define SvLEN(sv) (0 + ((XPV*) SvANY(sv))->xpv_len)
# define SvEND(sv) ((sv)->sv_u.svu_pv + ((XPV*)SvANY(sv))->xpv_cur)
-# ifdef DEBUGGING
-# define SvMAGIC(sv) (0 + *(assert(SvTYPE(sv) >= SVt_PVMG), &((XPVMG*) SvANY(sv))->xmg_u.xmg_magic))
-# define SvSTASH(sv) (0 + *(assert(SvTYPE(sv) >= SVt_PVMG), &((XPVMG*) SvANY(sv))->xmg_stash))
-# else
-# define SvMAGIC(sv) (0 + ((XPVMG*) SvANY(sv))->xmg_u.xmg_magic)
-# define SvSTASH(sv) (0 + ((XPVMG*) SvANY(sv))->xmg_stash)
-# endif
+# define SvMAGIC(sv) (0 + *(assert_(SvTYPE(sv) >= SVt_PVMG) &((XPVMG*) SvANY(sv))->xmg_u.xmg_magic))
+# define SvSTASH(sv) (0 + *(assert_(SvTYPE(sv) >= SVt_PVMG) &((XPVMG*) SvANY(sv))->xmg_stash))
#else
# define SvLEN(sv) ((XPV*) SvANY(sv))->xpv_len
# define SvEND(sv) ((sv)->sv_u.svu_pv + ((XPV*)SvANY(sv))->xpv_cur)
#define SvIV_please_nomg(sv) \
(!SvIOKp(sv) && (SvNOK(sv) || SvPOK(sv)) \
? (SvIV_nomg(sv), SvIOK(sv)) \
- : SvGMAGICAL(sv) \
- ? SvIOKp(sv) || ( \
- (SvNOKp(sv) || SvPOKp(sv)) \
- && sv_gmagical_2iv_please(sv) \
- ) \
- : SvIOK(sv))
+ : SvIOK(sv))
#define SvIV_set(sv, val) \
STMT_START { \
assert(PL_valid_types_IV_set[SvTYPE(sv) & SVt_MASK]); \
#endif
-#define FmLINES(sv) ((XPVFM*) SvANY(sv))->xfm_lines
+#define FmLINES(sv) ((XPVIV*) SvANY(sv))->xiv_iv
#define LvTYPE(sv) ((XPVLV*) SvANY(sv))->xlv_type
#define LvTARG(sv) ((XPVLV*) SvANY(sv))->xlv_targ
/*
=for apidoc Am|char*|SvPV_force|SV* sv|STRLEN len
-Like C<SvPV> but will force the SV into containing just a string
-(C<SvPOK_only>). You want force if you are going to update the C<SvPVX>
-directly.
+Like C<SvPV> but will force the SV into containing a string (C<SvPOK>), and
+only a string (C<SvPOK_only>), by hook or by crook. You want force if you are
+going to update the C<SvPVX> directly. Processes get magic.
=for apidoc Am|char*|SvPV_force_nomg|SV* sv|STRLEN len
-Like C<SvPV> but will force the SV into containing just a string
-(C<SvPOK_only>). You want force if you are going to update the C<SvPVX>
-directly. Doesn't process magic.
+Like C<SvPV> but will force the SV into containing a string (C<SvPOK>), and
+only a string (C<SvPOK_only>), by hook or by crook. You want force if you are
+going to update the C<SvPVX> directly. Doesn't process get magic.
=for apidoc Am|char*|SvPV|SV* sv|STRLEN len
Returns a pointer to the string in the SV, or a stringified form of
#define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
#define SvPV_force_flags(sv, lp, flags) \
- (SvPOK_nogthink(sv) \
+ (SvPOK_pure_nogthink(sv) \
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
#define SvPV_force_flags_nolen(sv, flags) \
- (SvPOK_nogthink(sv) \
+ (SvPOK_pure_nogthink(sv) \
? SvPVX(sv) : sv_pvn_force_flags(sv, 0, flags))
#define SvPV_force_flags_mutable(sv, lp, flags) \
- (SvPOK_nogthink(sv) \
+ (SvPOK_pure_nogthink(sv) \
? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
: sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8(sv, &lp))
#define SvPVutf8_force(sv, lp) \
- (SvPOK_utf8_nogthink(sv) \
+ (SvPOK_utf8_pure_nogthink(sv) \
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvutf8n_force(sv, &lp))
#define SvPVutf8_nolen(sv) \
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
#define SvPVbyte_force(sv, lp) \
- (SvPOK_byte_nogthink(sv) \
+ (SvPOK_byte_pure_nogthink(sv) \
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvbyten_force(sv, &lp))
#define SvPVbyte_nolen(sv) \
#define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
/*
+=for apidoc Amx|SV*|newSVpadname|PADNAME *pn
+
+Creates a new SV containing the pad name. This is currently identical
+to C<newSVsv>, but pad names may cease being SVs at some point, so
+C<newSVpadname> is preferable.
+
+=cut
+*/
+
+#define newSVpadname(pn) newSVsv(pn)
+
+/*
=for apidoc Am|void|SvOOK_offset|NN SV*sv|STRLEN len
Reads into I<len> the offset from SvPVX back to the true start of the
# define SvOOK_offset(sv, offset) STMT_START { \
assert(sizeof(offset) == sizeof(STRLEN)); \
if (SvOOK(sv)) { \
- const U8 *crash = (U8*)SvPVX_const(sv); \
- offset = *--crash; \
- if (!offset) { \
- crash -= sizeof(STRLEN); \
- Copy(crash, (U8 *)&offset, sizeof(STRLEN), U8); \
+ const U8 *_crash = (U8*)SvPVX_const(sv); \
+ (offset) = *--_crash; \
+ if (!(offset)) { \
+ _crash -= sizeof(STRLEN); \
+ Copy(_crash, (U8 *)&(offset), sizeof(STRLEN), U8); \
} \
{ \
/* Validate the preceding buffer's sentinels to \
verify that no-one is using it. */ \
- const U8 *const bonk = (U8 *) SvPVX_const(sv) - offset; \
- while (crash > bonk) { \
- --crash; \
- assert (*crash == (U8)PTR2UV(crash)); \
+ const U8 *const _bonk = (U8*)SvPVX_const(sv) - (offset);\
+ while (_crash > _bonk) { \
+ --_crash; \
+ assert (*_crash == (U8)PTR2UV(_crash)); \
} \
} \
} else { \
- offset = 0; \
+ (offset) = 0; \
} \
} STMT_END
#else
# define SvOOK_offset(sv, offset) STMT_START { \
assert(sizeof(offset) == sizeof(STRLEN)); \
if (SvOOK(sv)) { \
- offset = ((U8*)SvPVX_const(sv))[-1]; \
- if (!offset) { \
+ (offset) = ((U8*)SvPVX_const(sv))[-1]; \
+ if (!(offset)) { \
Copy(SvPVX_const(sv) - 1 - sizeof(STRLEN), \
- (U8 *)&offset, sizeof(STRLEN), U8); \
+ (U8*)&(offset), sizeof(STRLEN), U8); \
} \
} else { \
- offset = 0; \
+ (offset) = 0; \
} \
} STMT_END
#endif
https://perl5.git.perl.org / perl5.git / blobdiff