X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/85dca89a8f321bc581a3d365d95ab0c56368ed78..7c1b9f38fcbfdb3a9e1766e02bcb991d1a5452d9:/sv.h diff --git a/sv.h b/sv.h index 90771a4..72cd887 100644 --- a/sv.h +++ b/sv.h @@ -65,6 +65,11 @@ typedef enum { SVt_LAST /* keep last in enum. used to size arrays */ } svtype; +/* *** any alterations to the SV types above need to be reflected in + * SVt_MASK and the various PL_valid_types_* tables */ + +#define SVt_MASK 0xf /* smallest bitmask that covers all types */ + #ifndef PERL_CORE /* Although Fast Boyer Moore tables are now being stored in PVGVs, for most purposes eternal code wanting to consider PVBM probably needs to think of @@ -76,13 +81,9 @@ typedef enum { #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 @@ -103,13 +104,14 @@ typedef struct hek HEK; #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 @@ -119,10 +121,10 @@ struct STRUCT_SV { /* struct sv { */ #ifdef DEBUG_LEAKING_SCALARS 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_cloned:1; /* was cloned for an ithread */ PERL_BITFIELD32 sv_debug_line:16; /* the line where we were allocated */ - U32 sv_debug_serial; /* serial number of sv allocation */ - char * sv_debug_file; /* the file 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 }; @@ -307,10 +309,10 @@ perform the upgrade if necessary. See C. subroutine in another package. Set the CvIMPORTED_CV_ON() if it needs to be expanded to a real GV */ - -#define SVs_PADSTALE 0x00010000 /* lexical has gone out of scope */ -#define SVpad_STATE 0x00010000 /* pad name is a "state" var */ -#define SVs_PADTMP 0x00020000 /* in use as tmp */ +/* 0x00010000 *** FREE SLOT */ +#define SVs_PADTMP 0x00020000 /* in use as tmp; only if ! SVs_PADMY */ +#define SVs_PADSTALE 0x00020000 /* lexical has gone out of scope; + only valid for SVs_PADMY */ #define SVpad_TYPED 0x00020000 /* pad name is a Typed Lexical */ #define SVs_PADMY 0x00040000 /* in use a "my" variable */ #define SVpad_OUR 0x00040000 /* pad name is "our" instead of "my" */ @@ -370,8 +372,21 @@ perform the upgrade if necessary. See C. /* 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 */ @@ -381,31 +396,28 @@ perform the upgrade if necessary. See C. /* 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 */ +/* pad name vars only */ +#define SVpad_STATE 0x80000000 /* pad name is a "state" var */ -#define _XPV_ALLOCATED_HEAD \ +#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 */ -#define _XPV_HEAD \ - union _xnvu xnv_u; \ - _XPV_ALLOCATED_HEAD - union _xnvu { NV xnv_nv; /* numeric value, if any */ HV * xgv_stash; @@ -414,20 +426,15 @@ union _xnvu { 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; + I32 xbm_useful; U8 xbm_rare; /* rarest character in string */ } xbm_s; /* fields from PVBM */ }; union _xivu { IV xivu_iv; /* integer value */ - /* xpvfm: lines */ UV xivu_uv; - void * xivu_p1; - I32 xivu_i32; HEK * xivu_namehek; /* xpvlv, xpvgv: GvNAME */ - HV * xivu_hv; /* regexp: paren_names */ }; union _xmgu { @@ -439,20 +446,11 @@ struct xpv { _XPV_HEAD; }; -typedef struct { - _XPV_ALLOCATED_HEAD; -} xpv_allocated; - struct xpviv { _XPV_HEAD; union _xivu xiv_u; }; -typedef struct { - _XPV_ALLOCATED_HEAD; - union _xivu xiv_u; -} xpviv_allocated; - #define xiv_iv xiv_u.xivu_iv struct xpvuv { @@ -465,23 +463,20 @@ struct xpvuv { struct xpvnv { _XPV_HEAD; union _xivu xiv_u; + union _xnvu xnv_u; }; -#define _XPVMG_HEAD \ - union _xivu xiv_u; \ - union _xmgu xmg_u; \ - HV* xmg_stash /* class package */ - -/* 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 { _XPV_HEAD; - _XPVMG_HEAD; + union _xivu xiv_u; + union _xnvu xnv_u; }; struct xpvlv { _XPV_HEAD; - _XPVMG_HEAD; - + union _xivu xiv_u; + union _xnvu xnv_u; STRLEN xlv_targoff; STRLEN xlv_targlen; SV* xlv_targ; @@ -493,7 +488,8 @@ struct xpvlv { Boyer-Moore. */ struct xpvgv { _XPV_HEAD; - _XPVMG_HEAD; + union _xivu xiv_u; + union _xnvu xnv_u; }; /* This structure must match XPVCV in cv.h */ @@ -521,50 +517,41 @@ typedef U16 cv_flags_t; struct xpvfm { _XPV_HEAD; - _XPVMG_HEAD; _XPVCV_COMMON; + IV xfm_lines; }; -typedef struct { - _XPV_ALLOCATED_HEAD; - _XPVMG_HEAD; - _XPVCV_COMMON; -} xpvfm_allocated; - -#define _XPVIO_TAIL \ - PerlIO * xio_ifp; /* ifp and ofp are normally the same */ \ - PerlIO * xio_ofp; /* but sockets need separate streams */ \ - /* 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 \ - * The any pointer (known as IoANY()) will also be a good place \ - * to hang any IO disciplines to. \ - */ \ - union { \ - DIR * xiou_dirp; /* for opendir, readdir, etc */ \ - void * xiou_any; /* for alignment */ \ - } xio_dirpu; \ - IV xio_lines; /* $. */ \ - IV xio_page; /* $% */ \ - IV xio_page_len; /* $= */ \ - IV xio_lines_left; /* $- */ \ - char * xio_top_name; /* $^ */ \ - GV * xio_top_gv; /* $^ */ \ - char * xio_fmt_name; /* $~ */ \ - GV * xio_fmt_gv; /* $~ */ \ - char * xio_bottom_name;/* $^B */ \ - GV * xio_bottom_gv; /* $^B */ \ - char xio_type; \ - U8 xio_flags - struct xpvio { _XPV_HEAD; - _XPVMG_HEAD; - _XPVIO_TAIL; + 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 + * The any pointer (known as IoANY()) will also be a good place + * to hang any IO disciplines to. + */ + union { + DIR * xiou_dirp; /* for opendir, readdir, etc */ + void * xiou_any; /* for alignment */ + } xio_dirpu; + /* IV xio_lines is now in IVX $. */ + IV xio_page; /* $% */ + IV xio_page_len; /* $= */ + IV xio_lines_left; /* $- */ + char * xio_top_name; /* $^ */ + GV * xio_top_gv; /* $^ */ + char * xio_fmt_name; /* $~ */ + GV * xio_fmt_gv; /* $~ */ + char * xio_bottom_name;/* $^B */ + GV * xio_bottom_gv; /* $^B */ + char xio_type; + U8 xio_flags; }; #define xio_dirp xio_dirpu.xiou_dirp @@ -576,7 +563,8 @@ struct xpvio { #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. */ @@ -697,6 +685,9 @@ Only use when you are sure SvNOK is true. See also C. Returns a pointer to the physical string in the SV. The SV must contain a string. +This is also used to store the name of an autoloaded subroutine in an XS +AUTOLOAD routine. See L. + =for apidoc Am|STRLEN|SvCUR|SV* sv Returns the length of the string which is in the SV. See C. @@ -705,9 +696,14 @@ Returns the size of the string buffer in the SV, not including any part attributable to C. See C. =for apidoc Am|char*|SvEND|SV* sv -Returns a pointer to the last character in the string which is in the SV. +Returns a pointer to the spot just after the last character in +the string which is in the SV, where there is usually a trailing +null (even though Perl scalars do not strictly require it). See C. Access the character as *(SvEND(sv)). +Warning: If C is equal to C, then C points to +unallocated memory. + =for apidoc Am|HV*|SvSTASH|SV* sv Returns the stash of the SV. @@ -923,17 +919,43 @@ the scalar's value cannot change unless written to. #define SvTHINKFIRST(sv) (SvFLAGS(sv) & SVf_THINKFIRST) -#define SvPADSTALE(sv) (SvFLAGS(sv) & SVs_PADSTALE) -#define SvPADSTALE_on(sv) (SvFLAGS(sv) |= SVs_PADSTALE) -#define SvPADSTALE_off(sv) (SvFLAGS(sv) &= ~SVs_PADSTALE) - -#define SvPADTMP(sv) (SvFLAGS(sv) & SVs_PADTMP) -#define SvPADTMP_on(sv) (SvFLAGS(sv) |= SVs_PADTMP) -#define SvPADTMP_off(sv) (SvFLAGS(sv) &= ~SVs_PADTMP) - #define SvPADMY(sv) (SvFLAGS(sv) & SVs_PADMY) #define SvPADMY_on(sv) (SvFLAGS(sv) |= SVs_PADMY) +/* SVs_PADTMP and SVs_PADSTALE share the same bit, mediated by SVs_PADMY */ + +#define SvPADTMP(sv) ((SvFLAGS(sv) & (SVs_PADMY|SVs_PADTMP)) == SVs_PADTMP) +#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 SvTEMP(sv) (SvFLAGS(sv) & SVs_TEMP) #define SvTEMP_on(sv) (SvFLAGS(sv) |= SVs_TEMP) #define SvTEMP_off(sv) (SvFLAGS(sv) &= ~SVs_TEMP) @@ -950,9 +972,11 @@ the scalar's value cannot change unless written to. #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) @@ -1030,9 +1054,6 @@ the scalar's value cannot change unless written to. ((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 @@ -1068,69 +1089,52 @@ the scalar's value cannot change unless written to. /* These get expanded inside other macros that already use a variable _sv */ # define SvPVX(sv) \ (*({ SV *const _svpvx = MUTABLE_SV(sv); \ - assert(SvTYPE(_svpvx) >= SVt_PV); \ - assert(SvTYPE(_svpvx) != SVt_PVAV); \ - assert(SvTYPE(_svpvx) != SVt_PVHV); \ + assert(PL_valid_types_PVX[SvTYPE(_svpvx) & SVt_MASK]); \ assert(!isGV_with_GP(_svpvx)); \ + assert(!(SvTYPE(_svpvx) == SVt_PVIO \ + && !(IoFLAGS(_svpvx) & IOf_FAKE_DIRP))); \ &((_svpvx)->sv_u.svu_pv); \ })) # define SvCUR(sv) \ (*({ const SV *const _svcur = (const SV *)(sv); \ - assert(SvTYPE(_svcur) >= SVt_PV); \ - assert(SvTYPE(_svcur) != SVt_PVAV); \ - assert(SvTYPE(_svcur) != SVt_PVHV); \ + assert(PL_valid_types_PVX[SvTYPE(_svcur) & SVt_MASK]); \ 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) \ (*({ 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(PL_valid_types_IVX[SvTYPE(_svivx) & SVt_MASK]); \ assert(!isGV_with_GP(_svivx)); \ &(((XPVIV*) MUTABLE_PTR(SvANY(_svivx)))->xiv_iv); \ })) # define SvUVX(sv) \ (*({ 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(PL_valid_types_IVX[SvTYPE(_svuvx) & SVt_MASK]); \ assert(!isGV_with_GP(_svuvx)); \ &(((XPVUV*) MUTABLE_PTR(SvANY(_svuvx)))->xuv_uv); \ })) # define SvNVX(sv) \ (*({ 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(PL_valid_types_NVX[SvTYPE(_svnvx) & SVt_MASK]); \ assert(!isGV_with_GP(_svnvx)); \ &(((XPVNV*) MUTABLE_PTR(SvANY(_svnvx)))->xnv_u.xnv_nv); \ })) # define SvRV(sv) \ (*({ 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(PL_valid_types_RV[SvTYPE(_svrv) & SVt_MASK]); \ 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(PL_valid_types_RV[SvTYPE(_svrv) & SVt_MASK]); \ assert(!isGV_with_GP(_svrv)); \ + assert(!(SvTYPE(_svrv) == SVt_PVIO \ + && !(IoFLAGS(_svrv) & IOf_FAKE_DIRP))); \ (_svrv)->sv_u.svu_rv; \ }) # define SvMAGIC(sv) \ @@ -1184,40 +1188,37 @@ the scalar's value cannot change unless written to. #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); \ - assert(SvTYPE(sv) != SVt_PVHV); \ - assert(SvTYPE(sv) != SVt_PVCV); \ + STMT_START { \ + assert(PL_valid_types_IV_set[SvTYPE(sv) & SVt_MASK]); \ assert(!isGV_with_GP(sv)); \ (((XPVIV*) SvANY(sv))->xiv_iv = (val)); } STMT_END #define SvNV_set(sv, val) \ - 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); \ + STMT_START { \ + assert(PL_valid_types_NV_set[SvTYPE(sv) & SVt_MASK]); \ assert(!isGV_with_GP(sv)); \ (((XPVNV*)SvANY(sv))->xnv_u.xnv_nv = (val)); } STMT_END #define SvPV_set(sv, val) \ - STMT_START { assert(SvTYPE(sv) >= SVt_PV); \ - assert(SvTYPE(sv) != SVt_PVAV); \ - assert(SvTYPE(sv) != SVt_PVHV); \ + STMT_START { \ + assert(PL_valid_types_PVX[SvTYPE(sv) & SVt_MASK]); \ 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(SvTYPE(sv) != SVt_PVAV); \ - assert(SvTYPE(sv) != SVt_PVHV); \ - assert(SvTYPE(sv) != SVt_PVCV); \ + STMT_START { \ + assert(PL_valid_types_IV_set[SvTYPE(sv) & SVt_MASK]); \ assert(!isGV_with_GP(sv)); \ (((XPVUV*)SvANY(sv))->xuv_uv = (val)); } STMT_END #define SvRV_set(sv, val) \ - 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); \ + STMT_START { \ + assert(PL_valid_types_RV[SvTYPE(sv) & SVt_MASK]); \ 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); \ @@ -1226,16 +1227,18 @@ the scalar's value cannot change unless written to. STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \ (((XPVMG*) SvANY(sv))->xmg_stash = (val)); } STMT_END #define SvCUR_set(sv, val) \ - STMT_START { assert(SvTYPE(sv) >= SVt_PV); \ - assert(SvTYPE(sv) != SVt_PVAV); \ - assert(SvTYPE(sv) != SVt_PVHV); \ + STMT_START { \ + assert(PL_valid_types_PVX[SvTYPE(sv) & SVt_MASK]); \ 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); \ + STMT_START { \ + assert(PL_valid_types_PVX[SvTYPE(sv) & SVt_MASK]); \ 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); \ @@ -1283,57 +1286,53 @@ the scalar's value cannot change unless written to. } 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/' */ + +#ifndef PERL_CORE +# define BmFLAGS(sv) (SvTAIL(sv) ? FBMcf_TAIL : 0) +#endif + #if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) -# define BmFLAGS(sv) \ - (*({ SV *const _bmflags = MUTABLE_SV(sv); \ - assert(SvTYPE(_bmflags) == SVt_PVGV); \ - assert(SvVALID(_bmflags)); \ - &(((XPVGV*) SvANY(_bmflags))->xnv_u.xbm_s.xbm_flags); \ - })) # define BmRARE(sv) \ (*({ SV *const _bmrare = MUTABLE_SV(sv); \ - assert(SvTYPE(_bmrare) == SVt_PVGV); \ + assert(SvTYPE(_bmrare) == SVt_PVMG); \ assert(SvVALID(_bmrare)); \ - &(((XPVGV*) SvANY(_bmrare))->xnv_u.xbm_s.xbm_rare); \ + &(((XPVMG*) SvANY(_bmrare))->xnv_u.xbm_s.xbm_rare); \ })) # define BmUSEFUL(sv) \ (*({ SV *const _bmuseful = MUTABLE_SV(sv); \ - assert(SvTYPE(_bmuseful) == SVt_PVGV); \ + assert(SvTYPE(_bmuseful) == SVt_PVMG); \ assert(SvVALID(_bmuseful)); \ assert(!SvIOK(_bmuseful)); \ - &(((XPVGV*) SvANY(_bmuseful))->xiv_u.xivu_i32); \ + &(((XPVMG*) SvANY(_bmuseful))->xnv_u.xbm_s.xbm_useful); \ })) # define BmPREVIOUS(sv) \ (*({ SV *const _bmprevious = MUTABLE_SV(sv); \ - assert(SvTYPE(_bmprevious) == SVt_PVGV); \ + assert(SvTYPE(_bmprevious) == SVt_PVMG); \ assert(SvVALID(_bmprevious)); \ - &(((XPVGV*) SvANY(_bmprevious))->xnv_u.xbm_s.xbm_previous); \ + &(((XPVMG*) SvANY(_bmprevious))->xiv_u.xivu_uv); \ })) #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 BmRARE(sv) ((XPVMG*) SvANY(sv))->xnv_u.xbm_s.xbm_rare +# define BmUSEFUL(sv) ((XPVMG*) SvANY(sv))->xnv_u.xbm_s.xbm_useful +# define BmPREVIOUS(sv) ((XPVMG*) SvANY(sv))->xiv_u.xivu_uv #endif -#define FmLINES(sv) ((XPVFM*) SvANY(sv))->xiv_u.xivu_iv +#define FmLINES(sv) ((XPVFM*) SvANY(sv))->xfm_lines #define LvTYPE(sv) ((XPVLV*) SvANY(sv))->xlv_type #define LvTARG(sv) ((XPVLV*) SvANY(sv))->xlv_targ #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 @@ -1424,6 +1423,9 @@ Returns a pointer to the string in the SV, or a stringified form of the SV if the SV does not contain a string. The SV may cache the stringified form becoming C. Handles 'get' magic. +=for apidoc Am|char*|SvPV_nomg_nolen|SV* sv +Like C but doesn't process magic. + =for apidoc Am|IV|SvIV|SV* sv Coerces the given SV to an integer and returns it. See C for a version which guarantees to evaluate sv only once. @@ -1440,6 +1442,9 @@ otherwise use the more efficient C. Coerce the given SV to a double and return it. See C for a version which guarantees to evaluate sv only once. +=for apidoc Am|NV|SvNV_nomg|SV* sv +Like C 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 only once. Only use this if C is an expression with side effects, @@ -1459,6 +1464,12 @@ otherwise use the more efficient C. =for apidoc Am|bool|SvTRUE|SV* sv Returns a boolean indicating whether Perl would evaluate the SV as true or +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 @@ -1511,6 +1522,9 @@ scalar. =for apidoc Am|void|sv_catpvn_nomg|SV* sv|const char* ptr|STRLEN len Like C but doesn't process magic. +=for apidoc Am|void|sv_catpv_nomg|SV* sv|const char* ptr +Like C but doesn't process magic. + =for apidoc Am|void|sv_setsv_nomg|SV* dsv|SV* ssv Like C but doesn't process magic. @@ -1531,6 +1545,7 @@ Like sv_utf8_upgrade, but doesn't do magic on C #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)) /* ----*/ @@ -1576,6 +1591,10 @@ Like sv_utf8_upgrade, but doesn't do magic on C ((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)) @@ -1652,6 +1671,22 @@ Like sv_utf8_upgrade, but doesn't do magic on C : 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__ */ @@ -1684,11 +1719,26 @@ Like sv_utf8_upgrade, but doesn't do magic on C : 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 SvIsCOW(sv) ((SvFLAGS(sv) & (SVf_FAKE | SVf_READONLY)) == \ - (SVf_FAKE | SVf_READONLY)) +#define SvIsCOW(sv) ((SvFLAGS(sv) & (SVf_FAKE | SVf_READONLY)) == \ + (SVf_FAKE | SVf_READONLY) && !isGV_with_GP(sv)) #define SvIsCOW_shared_hash(sv) (SvIsCOW(sv) && SvLEN(sv) == 0) #define SvSHARED_HEK_FROM_PV(pvx) \ @@ -1714,6 +1764,15 @@ Like sv_utf8_upgrade, but doesn't do magic on C * 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 +/* It is not yet clear whether we want this as an API, or what the + * constants should be named. */ +#ifdef PERL_CORE +# define SV_CATBYTES 16384 +# define SV_CATUTF8 32768 +#endif /* 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. @@ -1776,6 +1835,7 @@ mg.c:1024: warning: left-hand operand of comma expression has no effect #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) @@ -1794,6 +1854,12 @@ mg.c:1024: warning: left-hand operand of comma expression has no effect #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) @@ -1871,12 +1937,12 @@ Returns a pointer to the character buffer. =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 SvDESTROYABLE(sv) CALL_FPTR(PL_destroyhook)(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 SvGETMAGIC(x) ((void)(SvGMAGICAL(x) && mg_get(x))) #define SvSETMAGIC(x) STMT_START { if (SvSMAGICAL(x)) mg_set(x); } STMT_END #define SvSetSV_and(dst,src,finally) \ @@ -1949,6 +2015,8 @@ struct clone_params { AV* stashes; UV flags; PerlInterpreter *proto_perl; + PerlInterpreter *new_perl; + AV *unreferenced; }; /*