X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/c951e2ad069531f80b857752d3795306ce8bba2d..21cde1537b3d89a793747da1f64a6483ed196b36:/sv.h diff --git a/sv.h b/sv.h index 9c6dfd8..5f58935 100644 --- a/sv.h +++ b/sv.h @@ -106,6 +106,7 @@ typedef struct hek HEK; SV** svu_array; \ HE** svu_hash; \ GP* svu_gp; \ + PerlIO *svu_fp; \ } sv_u @@ -115,10 +116,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 }; @@ -366,8 +367,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 */ @@ -377,18 +391,15 @@ 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 */ @@ -408,8 +419,7 @@ 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 */ }; @@ -417,7 +427,6 @@ union _xnvu { union _xivu { IV xivu_iv; /* integer value */ UV xivu_uv; - I32 xivu_i32; /* BmUSEFUL */ HEK * xivu_namehek; /* xpvlv, xpvgv: GvNAME */ }; @@ -509,8 +518,8 @@ struct xpvfm { struct xpvio { _XPV_HEAD; union _xivu xiv_u; - PerlIO * xio_ifp; /* ifp and ofp are normally the same */ - PerlIO * xio_ofp; /* but sockets need separate streams */ + /* 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 @@ -547,7 +556,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. */ @@ -921,9 +931,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) @@ -1001,9 +1013,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 @@ -1043,6 +1052,8 @@ the scalar's value cannot change unless written to. 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) \ @@ -1051,6 +1062,8 @@ the scalar's value cannot change unless written to. 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) \ @@ -1097,6 +1110,8 @@ the scalar's value cannot change unless written to. 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) \ @@ -1107,6 +1122,8 @@ the scalar's value cannot change unless written to. 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) \ @@ -1182,6 +1199,8 @@ the scalar's value cannot change unless written to. 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); \ @@ -1197,6 +1216,8 @@ the scalar's value cannot change unless written to. 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); \ @@ -1209,12 +1230,16 @@ the scalar's value cannot change unless written to. 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); \ @@ -1262,42 +1287,38 @@ 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 @@ -1308,7 +1329,7 @@ the scalar's value cannot change unless written to. #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 @@ -1403,6 +1424,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. @@ -1441,6 +1465,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 @@ -1493,6 +1523,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. @@ -1559,6 +1592,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)) @@ -1635,6 +1672,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__ */ @@ -1667,6 +1720,21 @@ 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__ */ @@ -1762,6 +1830,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) @@ -1781,6 +1850,11 @@ mg.c:1024: warning: left-hand operand of comma expression has no effect #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) @@ -1858,10 +1932,10 @@ 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 SvSETMAGIC(x) STMT_START { if (SvSMAGICAL(x)) mg_set(x); } STMT_END