/* sv.h
*
- * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- * 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, by Larry Wall and others
+ * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+ * 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall and others
*
* You may distribute under the terms of either the GNU General Public
* License or the Artistic License, as specified in the README file.
SVt_BIND, /* 1 */
SVt_IV, /* 2 */
SVt_NV, /* 3 */
- SVt_RV, /* 4 */
- SVt_PV, /* 5 */
- SVt_PVIV, /* 6 */
- SVt_PVNV, /* 7 */
- SVt_PVMG, /* 8 */
+ /* RV was here, before it was merged with IV. */
+ SVt_PV, /* 4 */
+ SVt_PVIV, /* 5 */
+ SVt_PVNV, /* 6 */
+ SVt_PVMG, /* 7 */
+ SVt_REGEXP, /* 8 */
/* PVBM was here, before BIND replaced it. */
SVt_PVGV, /* 9 */
SVt_PVLV, /* 10 */
purposes eternal code wanting to consider PVBM probably needs to think of
PVMG instead. */
# define SVt_PVBM SVt_PVMG
+/* Anything wanting to create a reference from clean should ensure that it has
+ a scalar of type SVt_IV now: */
+# define SVt_RV SVt_IV
#endif
/* There is collusion here with sv_clear - sv_clear exits early for SVt_NULL
- and SVt_IV, so never reaches the clause at the end that uses
- sv_type_details->body_size to determine whether to call safefree(). Hence
- body_size can be set no-zero to record the size of PTEs and HEs, without
- fear of bogus frees. */
-#ifdef PERL_IN_SV_C
-#define PTE_SVSLOT SVt_IV
-#endif
+ so never reaches the clause at the end that uses sv_type_details->body_size
+ to determine whether to call safefree(). Hence body_size can be set
+ non-zero to record the size of HEs, without fear of bogus frees. */
#if defined(PERL_IN_HV_C) || defined(PERL_IN_XS_APITEST)
#define HE_SVSLOT SVt_NULL
#endif
#define _SV_HEAD_UNION \
union { \
+ char* svu_pv; /* pointer to malloced string */ \
IV svu_iv; \
UV svu_uv; \
SV* svu_rv; /* pointer to another SV */ \
- char* svu_pv; /* pointer to malloced string */ \
SV** svu_array; \
HE** svu_hash; \
GP* svu_gp; \
+ PerlIO *svu_fp; \
} sv_u
_SV_HEAD(void*);
_SV_HEAD_UNION;
#ifdef DEBUG_LEAKING_SCALARS
- unsigned sv_debug_optype:9; /* the type of OP that allocated us */
- unsigned sv_debug_inpad:1; /* was allocated in a pad for an OP */
- unsigned sv_debug_cloned:1; /* was cloned for an ithread */
- unsigned sv_debug_line:16; /* the line where we were allocated */
- char * sv_debug_file; /* the file where we were allocated */
+ PERL_BITFIELD32 sv_debug_optype:9; /* the type of OP that allocated us */
+ PERL_BITFIELD32 sv_debug_inpad:1; /* was allocated in a pad for an OP */
+ PERL_BITFIELD32 sv_debug_line:16; /* the line where we were allocated */
+ UV sv_debug_serial; /* serial number of sv allocation */
+ char * sv_debug_file; /* the file where we were allocated */
+ SV * sv_debug_parent; /* what we were cloned from (ithreads)*/
#endif
};
_SV_HEAD_UNION;
};
+struct p5rx {
+ _SV_HEAD(struct regexp*); /* pointer to regexp body */
+ _SV_HEAD_UNION;
+};
+
#undef _SV_HEAD
#undef _SV_HEAD_UNION /* ensure no pollution */
#define SvFLAGS(sv) (sv)->sv_flags
#define SvREFCNT(sv) (sv)->sv_refcnt
-#if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC)
+#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
# define SvREFCNT_inc(sv) \
({ \
- SV * const _sv = (SV*)(sv); \
+ SV * const _sv = MUTABLE_SV(sv); \
if (_sv) \
(SvREFCNT(_sv))++; \
_sv; \
({ \
if (sv) \
(SvREFCNT(sv))++; \
- (SV *)(sv); \
+ MUTABLE_SV(sv); \
})
# define SvREFCNT_inc_NN(sv) \
({ \
- SV * const _sv = (SV*)(sv); \
+ SV * const _sv = MUTABLE_SV(sv); \
SvREFCNT(_sv)++; \
_sv; \
})
# define SvREFCNT_inc_void(sv) \
({ \
- SV * const _sv = (SV*)(sv); \
+ SV * const _sv = MUTABLE_SV(sv); \
if (_sv) \
(void)(SvREFCNT(_sv)++); \
})
#else
# define SvREFCNT_inc(sv) \
- ((PL_Sv=(SV*)(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
+ ((PL_Sv=MUTABLE_SV(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
# define SvREFCNT_inc_simple(sv) \
- ((sv) ? (SvREFCNT(sv)++,(SV*)(sv)) : NULL)
+ ((sv) ? (SvREFCNT(sv)++,MUTABLE_SV(sv)) : NULL)
# define SvREFCNT_inc_NN(sv) \
- (PL_Sv=(SV*)(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
+ (PL_Sv=MUTABLE_SV(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
# define SvREFCNT_inc_void(sv) \
- (void)((PL_Sv=(SV*)(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
+ (void)((PL_Sv=MUTABLE_SV(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
#endif
/* 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_simple_NN(sv) (++(SvREFCNT(sv)),(SV*)(sv))
-#define SvREFCNT_inc_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
-#define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT((SV*)(sv)))
+#define SvREFCNT_inc_simple_NN(sv) (++(SvREFCNT(sv)),MUTABLE_SV(sv))
+#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(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC)
+#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
# define SvREFCNT_dec(sv) \
({ \
- SV * const _sv = (SV*)(sv); \
+ SV * const _sv = MUTABLE_SV(sv); \
if (_sv) { \
if (SvREFCNT(_sv)) { \
if (--(SvREFCNT(_sv)) == 0) \
} \
})
#else
-#define SvREFCNT_dec(sv) sv_free((SV*)(sv))
+#define SvREFCNT_dec(sv) sv_free(MUTABLE_SV(sv))
#endif
#define SVTYPEMASK 0xff
3: For PVCV, whether CvUNIQUE(cv)
refers to an eval or once only
[CvEVAL(cv), CvSPECIAL(cv)]
- 4: Whether the regexp pointer is in
- fact an offset [SvREPADTMP(sv)]
- 5: On a pad name SV, that slot in the
+ 4: On a pad name SV, that slot in the
frame AV is a REFCNT'ed reference
to a lexical from "outside". */
-#define SVphv_REHASH SVf_FAKE /* 6: On a PVHV, hash values are being
+#define SVphv_REHASH SVf_FAKE /* 5: On a PVHV, hash values are being
recalculated */
#define SVf_OOK 0x02000000 /* has valid offset value. For a PVHV this
means that a hv_aux struct is present
after the main array */
#define SVf_BREAK 0x04000000 /* refcnt is artificially low - used by
- SV's in final arena cleanup */
+ SVs in final arena cleanup.
+ Set in S_regtry on PL_reg_curpm, so that
+ perl_destruct will skip it. */
#define SVf_READONLY 0x08000000 /* may not be modified */
/* PVHV */
#define SVphv_SHAREKEYS 0x20000000 /* PVHV keys live on shared string table */
-/* PVNV, PVMG, presumably only inside pads */
-#define SVpad_NAME 0x40000000 /* This SV is a name in the PAD, so
+
+/* PVNV, PVMG only, and only used in pads. Should be safe to test on any scalar
+ SV, as the core is careful to avoid setting both.
+
+ SVf_POK, SVp_POK also set:
+ 0x00004400 Normal
+ 0x0000C400 Studied (SvSCREAM)
+ 0x40004400 FBM compiled (SvVALID)
+ 0x4000C400 pad name.
+
+ 0x00008000 GV with GP
+ 0x00008800 RV with PCS imported
+*/
+#define SVpad_NAME (SVp_SCREAM|SVpbm_VALID)
+ /* This SV is a name in the PAD, so
SVpad_TYPED, SVpad_OUR and SVpad_STATE
apply */
/* PVAV */
/* This is only set true on a PVGV when it's playing "PVBM", but is tested for
on any regular scalar (anything <= PVLV) */
#define SVpbm_VALID 0x40000000
-/* ??? */
+/* Only used in toke.c on an SV stored in PL_lex_repl */
#define SVrepl_EVAL 0x40000000 /* Replacement part of s///e */
/* IV, PVIV, PVNV, PVMG, PVGV and (I assume) PVLV */
-/* Presumably IVs aren't stored in pads */
#define SVf_IVisUV 0x80000000 /* use XPVUV instead of XPVIV */
/* PVAV */
#define SVpav_REIFY 0x80000000 /* can become real */
/* PVHV */
#define SVphv_HASKFLAGS 0x80000000 /* keys have flag byte after hash */
-/* PVFM */
-#define SVpfm_COMPILED 0x80000000 /* FORMLINE is compiled */
/* PVGV when SVpbm_VALID is true */
#define SVpbm_TAIL 0x80000000
/* RV upwards. However, SVf_ROK and SVp_IOK are exclusive */
#define SVprv_WEAKREF 0x80000000 /* Weak reference */
+#define _XPV_HEAD \
+ HV* xmg_stash; /* class package */ \
+ union _xmgu xmg_u; \
+ STRLEN xpv_cur; /* length of svu_pv as a C string */ \
+ STRLEN xpv_len /* allocated size */
+
+union _xnvu {
+ NV xnv_nv; /* numeric value, if any */
+ HV * xgv_stash;
+ struct {
+ U32 xlow;
+ U32 xhigh;
+ } xpad_cop_seq; /* used by pad.c for cop_sequence */
+ struct {
+ U32 xbm_previous; /* how many characters in string before rare? */
+ U8 xbm_flags;
+ U8 xbm_rare; /* rarest character in string */
+ } xbm_s; /* fields from PVBM */
+};
-struct xpv {
- union {
- NV xnv_nv; /* numeric value, if any */
- HV * xgv_stash;
- struct {
- U32 xlow;
- U32 xhigh;
- } xpad_cop_seq; /* used by pad.c for cop_sequence */
- struct {
- U32 xbm_previous; /* how many characters in string before rare? */
- U8 xbm_flags;
- U8 xbm_rare; /* rarest character in string */
- } xbm_s; /* fields from PVBM */
- } xnv_u;
- STRLEN xpv_cur; /* length of svu_pv as a C string */
- STRLEN xpv_len; /* allocated size */
+union _xivu {
+ IV xivu_iv; /* integer value */
+ UV xivu_uv;
+ I32 xivu_i32; /* BmUSEFUL */
+ HEK * xivu_namehek; /* xpvlv, xpvgv: GvNAME */
+};
+
+union _xmgu {
+ MAGIC* xmg_magic; /* linked list of magicalness */
+ HV* xmg_ourstash; /* Stash for our (when SvPAD_OUR is true) */
};
-typedef struct {
- STRLEN xpv_cur; /* length of svu_pv as a C string */
- STRLEN xpv_len; /* allocated size */
-} xpv_allocated;
+struct xpv {
+ _XPV_HEAD;
+};
struct xpviv {
- union {
- NV xnv_nv; /* numeric value, if any */
- HV * xgv_stash;
- struct {
- U32 xlow;
- U32 xhigh;
- } xpad_cop_seq; /* used by pad.c for cop_sequence */
- struct {
- U32 xbm_previous; /* how many characters in string before rare? */
- U8 xbm_flags;
- U8 xbm_rare; /* rarest character in string */
- } xbm_s; /* fields from PVBM */
- } xnv_u;
- STRLEN xpv_cur; /* length of svu_pv as a C string */
- STRLEN xpv_len; /* allocated size */
- union {
- IV xivu_iv; /* integer value or pv offset */
- UV xivu_uv;
- void * xivu_p1;
- I32 xivu_i32;
- HEK * xivu_namehek;
- } xiv_u;
+ _XPV_HEAD;
+ union _xivu xiv_u;
};
-typedef struct {
- STRLEN xpv_cur; /* length of svu_pv as a C string */
- STRLEN xpv_len; /* allocated size */
- union {
- IV xivu_iv; /* integer value or pv offset */
- UV xivu_uv;
- void * xivu_p1;
- I32 xivu_i32;
- HEK * xivu_namehek;
- } xiv_u;
-} xpviv_allocated;
-
#define xiv_iv xiv_u.xivu_iv
struct xpvuv {
- union {
- NV xnv_nv; /* numeric value, if any */
- HV * xgv_stash;
- struct {
- U32 xlow;
- U32 xhigh;
- } xpad_cop_seq; /* used by pad.c for cop_sequence */
- struct {
- U32 xbm_previous; /* how many characters in string before rare? */
- U8 xbm_flags;
- U8 xbm_rare; /* rarest character in string */
- } xbm_s; /* fields from PVBM */
- } xnv_u;
- STRLEN xpv_cur; /* length of svu_pv as a C string */
- STRLEN xpv_len; /* allocated size */
- union {
- IV xuvu_iv;
- UV xuvu_uv; /* unsigned value or pv offset */
- void * xuvu_p1;
- HEK * xivu_namehek;
- } xuv_u;
+ _XPV_HEAD;
+ union _xivu xuv_u;
};
-#define xuv_uv xuv_u.xuvu_uv
+#define xuv_uv xuv_u.xivu_uv
struct xpvnv {
- union {
- NV xnv_nv; /* numeric value, if any */
- HV * xgv_stash;
- struct {
- U32 xlow;
- U32 xhigh;
- } xpad_cop_seq; /* used by pad.c for cop_sequence */
- struct {
- U32 xbm_previous; /* how many characters in string before rare? */
- U8 xbm_flags;
- U8 xbm_rare; /* rarest character in string */
- } xbm_s; /* fields from PVBM */
- } xnv_u;
- STRLEN xpv_cur; /* length of svu_pv as a C string */
- STRLEN xpv_len; /* allocated size */
- union {
- IV xivu_iv; /* integer value or pv offset */
- UV xivu_uv;
- void * xivu_p1;
- I32 xivu_i32;
- HEK * xivu_namehek;
- } xiv_u;
+ _XPV_HEAD;
+ union _xivu xiv_u;
+ union _xnvu xnv_u;
};
-/* These structure must match the beginning of struct xpvhv in hv.h. */
+/* This structure must match the beginning of struct xpvhv in hv.h. */
struct xpvmg {
- union {
- NV xnv_nv; /* numeric value, if any */
- HV * xgv_stash;
- struct {
- U32 xlow;
- U32 xhigh;
- } xpad_cop_seq; /* used by pad.c for cop_sequence */
- struct {
- U32 xbm_previous; /* how many characters in string before rare? */
- U8 xbm_flags;
- U8 xbm_rare; /* rarest character in string */
- } xbm_s; /* fields from PVBM */
- } xnv_u;
- STRLEN xpv_cur; /* length of svu_pv as a C string */
- STRLEN xpv_len; /* allocated size */
- union {
- IV xivu_iv; /* integer value or pv offset */
- UV xivu_uv;
- void * xivu_p1;
- I32 xivu_i32;
- HEK * xivu_namehek;
- } xiv_u;
- union {
- MAGIC* xmg_magic; /* linked list of magicalness */
- HV* xmg_ourstash; /* Stash for our (when SvPAD_OUR is true) */
- } xmg_u;
- HV* xmg_stash; /* class package */
+ _XPV_HEAD;
+ union _xivu xiv_u;
+ union _xnvu xnv_u;
};
struct xpvlv {
- union {
- NV xnv_nv; /* numeric value, if any */
- HV * xgv_stash;
- struct {
- U32 xlow;
- U32 xhigh;
- } xpad_cop_seq; /* used by pad.c for cop_sequence */
- struct {
- U32 xbm_previous; /* how many characters in string before rare? */
- U8 xbm_flags;
- U8 xbm_rare; /* rarest character in string */
- } xbm_s; /* fields from PVBM */
- } xnv_u;
- STRLEN xpv_cur; /* length of svu_pv as a C string */
- STRLEN xpv_len; /* allocated size */
- union {
- IV xivu_iv; /* integer value or pv offset */
- UV xivu_uv;
- void * xivu_p1;
- I32 xivu_i32;
- HEK * xivu_namehek; /* GvNAME */
- } xiv_u;
- union {
- MAGIC* xmg_magic; /* linked list of magicalness */
- HV* xmg_ourstash; /* Stash for our (when SvPAD_OUR is true) */
- } xmg_u;
- HV* xmg_stash; /* class package */
-
+ _XPV_HEAD;
+ union _xivu xiv_u;
+ union _xnvu xnv_u;
STRLEN xlv_targoff;
STRLEN xlv_targlen;
SV* xlv_targ;
/* This structure works in 3 ways - regular scalar, GV with GP, or fast
Boyer-Moore. */
struct xpvgv {
- union {
- NV xnv_nv;
- HV * xgv_stash; /* The stash of this GV */
- struct {
- U32 xlow;
- U32 xhigh;
- } xpad_cop_seq; /* used by pad.c for cop_sequence */
- struct {
- U32 xbm_previous; /* how many characters in string before rare? */
- U8 xbm_flags;
- U8 xbm_rare; /* rarest character in string */
- } xbm_s; /* fields from PVBM */
- } xnv_u;
- STRLEN xpv_cur; /* xgv_flags */
- STRLEN xpv_len; /* 0 */
- union {
- IV xivu_iv;
- UV xivu_uv;
- void * xivu_p1;
- I32 xivu_i32; /* is this constant pattern being useful? */
- HEK * xivu_namehek; /* GvNAME */
- } xiv_u;
- union {
- MAGIC* xmg_magic; /* linked list of magicalness */
- HV* xmg_ourstash; /* Stash for our (when SvPAD_OUR is true) */
- } xmg_u;
- HV* xmg_stash; /* class package */
-
+ _XPV_HEAD;
+ union _xivu xiv_u;
+ union _xnvu xnv_u;
};
/* This structure must match XPVCV in cv.h */
typedef U16 cv_flags_t;
-struct xpvfm {
- union {
- NV xnv_nv; /* numeric value, if any */
- HV * xgv_stash;
- struct {
- U32 xlow;
- U32 xhigh;
- } xpad_cop_seq; /* used by pad.c for cop_sequence */
- struct {
- U32 xbm_previous; /* how many characters in string before rare? */
- U8 xbm_flags;
- U8 xbm_rare; /* rarest character in string */
- } xbm_s; /* fields from PVBM */
- } xnv_u;
- STRLEN xpv_cur; /* length of svu_pv as a C string */
- STRLEN xpv_len; /* allocated size */
- union {
- IV xivu_iv; /* PVFMs use the pv offset */
- UV xivu_uv;
- void * xivu_p1;
- I32 xivu_i32;
- HEK * xivu_namehek;
- } xiv_u;
- union {
- MAGIC* xmg_magic; /* linked list of magicalness */
- HV* xmg_ourstash; /* Stash for our (when SvPAD_OUR is true) */
- } xmg_u;
- HV* xmg_stash; /* class package */
+#define _XPVCV_COMMON \
+ HV * xcv_stash; \
+ union { \
+ OP * xcv_start; \
+ ANY xcv_xsubany; \
+ } xcv_start_u; \
+ union { \
+ OP * xcv_root; \
+ void (*xcv_xsub) (pTHX_ CV*); \
+ } xcv_root_u; \
+ GV * xcv_gv; \
+ char * xcv_file; \
+ AV * xcv_padlist; \
+ CV * xcv_outside; \
+ U32 xcv_outside_seq; /* the COP sequence (at the point of our \
+ * compilation) in the lexically enclosing \
+ * sub */ \
+ cv_flags_t xcv_flags
- HV * xcv_stash;
- union {
- OP * xcv_start;
- ANY xcv_xsubany;
- } xcv_start_u;
- union {
- OP * xcv_root;
- void (*xcv_xsub) (pTHX_ CV*);
- } xcv_root_u;
- GV * xcv_gv;
- char * xcv_file;
- AV * xcv_padlist;
- CV * xcv_outside;
- U32 xcv_outside_seq; /* the COP sequence (at the point of our
- * compilation) in the lexically enclosing
- * sub */
- cv_flags_t xcv_flags;
+struct xpvfm {
+ _XPV_HEAD;
+ _XPVCV_COMMON;
IV xfm_lines;
};
-typedef struct {
- STRLEN xpv_cur; /* length of svu_pv as a C string */
- STRLEN xpv_len; /* allocated size */
- union {
- IV xivu_iv; /* PVFMs use the pv offset */
- UV xivu_uv;
- void * xivu_p1;
- I32 xivu_i32;
- HEK * xivu_namehek;
- } xiv_u;
- union {
- MAGIC* xmg_magic; /* linked list of magicalness */
- HV* xmg_ourstash; /* Stash for our (when SvPAD_OUR is true) */
- } xmg_u;
- HV* xmg_stash; /* class package */
-
- HV * xcv_stash;
- union {
- OP * xcv_start;
- ANY xcv_xsubany;
- } xcv_start_u;
- union {
- OP * xcv_root;
- void (*xcv_xsub) (pTHX_ CV*);
- } xcv_root_u;
- GV * xcv_gv;
- char * xcv_file;
- AV * xcv_padlist;
- CV * xcv_outside;
- U32 xcv_outside_seq; /* the COP sequence (at the point of our
- * compilation) in the lexically enclosing
- * sub */
- cv_flags_t xcv_flags;
- IV xfm_lines;
-} xpvfm_allocated;
struct xpvio {
- union {
- NV xnv_nv; /* numeric value, if any */
- HV * xgv_stash;
- struct {
- U32 xlow;
- U32 xhigh;
- } xpad_cop_seq; /* used by pad.c for cop_sequence */
- struct {
- U32 xbm_previous; /* how many characters in string before rare? */
- U8 xbm_flags;
- U8 xbm_rare; /* rarest character in string */
- } xbm_s; /* fields from PVBM */
- } xnv_u;
- STRLEN xpv_cur; /* length of svu_pv as a C string */
- STRLEN xpv_len; /* allocated size */
- union {
- IV xivu_iv; /* integer value or pv offset */
- UV xivu_uv;
- void * xivu_p1;
- I32 xivu_i32;
- HEK * xivu_namehek;
- } xiv_u;
- union {
- MAGIC* xmg_magic; /* linked list of magicalness */
- HV* xmg_ourstash; /* Stash for our (when SvPAD_OUR is true) */
- } xmg_u;
- HV* xmg_stash; /* class package */
-
- PerlIO * xio_ifp; /* ifp and ofp are normally the same */
- PerlIO * xio_ofp; /* but sockets need separate streams */
+ _XPV_HEAD;
+ union _xivu xiv_u;
+ /* ifp and ofp are normally the same, but sockets need separate streams */
+ PerlIO * xio_ofp;
/* Cray addresses everything by word boundaries (64 bits) and
* code and data pointers cannot be mixed (which is exactly what
- * Perl_filter_add() tries to do with the dirp), hence the following
- * union trick (as suggested by Gurusamy Sarathy).
- * For further information see Geir Johansen's problem report titled
- [ID 20000612.002] Perl problem on Cray system
+ * Perl_filter_add() tries to do with the dirp), hence the
+ * following union trick (as suggested by Gurusamy Sarathy).
+ * For further information see Geir Johansen's problem report
+ * titled [ID 20000612.002] Perl problem on Cray system
* The any pointer (known as IoANY()) will also be a good place
* to hang any IO disciplines to.
*/
DIR * xiou_dirp; /* for opendir, readdir, etc */
void * xiou_any; /* for alignment */
} xio_dirpu;
- IV xio_lines; /* $. */
+ /* IV xio_lines is now in IVX $. */
IV xio_page; /* $% */
IV xio_page_len; /* $= */
IV xio_lines_left; /* $- */
char xio_type;
U8 xio_flags;
};
+
#define xio_dirp xio_dirpu.xiou_dirp
#define xio_any xio_dirpu.xiou_any
#define IOf_DIDTOP 8 /* just did top of form */
#define IOf_UNTAINT 16 /* consider this fp (and its data) "safe" */
#define IOf_NOLINE 32 /* slurped a pseudo-line from empty file */
-#define IOf_FAKE_DIRP 64 /* xio_dirp is fake (source filters kludge) */
+#define IOf_FAKE_DIRP 64 /* xio_dirp is fake (source filters kludge)
+ Also, when this is set, SvPVX() is valid */
/* The following macros define implementation-independent predicates on SVs. */
=for apidoc Am|U32|SvNIOKp|SV* sv
Returns a U32 value indicating whether the SV contains a number, integer or
-double. Checks the B<private> setting. Use C<SvNIOK>.
+double. Checks the B<private> setting. Use C<SvNIOK> instead.
=for apidoc Am|void|SvNIOK_off|SV* sv
Unsets the NV/IV status of an SV.
=for apidoc Am|U32|SvOK|SV* sv
-Returns a U32 value indicating whether the value is an SV. It also tells
-whether the value is defined or not.
+Returns a U32 value indicating whether the value is defined. This is
+only meaningful for scalars.
=for apidoc Am|U32|SvIOKp|SV* sv
Returns a U32 value indicating whether the SV contains an integer. Checks
-the B<private> setting. Use C<SvIOK>.
+the B<private> setting. Use C<SvIOK> instead.
=for apidoc Am|U32|SvNOKp|SV* sv
Returns a U32 value indicating whether the SV contains a double. Checks the
-B<private> setting. Use C<SvNOK>.
+B<private> setting. Use C<SvNOK> instead.
=for apidoc Am|U32|SvPOKp|SV* sv
Returns a U32 value indicating whether the SV contains a character string.
-Checks the B<private> setting. Use C<SvPOK>.
+Checks the B<private> setting. Use C<SvPOK> instead.
=for apidoc Am|U32|SvIOK|SV* sv
Returns a U32 value indicating whether the SV contains an integer.
Returns a boolean indicating whether the SV contains a v-string.
=for apidoc Am|U32|SvOOK|SV* sv
-Returns a U32 indicating whether the SvIVX is a valid offset value for
-the SvPVX. This hack is used internally to speed up removal of characters
-from the beginning of a SvPV. When SvOOK is true, then the start of the
-allocated string buffer is really (SvPVX - SvIVX).
+Returns a U32 indicating whether the pointer to the string buffer is offset.
+This hack is used internally to speed up removal of characters from the
+beginning of a SvPV. When SvOOK is true, then the start of the
+allocated string buffer is actually C<SvOOK_offset()> bytes before SvPVX.
+This offset used to be stored in SvIVX, but is now stored within the spare
+part of the buffer.
=for apidoc Am|U32|SvROK|SV* sv
Tests if the SV is an RV.
#define SvOKp(sv) (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK))
#define SvIOKp(sv) (SvFLAGS(sv) & SVp_IOK)
-#define SvIOKp_on(sv) (assert_not_glob(sv) SvRELEASE_IVX(sv), \
+#define SvIOKp_on(sv) (assert_not_glob(sv) SvRELEASE_IVX_(sv) \
SvFLAGS(sv) |= SVp_IOK)
#define SvNOKp(sv) (SvFLAGS(sv) & SVp_NOK)
#define SvNOKp_on(sv) (assert_not_glob(sv) SvFLAGS(sv) |= SVp_NOK)
SvFLAGS(sv) |= SVp_POK)
#define SvIOK(sv) (SvFLAGS(sv) & SVf_IOK)
-#define SvIOK_on(sv) (assert_not_glob(sv) SvRELEASE_IVX(sv), \
+#define SvIOK_on(sv) (assert_not_glob(sv) SvRELEASE_IVX_(sv) \
SvFLAGS(sv) |= (SVf_IOK|SVp_IOK))
#define SvIOK_off(sv) (SvFLAGS(sv) &= ~(SVf_IOK|SVp_IOK|SVf_IVisUV))
#define SvIOK_only(sv) (SvOK_off(sv), \
#endif
/*
-=for apidoc Am|char*|SvGAMAGIC|SV* sv
+=for apidoc Am|U32|SvGAMAGIC|SV* sv
Returns true if the SV has get magic or overloading. If either is true then
the scalar is active data, and has the potential to return a new value every
#define SvGAMAGIC(sv) (SvGMAGICAL(sv) || SvAMAGIC(sv))
-#define Gv_AMG(stash) (PL_amagic_generation && Gv_AMupdate(stash))
+#define Gv_AMG(stash) (PL_amagic_generation && Gv_AMupdate(stash, FALSE))
#define SvWEAKREF(sv) ((SvFLAGS(sv) & (SVf_ROK|SVprv_WEAKREF)) \
== (SVf_ROK|SVprv_WEAKREF))
#define SvSCREAM_on(sv) (SvFLAGS(sv) |= SVp_SCREAM)
#define SvSCREAM_off(sv) (SvFLAGS(sv) &= ~SVp_SCREAM)
-#define SvCOMPILED(sv) (SvFLAGS(sv) & SVpfm_COMPILED)
-#define SvCOMPILED_on(sv) (SvFLAGS(sv) |= SVpfm_COMPILED)
-#define SvCOMPILED_off(sv) (SvFLAGS(sv) &= ~SVpfm_COMPILED)
+#ifndef PERL_CORE
+# define SvCOMPILED(sv) 0
+# define SvCOMPILED_on(sv)
+# define SvCOMPILED_off(sv)
+#endif
#define SvEVALED(sv) (SvFLAGS(sv) & SVrepl_EVAL)
#define SvEVALED_on(sv) (SvFLAGS(sv) |= SVrepl_EVAL)
#define SvEVALED_off(sv) (SvFLAGS(sv) &= ~SVrepl_EVAL)
#if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-# define SvVALID(sv) ({ SV *const thwacke = (SV *) (sv); \
- if (SvFLAGS(thwacke) & SVpbm_VALID) \
- assert(!isGV_with_GP(thwacke)); \
- (SvFLAGS(thwacke) & SVpbm_VALID); \
+# define SvVALID(sv) ({ const SV *const _svvalid = (const SV*)(sv); \
+ if (SvFLAGS(_svvalid) & SVpbm_VALID) \
+ assert(!isGV_with_GP(_svvalid)); \
+ (SvFLAGS(_svvalid) & SVpbm_VALID); \
})
-# define SvVALID_on(sv) ({ SV *const thwacke = (SV *) (sv); \
- assert(!isGV_with_GP(thwacke)); \
- (SvFLAGS(thwacke) |= SVpbm_VALID); \
+# define SvVALID_on(sv) ({ SV *const _svvalid = MUTABLE_SV(sv); \
+ assert(!isGV_with_GP(_svvalid)); \
+ (SvFLAGS(_svvalid) |= SVpbm_VALID); \
})
-# define SvVALID_off(sv) ({ SV *const thwacke = (SV *) (sv); \
- assert(!isGV_with_GP(thwacke)); \
- (SvFLAGS(thwacke) &= ~SVpbm_VALID); \
+# define SvVALID_off(sv) ({ SV *const _svvalid = MUTABLE_SV(sv); \
+ assert(!isGV_with_GP(_svvalid)); \
+ (SvFLAGS(_svvalid) &= ~SVpbm_VALID); \
})
-# define SvTAIL(sv) ({ SV *const _svi = (SV *) (sv); \
- assert(SvTYPE(_svi) != SVt_PVAV); \
- assert(SvTYPE(_svi) != SVt_PVHV); \
+# define SvTAIL(sv) ({ const SV *const _svtail = (const SV *)(sv); \
+ assert(SvTYPE(_svtail) != SVt_PVAV); \
+ assert(SvTYPE(_svtail) != SVt_PVHV); \
(SvFLAGS(sv) & (SVpbm_TAIL|SVpbm_VALID)) \
== (SVpbm_TAIL|SVpbm_VALID); \
})
#define SvTAIL_off(sv) (SvFLAGS(sv) &= ~SVpbm_TAIL)
-#ifdef USE_ITHREADS
-/* The following uses the FAKE flag to show that a regex pointer is infact
- its own offset in the regexpad for ithreads */
-#define SvREPADTMP(sv) (SvFLAGS(sv) & SVf_FAKE)
-#define SvREPADTMP_on(sv) (SvFLAGS(sv) |= SVf_FAKE)
-#define SvREPADTMP_off(sv) (SvFLAGS(sv) &= ~SVf_FAKE)
-#endif
-
#define SvPAD_TYPED(sv) \
((SvFLAGS(sv) & (SVpad_NAME|SVpad_TYPED)) == (SVpad_NAME|SVpad_TYPED))
#if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
# define SvPAD_TYPED_on(sv) ({ \
- SV *const whap = (SV *) (sv); \
- assert(SvTYPE(whap) == SVt_PVMG); \
- (SvFLAGS(whap) |= SVpad_NAME|SVpad_TYPED); \
+ SV *const _svpad = MUTABLE_SV(sv); \
+ assert(SvTYPE(_svpad) == SVt_PVMG); \
+ (SvFLAGS(_svpad) |= SVpad_NAME|SVpad_TYPED); \
})
#define SvPAD_OUR_on(sv) ({ \
- SV *const whap = (SV *) (sv); \
- assert(SvTYPE(whap) == SVt_PVMG); \
- (SvFLAGS(whap) |= SVpad_NAME|SVpad_OUR); \
+ SV *const _svpad = MUTABLE_SV(sv); \
+ assert(SvTYPE(_svpad) == SVt_PVMG); \
+ (SvFLAGS(_svpad) |= SVpad_NAME|SVpad_OUR); \
})
#define SvPAD_STATE_on(sv) ({ \
- SV *const whap = (SV *) (sv); \
- assert(SvTYPE(whap) == SVt_PVNV || SvTYPE(whap) == SVt_PVMG); \
- (SvFLAGS(whap) |= SVpad_NAME|SVpad_STATE); \
+ SV *const _svpad = MUTABLE_SV(sv); \
+ assert(SvTYPE(_svpad) == SVt_PVNV || SvTYPE(_svpad) == SVt_PVMG); \
+ (SvFLAGS(_svpad) |= SVpad_NAME|SVpad_STATE); \
})
#else
# define SvPAD_TYPED_on(sv) (SvFLAGS(sv) |= SVpad_NAME|SVpad_TYPED)
((XPVMG*) SvANY(sv))->xmg_u.xmg_ourstash = st; \
} STMT_END
-#ifdef PERL_DEBUG_COW
-#else
-#endif
#define SvRVx(sv) SvRV(sv)
#ifdef PERL_DEBUG_COW
# define SvUVX(sv) (0 + ((XPVUV*) SvANY(sv))->xuv_uv)
# define SvNVX(sv) (-0.0 + ((XPVNV*) SvANY(sv))->xnv_u.xnv_nv)
# define SvRV(sv) (0 + (sv)->sv_u.svu_rv)
+# 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))
# if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
/* These get expanded inside other macros that already use a variable _sv */
# define SvPVX(sv) \
- (*({ SV *const _svi = (SV *) (sv); \
- assert(SvTYPE(_svi) >= SVt_PV); \
- assert(SvTYPE(_svi) != SVt_PVAV); \
- assert(SvTYPE(_svi) != SVt_PVHV); \
- assert(!isGV_with_GP(_svi)); \
- &((_svi)->sv_u.svu_pv); \
+ (*({ SV *const _svpvx = MUTABLE_SV(sv); \
+ assert(SvTYPE(_svpvx) >= SVt_PV); \
+ assert(SvTYPE(_svpvx) != SVt_PVAV); \
+ assert(SvTYPE(_svpvx) != SVt_PVHV); \
+ assert(!isGV_with_GP(_svpvx)); \
+ assert(!(SvTYPE(_svpvx) == SVt_PVIO \
+ && !(IoFLAGS(_svpvx) & IOf_FAKE_DIRP))); \
+ &((_svpvx)->sv_u.svu_pv); \
}))
# define SvCUR(sv) \
- (*({ SV *const _svi = (SV *) (sv); \
- assert(SvTYPE(_svi) >= SVt_PV); \
- assert(SvTYPE(_svi) != SVt_PVAV); \
- assert(SvTYPE(_svi) != SVt_PVHV); \
- assert(!isGV_with_GP(_svi)); \
- &(((XPV*) SvANY(_svi))->xpv_cur); \
+ (*({ const SV *const _svcur = (const SV *)(sv); \
+ assert(SvTYPE(_svcur) >= SVt_PV); \
+ assert(SvTYPE(_svcur) != SVt_PVAV); \
+ assert(SvTYPE(_svcur) != SVt_PVHV); \
+ assert(!isGV_with_GP(_svcur)); \
+ assert(!(SvTYPE(_svcur) == SVt_PVIO \
+ && !(IoFLAGS(_svcur) & IOf_FAKE_DIRP))); \
+ &(((XPV*) MUTABLE_PTR(SvANY(_svcur)))->xpv_cur); \
}))
# define SvIVX(sv) \
- (*({ SV *const _svi = (SV *) (sv); \
- assert(SvTYPE(_svi) == SVt_IV || SvTYPE(_svi) >= SVt_PVIV); \
- assert(SvTYPE(_svi) != SVt_PVAV); \
- assert(SvTYPE(_svi) != SVt_PVHV); \
- assert(SvTYPE(_svi) != SVt_PVCV); \
- assert(!isGV_with_GP(_svi)); \
- &(((XPVIV*) SvANY(_svi))->xiv_iv); \
+ (*({ const SV *const _svivx = (const SV *)(sv); \
+ assert(SvTYPE(_svivx) == SVt_IV || SvTYPE(_svivx) >= SVt_PVIV); \
+ assert(SvTYPE(_svivx) != SVt_PVAV); \
+ assert(SvTYPE(_svivx) != SVt_PVHV); \
+ assert(SvTYPE(_svivx) != SVt_PVCV); \
+ assert(SvTYPE(_svivx) != SVt_PVFM); \
+ assert(SvTYPE(_svivx) != SVt_PVIO); \
+ assert(SvTYPE(_svivx) != SVt_REGEXP); \
+ assert(!isGV_with_GP(_svivx)); \
+ &(((XPVIV*) MUTABLE_PTR(SvANY(_svivx)))->xiv_iv); \
}))
# define SvUVX(sv) \
- (*({ SV *const _svi = (SV *) (sv); \
- assert(SvTYPE(_svi) == SVt_IV || SvTYPE(_svi) >= SVt_PVIV); \
- assert(SvTYPE(_svi) != SVt_PVAV); \
- assert(SvTYPE(_svi) != SVt_PVHV); \
- assert(SvTYPE(_svi) != SVt_PVCV); \
- assert(!isGV_with_GP(_svi)); \
- &(((XPVUV*) SvANY(_svi))->xuv_uv); \
+ (*({ const SV *const _svuvx = (const SV *)(sv); \
+ assert(SvTYPE(_svuvx) == SVt_IV || SvTYPE(_svuvx) >= SVt_PVIV); \
+ assert(SvTYPE(_svuvx) != SVt_PVAV); \
+ assert(SvTYPE(_svuvx) != SVt_PVHV); \
+ assert(SvTYPE(_svuvx) != SVt_PVCV); \
+ assert(SvTYPE(_svuvx) != SVt_PVFM); \
+ assert(SvTYPE(_svuvx) != SVt_PVIO); \
+ assert(SvTYPE(_svuvx) != SVt_REGEXP); \
+ assert(!isGV_with_GP(_svuvx)); \
+ &(((XPVUV*) MUTABLE_PTR(SvANY(_svuvx)))->xuv_uv); \
}))
# define SvNVX(sv) \
- (*({ SV *const _svi = (SV *) (sv); \
- assert(SvTYPE(_svi) == SVt_NV || SvTYPE(_svi) >= SVt_PVNV); \
- assert(SvTYPE(_svi) != SVt_PVAV); \
- assert(SvTYPE(_svi) != SVt_PVHV); \
- assert(SvTYPE(_svi) != SVt_PVCV); \
- assert(SvTYPE(_svi) != SVt_PVFM); \
- assert(!isGV_with_GP(_svi)); \
- &(((XPVNV*) SvANY(_svi))->xnv_u.xnv_nv); \
+ (*({ const SV *const _svnvx = (const SV *)(sv); \
+ assert(SvTYPE(_svnvx) == SVt_NV || SvTYPE(_svnvx) >= SVt_PVNV); \
+ assert(SvTYPE(_svnvx) != SVt_PVAV); \
+ assert(SvTYPE(_svnvx) != SVt_PVHV); \
+ assert(SvTYPE(_svnvx) != SVt_PVCV); \
+ assert(SvTYPE(_svnvx) != SVt_PVFM); \
+ assert(SvTYPE(_svnvx) != SVt_PVIO); \
+ assert(SvTYPE(_svnvx) != SVt_REGEXP); \
+ assert(!isGV_with_GP(_svnvx)); \
+ &(((XPVNV*) MUTABLE_PTR(SvANY(_svnvx)))->xnv_u.xnv_nv); \
}))
# define SvRV(sv) \
- (*({ SV *const _svi = (SV *) (sv); \
- assert(SvTYPE(_svi) >= SVt_RV); \
- assert(SvTYPE(_svi) != SVt_PVAV); \
- assert(SvTYPE(_svi) != SVt_PVHV); \
- assert(SvTYPE(_svi) != SVt_PVCV); \
- assert(SvTYPE(_svi) != SVt_PVFM); \
- assert(!isGV_with_GP(_svi)); \
- &((_svi)->sv_u.svu_rv); \
+ (*({ SV *const _svrv = MUTABLE_SV(sv); \
+ assert(SvTYPE(_svrv) >= SVt_PV || SvTYPE(_svrv) == SVt_IV); \
+ assert(SvTYPE(_svrv) != SVt_PVAV); \
+ assert(SvTYPE(_svrv) != SVt_PVHV); \
+ assert(SvTYPE(_svrv) != SVt_PVCV); \
+ assert(SvTYPE(_svrv) != SVt_PVFM); \
+ assert(!isGV_with_GP(_svrv)); \
+ assert(!(SvTYPE(_svrv) == SVt_PVIO \
+ && !(IoFLAGS(_svrv) & IOf_FAKE_DIRP))); \
+ &((_svrv)->sv_u.svu_rv); \
}))
+# define SvRV_const(sv) \
+ ({ const SV *const _svrv = (const SV *)(sv); \
+ assert(SvTYPE(_svrv) >= SVt_PV || SvTYPE(_svrv) == SVt_IV); \
+ assert(SvTYPE(_svrv) != SVt_PVAV); \
+ assert(SvTYPE(_svrv) != SVt_PVHV); \
+ assert(SvTYPE(_svrv) != SVt_PVCV); \
+ assert(SvTYPE(_svrv) != SVt_PVFM); \
+ assert(!isGV_with_GP(_svrv)); \
+ assert(!(SvTYPE(_svrv) == SVt_PVIO \
+ && !(IoFLAGS(_svrv) & IOf_FAKE_DIRP))); \
+ (_svrv)->sv_u.svu_rv; \
+ })
# define SvMAGIC(sv) \
- (*({ SV *const _svi = (SV *) (sv); \
- assert(SvTYPE(_svi) >= SVt_PVMG); \
- if(SvTYPE(_svi) == SVt_PVMG) \
- assert(!SvPAD_OUR(_svi)); \
- &(((XPVMG*) SvANY(_svi))->xmg_u.xmg_magic); \
+ (*({ const SV *const _svmagic = (const SV *)(sv); \
+ assert(SvTYPE(_svmagic) >= SVt_PVMG); \
+ if(SvTYPE(_svmagic) == SVt_PVMG) \
+ assert(!SvPAD_OUR(_svmagic)); \
+ &(((XPVMG*) MUTABLE_PTR(SvANY(_svmagic)))->xmg_u.xmg_magic); \
}))
# define SvSTASH(sv) \
- (*({ SV *const _svi = (SV *) (sv); \
- assert(SvTYPE(_svi) >= SVt_PVMG); \
- &(((XPVMG*) SvANY(_svi))->xmg_stash); \
+ (*({ const SV *const _svstash = (const SV *)(sv); \
+ assert(SvTYPE(_svstash) >= SVt_PVMG); \
+ &(((XPVMG*) MUTABLE_PTR(SvANY(_svstash)))->xmg_stash); \
}))
# else
# define SvPVX(sv) ((sv)->sv_u.svu_pv)
# define SvUVX(sv) ((XPVUV*) SvANY(sv))->xuv_uv
# define SvNVX(sv) ((XPVNV*) SvANY(sv))->xnv_u.xnv_nv
# define SvRV(sv) ((sv)->sv_u.svu_rv)
+# define SvRV_const(sv) (0 + (sv)->sv_u.svu_rv)
# define SvMAGIC(sv) ((XPVMG*) SvANY(sv))->xmg_u.xmg_magic
# define SvSTASH(sv) ((XPVMG*) SvANY(sv))->xmg_stash
# endif
#define SvIV_please(sv) \
STMT_START {if (!SvIOKp(sv) && (SvNOK(sv) || SvPOK(sv))) \
(void) SvIV(sv); } STMT_END
+#define SvIV_please_nomg(sv) \
+ STMT_START {if (!SvIOKp(sv) && (SvNOK(sv) || SvPOK(sv))) \
+ (void) SvIV_nomg(sv); } STMT_END
#define SvIV_set(sv, val) \
STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
assert(SvTYPE(sv) != SVt_PVAV); \
STMT_START { assert(SvTYPE(sv) == SVt_NV || SvTYPE(sv) >= SVt_PVNV); \
assert(SvTYPE(sv) != SVt_PVAV); assert(SvTYPE(sv) != SVt_PVHV); \
assert(SvTYPE(sv) != SVt_PVCV); assert(SvTYPE(sv) != SVt_PVFM); \
+ assert(SvTYPE(sv) != SVt_PVIO); \
assert(!isGV_with_GP(sv)); \
(((XPVNV*)SvANY(sv))->xnv_u.xnv_nv = (val)); } STMT_END
#define SvPV_set(sv, val) \
assert(SvTYPE(sv) != SVt_PVAV); \
assert(SvTYPE(sv) != SVt_PVHV); \
assert(!isGV_with_GP(sv)); \
+ assert(!(SvTYPE(sv) == SVt_PVIO \
+ && !(IoFLAGS(sv) & IOf_FAKE_DIRP))); \
((sv)->sv_u.svu_pv = (val)); } STMT_END
#define SvUV_set(sv, val) \
STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
assert(!isGV_with_GP(sv)); \
(((XPVUV*)SvANY(sv))->xuv_uv = (val)); } STMT_END
#define SvRV_set(sv, val) \
- STMT_START { assert(SvTYPE(sv) >= SVt_RV); \
+ STMT_START { assert(SvTYPE(sv) >= SVt_PV || SvTYPE(sv) == SVt_IV); \
assert(SvTYPE(sv) != SVt_PVAV); \
assert(SvTYPE(sv) != SVt_PVHV); \
assert(SvTYPE(sv) != SVt_PVCV); \
assert(SvTYPE(sv) != SVt_PVFM); \
assert(!isGV_with_GP(sv)); \
+ assert(!(SvTYPE(sv) == SVt_PVIO \
+ && !(IoFLAGS(sv) & IOf_FAKE_DIRP))); \
((sv)->sv_u.svu_rv = (val)); } STMT_END
#define SvMAGIC_set(sv, val) \
STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
assert(SvTYPE(sv) != SVt_PVAV); \
assert(SvTYPE(sv) != SVt_PVHV); \
assert(!isGV_with_GP(sv)); \
+ assert(!(SvTYPE(sv) == SVt_PVIO \
+ && !(IoFLAGS(sv) & IOf_FAKE_DIRP))); \
(((XPV*) SvANY(sv))->xpv_cur = (val)); } STMT_END
#define SvLEN_set(sv, val) \
STMT_START { assert(SvTYPE(sv) >= SVt_PV); \
assert(SvTYPE(sv) != SVt_PVAV); \
assert(SvTYPE(sv) != SVt_PVHV); \
assert(!isGV_with_GP(sv)); \
+ assert(!(SvTYPE(sv) == SVt_PVIO \
+ && !(IoFLAGS(sv) & IOf_FAKE_DIRP))); \
(((XPV*) SvANY(sv))->xpv_len = (val)); } STMT_END
#define SvEND_set(sv, val) \
STMT_START { assert(SvTYPE(sv) >= SVt_PV); \
- (SvCUR(sv) = (val) - SvPVX(sv)); } STMT_END
+ SvCUR_set(sv, (val) - SvPVX(sv)); } STMT_END
#define SvPV_renew(sv,n) \
STMT_START { SvLEN_set(sv, n); \
STMT_START { \
assert(SvTYPE(sv) >= SVt_PV); \
if (SvLEN(sv)) { \
+ assert(!SvROK(sv)); \
if(SvOOK(sv)) { \
- SvPV_set(sv, SvPVX_mutable(sv) - SvIVX(sv)); \
+ STRLEN zok; \
+ SvOOK_offset(sv, zok); \
+ SvPV_set(sv, SvPVX_mutable(sv) - zok); \
SvFLAGS(sv) &= ~SVf_OOK; \
} \
Safefree(SvPVX(sv)); \
} \
} STMT_END
+#ifdef PERL_CORE
+/* Code that crops up in three places to take a scalar and ready it to hold
+ a reference */
+# define prepare_SV_for_RV(sv) \
+ STMT_START { \
+ if (SvTYPE(sv) < SVt_PV && SvTYPE(sv) != SVt_IV) \
+ sv_upgrade(sv, SVt_IV); \
+ else if (SvTYPE(sv) >= SVt_PV) { \
+ SvPV_free(sv); \
+ SvLEN_set(sv, 0); \
+ SvCUR_set(sv, 0); \
+ } \
+ } STMT_END
+#endif
#define PERL_FBM_TABLE_OFFSET 1 /* Number of bytes between EOS and table */
/* SvPOKp not SvPOK in the assertion because the string can be tainted! eg
perl -T -e '/$^X/'
*/
+
+#define BmFLAGS(sv) (SvTAIL(sv) ? FBMcf_TAIL : 0)
+
#if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-# define BmFLAGS(sv) \
- (*({ SV *const uggh = (SV *) (sv); \
- assert(SvTYPE(uggh) == SVt_PVGV); \
- assert(SvVALID(uggh)); \
- &(((XPVGV*) SvANY(uggh))->xnv_u.xbm_s.xbm_flags); \
- }))
# define BmRARE(sv) \
- (*({ SV *const uggh = (SV *) (sv); \
- assert(SvTYPE(uggh) == SVt_PVGV); \
- assert(SvVALID(uggh)); \
- &(((XPVGV*) SvANY(uggh))->xnv_u.xbm_s.xbm_rare); \
+ (*({ SV *const _bmrare = MUTABLE_SV(sv); \
+ assert(SvTYPE(_bmrare) == SVt_PVGV); \
+ assert(SvVALID(_bmrare)); \
+ &(((XPVGV*) SvANY(_bmrare))->xnv_u.xbm_s.xbm_rare); \
}))
# define BmUSEFUL(sv) \
- (*({ SV *const uggh = (SV *) (sv); \
- assert(SvTYPE(uggh) == SVt_PVGV); \
- assert(SvVALID(uggh)); \
- assert(!SvIOK(uggh)); \
- &(((XPVGV*) SvANY(uggh))->xiv_u.xivu_i32); \
+ (*({ SV *const _bmuseful = MUTABLE_SV(sv); \
+ assert(SvTYPE(_bmuseful) == SVt_PVGV); \
+ assert(SvVALID(_bmuseful)); \
+ assert(!SvIOK(_bmuseful)); \
+ &(((XPVGV*) SvANY(_bmuseful))->xiv_u.xivu_i32); \
}))
# define BmPREVIOUS(sv) \
- (*({ SV *const uggh = (SV *) (sv); \
- assert(SvTYPE(uggh) == SVt_PVGV); \
- assert(SvVALID(uggh)); \
- &(((XPVGV*) SvANY(uggh))->xnv_u.xbm_s.xbm_previous); \
+ (*({ SV *const _bmprevious = MUTABLE_SV(sv); \
+ assert(SvTYPE(_bmprevious) == SVt_PVGV); \
+ assert(SvVALID(_bmprevious)); \
+ &(((XPVGV*) SvANY(_bmprevious))->xnv_u.xbm_s.xbm_previous); \
}))
#else
-# define BmFLAGS(sv) ((XPVGV*) SvANY(sv))->xnv_u.xbm_s.xbm_flags
# define BmRARE(sv) ((XPVGV*) SvANY(sv))->xnv_u.xbm_s.xbm_rare
# define BmUSEFUL(sv) ((XPVGV*) SvANY(sv))->xiv_u.xivu_i32
# define BmPREVIOUS(sv) ((XPVGV*) SvANY(sv))->xnv_u.xbm_s.xbm_previous
#define LvTARGOFF(sv) ((XPVLV*) SvANY(sv))->xlv_targoff
#define LvTARGLEN(sv) ((XPVLV*) SvANY(sv))->xlv_targlen
-#define IoIFP(sv) ((XPVIO*) SvANY(sv))->xio_ifp
+#define IoIFP(sv) (sv)->sv_u.svu_fp
#define IoOFP(sv) ((XPVIO*) SvANY(sv))->xio_ofp
#define IoDIRP(sv) ((XPVIO*) SvANY(sv))->xio_dirp
#define IoANY(sv) ((XPVIO*) SvANY(sv))->xio_any
-#define IoLINES(sv) ((XPVIO*) SvANY(sv))->xio_lines
+#define IoLINES(sv) ((XPVIO*) SvANY(sv))->xiv_u.xivu_iv
#define IoPAGE(sv) ((XPVIO*) SvANY(sv))->xio_page
#define IoPAGE_LEN(sv) ((XPVIO*) SvANY(sv))->xio_page_len
#define IoLINES_LEFT(sv)((XPVIO*) SvANY(sv))->xio_lines_left
the SV if the SV does not contain a string. The SV may cache the
stringified form becoming C<SvPOK>. Handles 'get' magic.
+=for apidoc Am|char*|SvPV_nomg_nolen|SV* sv
+Like C<SvPV_nolen> but doesn't process magic.
+
=for apidoc Am|IV|SvIV|SV* sv
Coerces the given SV to an integer and returns it. See C<SvIVx> for a
version which guarantees to evaluate sv only once.
Coerce the given SV to a double and return it. See C<SvNVx> for a version
which guarantees to evaluate sv only once.
+=for apidoc Am|NV|SvNV_nomg|SV* sv
+Like C<SvNV> but doesn't process magic.
+
=for apidoc Am|NV|SvNVx|SV* sv
Coerces the given SV to a double and returns it. Guarantees to evaluate
C<sv> only once. Only use this if C<sv> is an expression with side effects,
=for apidoc Am|bool|SvTRUE|SV* sv
Returns a boolean indicating whether Perl would evaluate the SV as true or
-false, defined or undefined. Does not handle 'get' magic.
+false. See SvOK() for a defined/undefined test. Handles 'get' magic
+unless the scalar is already SvPOK, SvIOK or SvNOK (the public, not the
+private flags).
+
+=for apidoc Am|bool|SvTRUE_nomg|SV* sv
+Returns a boolean indicating whether Perl would evaluate the SV as true or
+false. See SvOK() for a defined/undefined test. Does not handle 'get' magic.
=for apidoc Am|char*|SvPVutf8_force|SV* sv|STRLEN len
Like C<SvPV_force>, but converts sv to utf8 first if necessary.
=for apidoc Am|void|sv_catpvn_nomg|SV* sv|const char* ptr|STRLEN len
Like C<sv_catpvn> but doesn't process magic.
+=for apidoc Am|void|sv_catpv_nomg|SV* sv|const char* ptr
+Like C<sv_catpv> but doesn't process magic.
+
=for apidoc Am|void|sv_setsv_nomg|SV* dsv|SV* ssv
Like C<sv_setsv> but doesn't process magic.
=for apidoc Am|void|sv_catsv_nomg|SV* dsv|SV* ssv
Like C<sv_catsv> but doesn't process magic.
+=for apidoc Amdb|STRLEN|sv_utf8_upgrade_nomg|NN SV *sv
+
+Like sv_utf8_upgrade, but doesn't do magic on C<sv>
+
=cut
*/
#define SvIV_nomg(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv_flags(sv, 0))
#define SvUV_nomg(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv_flags(sv, 0))
+#define SvNV_nomg(sv) (SvNOK(sv) ? SvNVX(sv) : sv_2nv_flags(sv, 0))
/* ----*/
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
? SvPVX(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC))
+#define SvPV_nomg_nolen(sv) \
+ ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
+ ? SvPVX(sv) : sv_2pv_flags(sv, 0, 0))
+
#define SvPV_nolen_const(sv) \
((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
? SvPVX_const(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC|SV_CONST_RETURN))
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8(sv, &lp))
#define SvPVutf8_force(sv, lp) \
- ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == (SVf_POK|SVf_UTF8) \
+ ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST)) == (SVf_POK|SVf_UTF8) \
? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvutf8n_force(sv, &lp))
#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
-# define SvIVx(sv) ({SV *_sv = (SV*)(sv); SvIV(_sv); })
-# define SvUVx(sv) ({SV *_sv = (SV*)(sv); SvUV(_sv); })
-# define SvNVx(sv) ({SV *_sv = (SV*)(sv); SvNV(_sv); })
+# define SvIVx(sv) ({SV *_sv = MUTABLE_SV(sv); SvIV(_sv); })
+# define SvUVx(sv) ({SV *_sv = MUTABLE_SV(sv); SvUV(_sv); })
+# define SvNVx(sv) ({SV *_sv = MUTABLE_SV(sv); SvNV(_sv); })
# define SvPVx(sv, lp) ({SV *_sv = (sv); SvPV(_sv, lp); })
# define SvPVx_const(sv, lp) ({SV *_sv = (sv); SvPV_const(_sv, lp); })
# define SvPVx_nolen(sv) ({SV *_sv = (sv); SvPV_nolen(_sv); })
: SvNOK(sv) \
? SvNVX(sv) != 0.0 \
: sv_2bool(sv) )
+# define SvTRUE_nomg(sv) ( \
+ !sv \
+ ? 0 \
+ : SvPOK(sv) \
+ ? (({XPV *nxpv = (XPV*)SvANY(sv); \
+ nxpv && \
+ (nxpv->xpv_cur > 1 || \
+ (nxpv->xpv_cur && *(sv)->sv_u.svu_pv != '0')); }) \
+ ? 1 \
+ : 0) \
+ : \
+ SvIOK(sv) \
+ ? SvIVX(sv) != 0 \
+ : SvNOK(sv) \
+ ? SvNVX(sv) != 0.0 \
+ : sv_2bool_flags(sv,0) )
# define SvTRUEx(sv) ({SV *_sv = (sv); SvTRUE(_sv); })
#else /* __GNUC__ */
: SvNOK(sv) \
? SvNVX(sv) != 0.0 \
: sv_2bool(sv) )
+# define SvTRUE_nomg(sv) ( \
+ !sv \
+ ? 0 \
+ : SvPOK(sv) \
+ ? ((PL_Xpv = (XPV*)SvANY(PL_Sv = (sv))) && \
+ (PL_Xpv->xpv_cur > 1 || \
+ (PL_Xpv->xpv_cur && *PL_Sv->sv_u.svu_pv != '0')) \
+ ? 1 \
+ : 0) \
+ : \
+ SvIOK(sv) \
+ ? SvIVX(sv) != 0 \
+ : SvNOK(sv) \
+ ? SvNVX(sv) != 0.0 \
+ : sv_2bool_flags(sv,0) )
# define SvTRUEx(sv) ((PL_Sv = (sv)), SvTRUE(PL_Sv))
#endif /* __GNU__ */
#define SV_COW_SHARED_HASH_KEYS 512
/* This one is only enabled for PERL_OLD_COPY_ON_WRITE */
#define SV_COW_OTHER_PVS 1024
+/* Make sv_2pv_flags return NULL if something is undefined. */
+#define SV_UNDEF_RETURNS_NULL 2048
+/* Tell sv_utf8_upgrade() to not check to see if an upgrade is really needed.
+ * This is used when the caller has already determined it is, and avoids
+ * redundant work */
+#define SV_FORCE_UTF8_UPGRADE 4096
+/* if (after resolving magic etc), the SV is found to be overloaded,
+ * don't call the overload magic, just return as-is */
+#define SV_SKIP_OVERLOAD 8192
/* The core is safe for this COW optimisation. XS code on CPAN may not be.
So only default to doing the COW setup if we're in the core.
#ifdef PERL_OLD_COPY_ON_WRITE
#define SvRELEASE_IVX(sv) \
- ((SvIsCOW(sv) ? sv_force_normal_flags(sv, 0) : (void) 0), SvOOK_off(sv))
+ ((SvIsCOW(sv) ? sv_force_normal_flags(sv, 0) : (void) 0), 0)
# define SvIsCOW_normal(sv) (SvIsCOW(sv) && SvLEN(sv))
+# define SvRELEASE_IVX_(sv) SvRELEASE_IVX(sv),
#else
-# define SvRELEASE_IVX(sv) SvOOK_off(sv)
+# define SvRELEASE_IVX(sv) 0
+/* This little game brought to you by the need to shut this warning up:
+mg.c: In function `Perl_magic_get':
+mg.c:1024: warning: left-hand operand of comma expression has no effect
+*/
+# define SvRELEASE_IVX_(sv) /**/
#endif /* PERL_OLD_COPY_ON_WRITE */
#define CAN_COW_MASK (SVs_OBJECT|SVs_GMG|SVs_SMG|SVs_RMG|SVf_IOK|SVf_NOK| \
#define sv_pvbyte(sv) SvPVbyte_nolen(sv)
#define sv_pvn_force_nomg(sv, lp) sv_pvn_force_flags(sv, lp, 0)
+#define sv_utf8_upgrade_flags(sv, flags) sv_utf8_upgrade_flags_grow(sv, flags, 0)
#define sv_utf8_upgrade_nomg(sv) sv_utf8_upgrade_flags(sv, 0)
#define sv_catpvn_nomg(dsv, sstr, slen) sv_catpvn_flags(dsv, sstr, slen, 0)
+#define sv_catpv_nomg(dsv, sstr) sv_catpv_flags(dsv, sstr, 0)
#define sv_setsv(dsv, ssv) \
sv_setsv_flags(dsv, ssv, SV_GMAGIC|SV_DO_COW_SVSETSV)
#define sv_setsv_nomg(dsv, ssv) sv_setsv_flags(dsv, ssv, SV_DO_COW_SVSETSV)
#define sv_utf8_upgrade(sv) sv_utf8_upgrade_flags(sv, SV_GMAGIC)
#define sv_2iv(sv) sv_2iv_flags(sv, SV_GMAGIC)
#define sv_2uv(sv) sv_2uv_flags(sv, SV_GMAGIC)
+#define sv_2nv(sv) sv_2nv_flags(sv, SV_GMAGIC)
+#define sv_eq(sv1, sv2) sv_eq_flags(sv1, sv2, SV_GMAGIC)
+#define sv_cmp(sv1, sv2) sv_cmp_flags(sv1, sv2, SV_GMAGIC)
+#define sv_cmp_locale(sv1, sv2) sv_cmp_locale_flags(sv1, sv2, SV_GMAGIC)
+#define sv_collxfrm(sv, nxp) sv_cmp_flags(sv, nxp, SV_GMAGIC)
+#define sv_2bool(sv) sv_2bool_flags(sv, SV_GMAGIC)
+#define sv_insert(bigstr, offset, len, little, littlelen) \
+ Perl_sv_insert_flags(aTHX_ (bigstr),(offset), (len), (little), \
+ (littlelen), SV_GMAGIC)
/* Should be named SvCatPVN_utf8_upgrade? */
#define sv_catpvn_utf8_upgrade(dsv, sstr, slen, nsv) \
STMT_START { \
if (!(nsv)) \
- nsv = sv_2mortal(newSVpvn(sstr, slen)); \
+ nsv = newSVpvn_flags(sstr, slen, SVs_TEMP); \
else \
sv_setpvn(nsv, sstr, slen); \
SvUTF8_off(nsv); \
=cut
*/
-#define SvSHARE(sv) CALL_FPTR(PL_sharehook)(aTHX_ sv)
-#define SvLOCK(sv) CALL_FPTR(PL_lockhook)(aTHX_ sv)
-#define SvUNLOCK(sv) CALL_FPTR(PL_unlockhook)(aTHX_ sv)
+#define SvSHARE(sv) PL_sharehook(aTHX_ sv)
+#define SvLOCK(sv) PL_lockhook(aTHX_ sv)
+#define SvUNLOCK(sv) PL_unlockhook(aTHX_ sv)
+#define SvDESTROYABLE(sv) PL_destroyhook(aTHX_ sv)
#define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
#define SvSETMAGIC(x) STMT_START { if (SvSMAGICAL(x)) mg_set(x); } STMT_END
AV* stashes;
UV flags;
PerlInterpreter *proto_perl;
+ PerlInterpreter *new_perl;
+ AV *unreferenced;
};
/*
+=for apidoc Am|SV*|newSVpvn_utf8|NULLOK const char* s|STRLEN len|U32 utf8
+
+Creates a new SV and copies a string into it. If utf8 is true, calls
+C<SvUTF8_on> on the new SV. Implemented as a wrapper around C<newSVpvn_flags>.
+
+=cut
+*/
+
+#define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
+
+/*
+=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
+allocated buffer, which will be non-zero if C<sv_chop> has been used to
+efficiently remove characters from start of the buffer. Implemented as a
+macro, which takes the address of I<len>, which must be of type C<STRLEN>.
+Evaluates I<sv> more than once. Sets I<len> to 0 if C<SvOOK(sv)> is false.
+
+=cut
+*/
+
+#ifdef DEBUGGING
+/* Does the bot know something I don't?
+10:28 <@Nicholas> metabatman
+10:28 <+meta> Nicholas: crash
+*/
+# 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); \
+ } \
+ { \
+ /* 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)); \
+ } \
+ } \
+ } else { \
+ offset = 0; \
+ } \
+ } STMT_END
+#else
+ /* This is the same code, but avoids using any temporary variables: */
+# define SvOOK_offset(sv, offset) STMT_START { \
+ assert(sizeof(offset) == sizeof(STRLEN)); \
+ if (SvOOK(sv)) { \
+ offset = ((U8*)SvPVX_const(sv))[-1]; \
+ if (!offset) { \
+ Copy(SvPVX_const(sv) - 1 - sizeof(STRLEN), \
+ (U8 *)&offset, sizeof(STRLEN), U8); \
+ } \
+ } else { \
+ offset = 0; \
+ } \
+ } STMT_END
+#endif
+
+#define newIO() MUTABLE_IO(newSV_type(SVt_PVIO))
+
+/*
* Local variables:
* c-indentation-style: bsd
* c-basic-offset: 4
https://perl5.git.perl.org / perl5.git / blobdiff