X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=sv.h;h=d2113aeda239665c3d15ef1645ec2b87a4d21bfd;hb=8a89745af2209e8e3e9190ec5a357d3a7ebd3898;hp=598397e31cd1bde8e1cff8f81a933b3bc2de7dbe;hpb=88632417a970dff8f92718b0800b1aa1400cb4ae;p=p5sagit%2Fp5-mst-13.2.git diff --git a/sv.h b/sv.h index 598397e..d2113ae 100644 --- a/sv.h +++ b/sv.h @@ -1,6 +1,7 @@ /* sv.h * - * Copyright (c) 1991-2002, Larry Wall + * Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, + * 2000, 2001, 2002, 2003, 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. @@ -125,23 +126,35 @@ perform the upgrade if necessary. See C. #define SvFLAGS(sv) (sv)->sv_flags #define SvREFCNT(sv) (sv)->sv_refcnt -#define ATOMIC_INC(count) (++count) -#define ATOMIC_DEC_AND_TEST(res, count) (res = (--count == 0)) - #if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC) # define SvREFCNT_inc(sv) \ ({ \ SV *nsv = (SV*)(sv); \ if (nsv) \ - ATOMIC_INC(SvREFCNT(nsv)); \ + (SvREFCNT(nsv))++; \ nsv; \ }) #else # define SvREFCNT_inc(sv) \ - ((PL_Sv=(SV*)(sv)), (PL_Sv && ATOMIC_INC(SvREFCNT(PL_Sv))), (SV*)PL_Sv) + ((PL_Sv=(SV*)(sv)), (PL_Sv && ++(SvREFCNT(PL_Sv))), (SV*)PL_Sv) #endif +#if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC) +# define SvREFCNT_dec(sv) \ + ({ \ + SV *nsv = (SV*)(sv); \ + if (nsv) { \ + if (SvREFCNT(nsv)) { \ + if (--(SvREFCNT(nsv)) == 0) \ + Perl_sv_free2(aTHX_ nsv); \ + } else { \ + sv_free(nsv); \ + } \ + } \ + }) +#else #define SvREFCNT_dec(sv) sv_free((SV*)(sv)) +#endif #define SVTYPEMASK 0xff #define SvTYPE(sv) ((sv)->sv_flags & SVTYPEMASK) @@ -261,7 +274,8 @@ struct xpvlv { STRLEN xlv_targoff; STRLEN xlv_targlen; SV* xlv_targ; - char xlv_type; + char xlv_type; /* k=keys .=pos x=substr v=vec /=join/re + * y=alem/helem/iter t=tie T=tied HE */ }; struct xpvgv { @@ -294,7 +308,7 @@ struct xpvbm { U8 xbm_rare; /* rarest character in string */ }; -/* This structure much match XPVCV in cv.h */ +/* This structure must match XPVCV in cv.h */ typedef U16 cv_flags_t; @@ -514,11 +528,19 @@ Set the length of the string which is in the SV. See C. #define SvNIOK_off(sv) (SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK| \ SVp_IOK|SVp_NOK|SVf_IVisUV)) +#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) +#define assert_not_ROK(sv) ({assert(!SvROK(sv) || !SvRV(sv))}), +#else +#define assert_not_ROK(sv) +#endif + #define SvOK(sv) (SvFLAGS(sv) & SVf_OK) -#define SvOK_off(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \ +#define SvOK_off(sv) (assert_not_ROK(sv) \ + SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \ SVf_IVisUV|SVf_UTF8), \ SvOOK_off(sv)) -#define SvOK_off_exc_UV(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \ +#define SvOK_off_exc_UV(sv) (assert_not_ROK(sv) \ + SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \ SVf_UTF8), \ SvOOK_off(sv)) @@ -529,7 +551,8 @@ Set the length of the string which is in the SV. See C. #define SvNOKp(sv) (SvFLAGS(sv) & SVp_NOK) #define SvNOKp_on(sv) (SvFLAGS(sv) |= SVp_NOK) #define SvPOKp(sv) (SvFLAGS(sv) & SVp_POK) -#define SvPOKp_on(sv) (SvFLAGS(sv) |= SVp_POK) +#define SvPOKp_on(sv) (assert_not_ROK(sv) \ + SvFLAGS(sv) |= SVp_POK) #define SvIOK(sv) (SvFLAGS(sv) & SVf_IOK) #define SvIOK_on(sv) (SvRELEASE_IVX(sv), \ @@ -579,12 +602,15 @@ and leaves the UTF8 status as it was. #define SvUTF8_off(sv) (SvFLAGS(sv) &= ~(SVf_UTF8)) #define SvPOK(sv) (SvFLAGS(sv) & SVf_POK) -#define SvPOK_on(sv) (SvFLAGS(sv) |= (SVf_POK|SVp_POK)) +#define SvPOK_on(sv) (assert_not_ROK(sv) \ + SvFLAGS(sv) |= (SVf_POK|SVp_POK)) #define SvPOK_off(sv) (SvFLAGS(sv) &= ~(SVf_POK|SVp_POK)) -#define SvPOK_only(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \ +#define SvPOK_only(sv) (assert_not_ROK(sv) \ + SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \ SVf_IVisUV|SVf_UTF8), \ SvFLAGS(sv) |= (SVf_POK|SVp_POK)) -#define SvPOK_only_UTF8(sv) (SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \ +#define SvPOK_only_UTF8(sv) (assert_not_ROK(sv) \ + SvFLAGS(sv) &= ~(SVf_OK|SVf_AMAGIC| \ SVf_IVisUV), \ SvFLAGS(sv) |= (SVf_POK|SVp_POK)) @@ -762,14 +788,16 @@ and leaves the UTF8 status as it was. #define IoFLAGS(sv) ((XPVIO*) SvANY(sv))->xio_flags /* IoTYPE(sv) is a single character telling the type of I/O connection. */ -#define IoTYPE_RDONLY '<' -#define IoTYPE_WRONLY '>' -#define IoTYPE_RDWR '+' -#define IoTYPE_APPEND 'a' -#define IoTYPE_PIPE '|' -#define IoTYPE_STD '-' /* stdin or stdout */ -#define IoTYPE_SOCKET 's' -#define IoTYPE_CLOSED ' ' +#define IoTYPE_RDONLY '<' +#define IoTYPE_WRONLY '>' +#define IoTYPE_RDWR '+' +#define IoTYPE_APPEND 'a' +#define IoTYPE_PIPE '|' +#define IoTYPE_STD '-' /* stdin or stdout */ +#define IoTYPE_SOCKET 's' +#define IoTYPE_CLOSED ' ' +#define IoTYPE_IMPLICIT 'I' /* stdin or stdout or stderr */ +#define IoTYPE_NUMERIC '#' /* fdopen */ /* =for apidoc Am|bool|SvTAINTED|SV* sv @@ -777,7 +805,7 @@ Checks to see if an SV is tainted. Returns TRUE if it is, FALSE if not. =for apidoc Am|void|SvTAINTED_on|SV* sv -Marks an SV as tainted. +Marks an SV as tainted if tainting is enabled. =for apidoc Am|void|SvTAINTED_off|SV* sv Untaints an SV. Be I careful with this routine, as it short-circuits @@ -788,7 +816,7 @@ standard perl fashion, via a carefully crafted regexp, rather than directly untainting variables. =for apidoc Am|void|SvTAINT|SV* sv -Taints an SV if tainting is enabled +Taints an SV if tainting is enabled. =cut */ @@ -896,6 +924,14 @@ Like C, but converts sv to byte representation first if necessary. Guarantees to evaluate sv only once; use the more efficient C otherwise. +=for apidoc Am|bool|SvIsCOW|SV* sv +Returns a boolean indicating whether the SV is Copy-On-Write. (either shared +hash key scalars, or full Copy On Write scalars if 5.9.0 is configured for +COW) + +=for apidoc Am|bool|SvIsCOW_shared_hash|SV* sv +Returns a boolean indicating whether the SV is Copy-On-Write shared hash key +scalar. =cut */ @@ -967,7 +1003,7 @@ otherwise. #define SvPVutf8x_force(sv, lp) sv_pvutf8n_force(sv, &lp) #define SvPVbytex_force(sv, lp) sv_pvbyten_force(sv, &lp) -#if defined(__GNUC__) && !defined(__STRICT_ANSI__) && !defined(PERL_GCC_PEDANTIC) +#if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN) # define SvIVx(sv) ({SV *nsv = (SV*)(sv); SvIV(nsv); }) # define SvUVx(sv) ({SV *nsv = (SV*)(sv); SvUV(nsv); }) @@ -1043,8 +1079,14 @@ otherwise. #ifdef PERL_COPY_ON_WRITE # define SvRELEASE_IVX(sv) ((void)((SvFLAGS(sv) & (SVf_OOK|SVf_READONLY|SVf_FAKE)) \ - && sv_release_IVX(sv))) + && Perl_sv_release_IVX(aTHX_ sv))) # define SvIsCOW_normal(sv) (SvIsCOW(sv) && SvLEN(sv)) + +#define CAN_COW_MASK (SVs_OBJECT|SVs_GMG|SVs_SMG|SVs_RMG|SVf_IOK|SVf_NOK| \ + SVf_POK|SVf_ROK|SVp_IOK|SVp_NOK|SVp_POK|SVf_FAKE| \ + SVf_OOK|SVf_BREAK|SVf_READONLY|SVf_AMAGIC) +#define CAN_COW_FLAGS (SVp_POK|SVf_POK) + #else # define SvRELEASE_IVX(sv) ((void)SvOOK_off(sv)) #endif /* PERL_COPY_ON_WRITE */ @@ -1072,6 +1114,17 @@ otherwise. #define sv_pvn_force(sv, lp) sv_pvn_force_flags(sv, lp, SV_GMAGIC) #define sv_utf8_upgrade(sv) sv_utf8_upgrade_flags(sv, 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)); \ + else \ + sv_setpvn(nsv, sstr, slen); \ + SvUTF8_off(nsv); \ + sv_utf8_upgrade(nsv); \ + sv_catsv(dsv, nsv); \ + } STMT_END /* =for apidoc Am|SV*|newRV_inc|SV* sv @@ -1169,13 +1222,14 @@ Returns a pointer to the character buffer. #define SvSetMagicSV_nosteal(dst,src) \ SvSetSV_nosteal_and(dst,src,SvSETMAGIC(dst)) + #if !defined(SKIP_DEBUGGING) #define SvPEEK(sv) sv_peek(sv) #else #define SvPEEK(sv) "" #endif -#define SvIMMORTAL(sv) ((sv)==&PL_sv_undef || (sv)==&PL_sv_yes || (sv)==&PL_sv_no) +#define SvIMMORTAL(sv) ((sv)==&PL_sv_undef || (sv)==&PL_sv_yes || (sv)==&PL_sv_no || (sv)==&PL_sv_placeholder) #define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)