sv.h

   1 /*    sv.h
   2  *
   3  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
   4  *    2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall and others
   5  *
   6  *    You may distribute under the terms of either the GNU General Public
   7  *    License or the Artistic License, as specified in the README file.
   8  *
   9  */
  10
  11 #ifdef sv_flags
  12 #undef sv_flags         /* Convex has this in <signal.h> for sigvec() */
  13 #endif
  14
  15 /*
  16 =head1 SV Flags
  17
  18 =for apidoc AmU||svtype
  19 An enum of flags for Perl types.  These are found in the file B<sv.h>
  20 in the C<svtype> enum.  Test these flags with the C<SvTYPE> macro.
  21
  22 =for apidoc AmU||SVt_PV
  23 Pointer type flag for scalars.  See C<svtype>.
  24
  25 =for apidoc AmU||SVt_IV
  26 Integer type flag for scalars.  See C<svtype>.
  27
  28 =for apidoc AmU||SVt_NV
  29 Double type flag for scalars.  See C<svtype>.
  30
  31 =for apidoc AmU||SVt_PVMG
  32 Type flag for blessed scalars.  See C<svtype>.
  33
  34 =for apidoc AmU||SVt_PVAV
  35 Type flag for arrays.  See C<svtype>.
  36
  37 =for apidoc AmU||SVt_PVHV
  38 Type flag for hashes.  See C<svtype>.
  39
  40 =for apidoc AmU||SVt_PVCV
  41 Type flag for code refs.  See C<svtype>.
  42
  43 =cut
  44 */
  45
  46 typedef enum {
  47         SVt_NULL,       /* 0 */
  48         SVt_BIND,       /* 1 */
  49         SVt_IV,         /* 2 */
  50         SVt_NV,         /* 3 */
  51         /* RV was here, before it was merged with IV.  */
  52         SVt_PV,         /* 4 */
  53         SVt_PVIV,       /* 5 */
  54         SVt_PVNV,       /* 6 */
  55         SVt_PVMG,       /* 7 */
  56         SVt_REGEXP,     /* 8 */
  57         /* PVBM was here, before BIND replaced it.  */
  58         SVt_PVGV,       /* 9 */
  59         SVt_PVLV,       /* 10 */
  60         SVt_PVAV,       /* 11 */
  61         SVt_PVHV,       /* 12 */
  62         SVt_PVCV,       /* 13 */
  63         SVt_PVFM,       /* 14 */
  64         SVt_PVIO,       /* 15 */
  65         SVt_LAST        /* keep last in enum. used to size arrays */
  66 } svtype;
  67
  68 #ifndef PERL_CORE
  69 /* Although Fast Boyer Moore tables are now being stored in PVGVs, for most
  70    purposes eternal code wanting to consider PVBM probably needs to think of
  71    PVMG instead.  */
  72 #  define SVt_PVBM      SVt_PVMG
  73 /* Anything wanting to create a reference from clean should ensure that it has
  74    a scalar of type SVt_IV now:  */
  75 #  define SVt_RV        SVt_IV
  76 #endif
  77
  78 /* There is collusion here with sv_clear - sv_clear exits early for SVt_NULL
  79    and SVt_IV, so never reaches the clause at the end that uses
  80    sv_type_details->body_size to determine whether to call safefree(). Hence
  81    body_size can be set no-zero to record the size of PTEs and HEs, without
  82    fear of bogus frees.  */
  83 #ifdef PERL_IN_SV_C
  84 #define PTE_SVSLOT      SVt_IV
  85 #endif
  86 #if defined(PERL_IN_HV_C) || defined(PERL_IN_XS_APITEST)
  87 #define HE_SVSLOT       SVt_NULL
  88 #endif
  89
  90 #define PERL_ARENA_ROOTS_SIZE   (SVt_LAST)
  91
  92 /* typedefs to eliminate some typing */
  93 typedef struct he HE;
  94 typedef struct hek HEK;
  95
  96 /* Using C's structural equivalence to help emulate C++ inheritance here... */
  97
  98 /* start with 2 sv-head building blocks */
  99 #define _SV_HEAD(ptrtype) \
 100     ptrtype     sv_any;         /* pointer to body */   \
 101     U32         sv_refcnt;      /* how many references to us */ \
 102     U32         sv_flags        /* what we are */
 103
 104 #define _SV_HEAD_UNION \
 105     union {                             \
 106         IV      svu_iv;                 \
 107         UV      svu_uv;                 \
 108         SV*     svu_rv;         /* pointer to another SV */             \
 109         char*   svu_pv;         /* pointer to malloced string */        \
 110         SV**    svu_array;              \
 111         HE**    svu_hash;               \
 112         GP*     svu_gp;                 \
 113     }   sv_u
 114
 115
 116 struct STRUCT_SV {              /* struct sv { */
 117     _SV_HEAD(void*);
 118     _SV_HEAD_UNION;
 119 #ifdef DEBUG_LEAKING_SCALARS
 120     PERL_BITFIELD32 sv_debug_optype:9;  /* the type of OP that allocated us */
 121     PERL_BITFIELD32 sv_debug_inpad:1;   /* was allocated in a pad for an OP */
 122     PERL_BITFIELD32 sv_debug_cloned:1;  /* was cloned for an ithread */
 123     PERL_BITFIELD32 sv_debug_line:16;   /* the line where we were allocated */
 124     U32             sv_debug_serial;    /* serial number of sv allocation   */
 125     char *      sv_debug_file;          /* the file where we were allocated */
 126 #endif
 127 };
 128
 129 struct gv {
 130     _SV_HEAD(XPVGV*);           /* pointer to xpvgv body */
 131     _SV_HEAD_UNION;
 132 };
 133
 134 struct cv {
 135     _SV_HEAD(XPVCV*);           /* pointer to xpvcv body */
 136     _SV_HEAD_UNION;
 137 };
 138
 139 struct av {
 140     _SV_HEAD(XPVAV*);           /* pointer to xpvav body */
 141     _SV_HEAD_UNION;
 142 };
 143
 144 struct hv {
 145     _SV_HEAD(XPVHV*);           /* pointer to xpvhv body */
 146     _SV_HEAD_UNION;
 147 };
 148
 149 struct io {
 150     _SV_HEAD(XPVIO*);           /* pointer to xpvio body */
 151     _SV_HEAD_UNION;
 152 };
 153
 154 struct p5rx {
 155     _SV_HEAD(struct regexp*);   /* pointer to regexp body */
 156     _SV_HEAD_UNION;
 157 };
 158
 159 #undef _SV_HEAD
 160 #undef _SV_HEAD_UNION           /* ensure no pollution */
 161
 162 /*
 163 =head1 SV Manipulation Functions
 164
 165 =for apidoc Am|U32|SvREFCNT|SV* sv
 166 Returns the value of the object's reference count.
 167
 168 =for apidoc Am|SV*|SvREFCNT_inc|SV* sv
 169 Increments the reference count of the given SV.
 170
 171 All of the following SvREFCNT_inc* macros are optimized versions of
 172 SvREFCNT_inc, and can be replaced with SvREFCNT_inc.
 173
 174 =for apidoc Am|SV*|SvREFCNT_inc_NN|SV* sv
 175 Same as SvREFCNT_inc, but can only be used if you know I<sv>
 176 is not NULL.  Since we don't have to check the NULLness, it's faster
 177 and smaller.
 178
 179 =for apidoc Am|void|SvREFCNT_inc_void|SV* sv
 180 Same as SvREFCNT_inc, but can only be used if you don't need the
 181 return value.  The macro doesn't need to return a meaningful value.
 182
 183 =for apidoc Am|void|SvREFCNT_inc_void_NN|SV* sv
 184 Same as SvREFCNT_inc, but can only be used if you don't need the return
 185 value, and you know that I<sv> is not NULL.  The macro doesn't need
 186 to return a meaningful value, or check for NULLness, so it's smaller
 187 and faster.
 188
 189 =for apidoc Am|SV*|SvREFCNT_inc_simple|SV* sv
 190 Same as SvREFCNT_inc, but can only be used with expressions without side
 191 effects.  Since we don't have to store a temporary value, it's faster.
 192
 193 =for apidoc Am|SV*|SvREFCNT_inc_simple_NN|SV* sv
 194 Same as SvREFCNT_inc_simple, but can only be used if you know I<sv>
 195 is not NULL.  Since we don't have to check the NULLness, it's faster
 196 and smaller.
 197
 198 =for apidoc Am|void|SvREFCNT_inc_simple_void|SV* sv
 199 Same as SvREFCNT_inc_simple, but can only be used if you don't need the
 200 return value.  The macro doesn't need to return a meaningful value.
 201
 202 =for apidoc Am|void|SvREFCNT_inc_simple_void_NN|SV* sv
 203 Same as SvREFCNT_inc, but can only be used if you don't need the return
 204 value, and you know that I<sv> is not NULL.  The macro doesn't need
 205 to return a meaningful value, or check for NULLness, so it's smaller
 206 and faster.
 207
 208 =for apidoc Am|void|SvREFCNT_dec|SV* sv
 209 Decrements the reference count of the given SV.
 210
 211 =for apidoc Am|svtype|SvTYPE|SV* sv
 212 Returns the type of the SV.  See C<svtype>.
 213
 214 =for apidoc Am|void|SvUPGRADE|SV* sv|svtype type
 215 Used to upgrade an SV to a more complex form.  Uses C<sv_upgrade> to
 216 perform the upgrade if necessary.  See C<svtype>.
 217
 218 =cut
 219 */
 220
 221 #define SvANY(sv)       (sv)->sv_any
 222 #define SvFLAGS(sv)     (sv)->sv_flags
 223 #define SvREFCNT(sv)    (sv)->sv_refcnt
 224
 225 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
 226 #  define SvREFCNT_inc(sv)              \
 227     ({                                  \
 228         SV * const _sv = MUTABLE_SV(sv);        \
 229         if (_sv)                        \
 230              (SvREFCNT(_sv))++;         \
 231         _sv;                            \
 232     })
 233 #  define SvREFCNT_inc_simple(sv)       \
 234     ({                                  \
 235         if (sv)                         \
 236              (SvREFCNT(sv))++;          \
 237         MUTABLE_SV(sv);                         \
 238     })
 239 #  define SvREFCNT_inc_NN(sv)           \
 240     ({                                  \
 241         SV * const _sv = MUTABLE_SV(sv);        \
 242         SvREFCNT(_sv)++;                \
 243         _sv;                            \
 244     })
 245 #  define SvREFCNT_inc_void(sv)         \
 246     ({                                  \
 247         SV * const _sv = MUTABLE_SV(sv);        \
 248         if (_sv)                        \
 249             (void)(SvREFCNT(_sv)++);    \
 250     })
 251 #else
 252 #  define SvREFCNT_inc(sv)      \
 253         ((PL_Sv=MUTABLE_SV(sv)) ? (++(SvREFCNT(PL_Sv)),PL_Sv) : NULL)
 254 #  define SvREFCNT_inc_simple(sv) \
 255         ((sv) ? (SvREFCNT(sv)++,MUTABLE_SV(sv)) : NULL)
 256 #  define SvREFCNT_inc_NN(sv) \
 257         (PL_Sv=MUTABLE_SV(sv),++(SvREFCNT(PL_Sv)),PL_Sv)
 258 #  define SvREFCNT_inc_void(sv) \
 259         (void)((PL_Sv=MUTABLE_SV(sv)) ? ++(SvREFCNT(PL_Sv)) : 0)
 260 #endif
 261
 262 /* These guys don't need the curly blocks */
 263 #define SvREFCNT_inc_simple_void(sv)    STMT_START { if (sv) SvREFCNT(sv)++; } STMT_END
 264 #define SvREFCNT_inc_simple_NN(sv)      (++(SvREFCNT(sv)),MUTABLE_SV(sv))
 265 #define SvREFCNT_inc_void_NN(sv)        (void)(++SvREFCNT(MUTABLE_SV(sv)))
 266 #define SvREFCNT_inc_simple_void_NN(sv) (void)(++SvREFCNT(MUTABLE_SV(sv)))
 267
 268 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
 269 #  define SvREFCNT_dec(sv)              \
 270     ({                                  \
 271         SV * const _sv = MUTABLE_SV(sv);        \
 272         if (_sv) {                      \
 273             if (SvREFCNT(_sv)) {        \
 274                 if (--(SvREFCNT(_sv)) == 0) \
 275                     Perl_sv_free2(aTHX_ _sv);   \
 276             } else {                    \
 277                 sv_free(_sv);           \
 278             }                           \
 279         }                               \
 280     })
 281 #else
 282 #define SvREFCNT_dec(sv)        sv_free(MUTABLE_SV(sv))
 283 #endif
 284
 285 #define SVTYPEMASK      0xff
 286 #define SvTYPE(sv)      ((svtype)((sv)->sv_flags & SVTYPEMASK))
 287
 288 /* Sadly there are some parts of the core that have pointers to already-freed
 289    SV heads, and rely on being able to tell that they are now free. So mark
 290    them all by using a consistent macro.  */
 291 #define SvIS_FREED(sv)  ((sv)->sv_flags == SVTYPEMASK)
 292
 293 #define SvUPGRADE(sv, mt) (SvTYPE(sv) >= (mt) || (sv_upgrade(sv, mt), 1))
 294
 295 #define SVf_IOK         0x00000100  /* has valid public integer value */
 296 #define SVf_NOK         0x00000200  /* has valid public numeric value */
 297 #define SVf_POK         0x00000400  /* has valid public pointer value */
 298 #define SVf_ROK         0x00000800  /* has a valid reference pointer */
 299
 300 #define SVp_IOK         0x00001000  /* has valid non-public integer value */
 301 #define SVp_NOK         0x00002000  /* has valid non-public numeric value */
 302 #define SVp_POK         0x00004000  /* has valid non-public pointer value */
 303 #define SVp_SCREAM      0x00008000  /* has been studied? */
 304 #define SVphv_CLONEABLE SVp_SCREAM  /* PVHV (stashes) clone its objects */
 305 #define SVpgv_GP        SVp_SCREAM  /* GV has a valid GP */
 306 #define SVprv_PCS_IMPORTED  SVp_SCREAM  /* RV is a proxy for a constant
 307                                        subroutine in another package. Set the
 308                                        CvIMPORTED_CV_ON() if it needs to be
 309                                        expanded to a real GV */
 310
 311 #define SVs_PADSTALE    0x00010000  /* lexical has gone out of scope */
 312 #define SVpad_STATE     0x00010000  /* pad name is a "state" var */
 313 #define SVs_PADTMP      0x00020000  /* in use as tmp */
 314 #define SVpad_TYPED     0x00020000  /* pad name is a Typed Lexical */
 315 #define SVs_PADMY       0x00040000  /* in use a "my" variable */
 316 #define SVpad_OUR       0x00040000  /* pad name is "our" instead of "my" */
 317 #define SVs_TEMP        0x00080000  /* string is stealable? */
 318 #define SVs_OBJECT      0x00100000  /* is "blessed" */
 319 #define SVs_GMG         0x00200000  /* has magical get method */
 320 #define SVs_SMG         0x00400000  /* has magical set method */
 321 #define SVs_RMG         0x00800000  /* has random magical methods */
 322
 323 #define SVf_FAKE        0x01000000  /* 0: glob or lexical is just a copy
 324                                        1: SV head arena wasn't malloc()ed
 325                                        2: in conjunction with SVf_READONLY
 326                                           marks a shared hash key scalar
 327                                           (SvLEN == 0) or a copy on write
 328                                           string (SvLEN != 0) [SvIsCOW(sv)]
 329                                        3: For PVCV, whether CvUNIQUE(cv)
 330                                           refers to an eval or once only
 331                                           [CvEVAL(cv), CvSPECIAL(cv)]
 332                                        4: On a pad name SV, that slot in the
 333                                           frame AV is a REFCNT'ed reference
 334                                           to a lexical from "outside". */
 335 #define SVphv_REHASH    SVf_FAKE    /* 5: On a PVHV, hash values are being
 336                                           recalculated */
 337 #define SVf_OOK         0x02000000  /* has valid offset value. For a PVHV this
 338                                        means that a hv_aux struct is present
 339                                        after the main array */
 340 #define SVf_BREAK       0x04000000  /* refcnt is artificially low - used by
 341                                        SVs in final arena cleanup.
 342                                        Set in S_regtry on PL_reg_curpm, so that
 343                                        perl_destruct will skip it. */
 344 #define SVf_READONLY    0x08000000  /* may not be modified */
 345
 346
 347
 348
 349 #define SVf_THINKFIRST  (SVf_READONLY|SVf_ROK|SVf_FAKE)
 350
 351 #define SVf_OK          (SVf_IOK|SVf_NOK|SVf_POK|SVf_ROK| \
 352                          SVp_IOK|SVp_NOK|SVp_POK|SVpgv_GP)
 353
 354 #define PRIVSHIFT 4     /* (SVp_?OK >> PRIVSHIFT) == SVf_?OK */
 355
 356 #define SVf_AMAGIC      0x10000000  /* has magical overloaded methods */
 357
 358 /* Ensure this value does not clash with the GV_ADD* flags in gv.h: */
 359 #define SVf_UTF8        0x20000000  /* SvPV is UTF-8 encoded
 360                                        This is also set on RVs whose overloaded
 361                                        stringification is UTF-8. This might
 362                                        only happen as a side effect of SvPV() */
 363
 364
 365 /* Some private flags. */
 366
 367 /* PVAV could probably use 0x2000000 without conflict. I assume that PVFM can
 368    be UTF-8 encoded, and PVCVs could well have UTF-8 prototypes. PVIOs haven't
 369    been restructured, so sometimes get used as string buffers.  */
 370
 371 /* PVHV */
 372 #define SVphv_SHAREKEYS 0x20000000  /* PVHV keys live on shared string table */
 373 /* PVNV, PVMG, presumably only inside pads */
 374 #define SVpad_NAME      0x40000000  /* This SV is a name in the PAD, so
 375                                        SVpad_TYPED, SVpad_OUR and SVpad_STATE
 376                                        apply */
 377 /* PVAV */
 378 #define SVpav_REAL      0x40000000  /* free old entries */
 379 /* PVHV */
 380 #define SVphv_LAZYDEL   0x40000000  /* entry in xhv_eiter must be deleted */
 381 /* This is only set true on a PVGV when it's playing "PVBM", but is tested for
 382    on any regular scalar (anything <= PVLV) */
 383 #define SVpbm_VALID     0x40000000
 384 /* ??? */
 385 #define SVrepl_EVAL     0x40000000  /* Replacement part of s///e */
 386
 387 /* IV, PVIV, PVNV, PVMG, PVGV and (I assume) PVLV  */
 388 /* Presumably IVs aren't stored in pads */
 389 #define SVf_IVisUV      0x80000000  /* use XPVUV instead of XPVIV */
 390 /* PVAV */
 391 #define SVpav_REIFY     0x80000000  /* can become real */
 392 /* PVHV */
 393 #define SVphv_HASKFLAGS 0x80000000  /* keys have flag byte after hash */
 394 /* PVFM */
 395 #define SVpfm_COMPILED  0x80000000  /* FORMLINE is compiled */
 396 /* PVGV when SVpbm_VALID is true */
 397 #define SVpbm_TAIL      0x80000000
 398 /* RV upwards. However, SVf_ROK and SVp_IOK are exclusive  */
 399 #define SVprv_WEAKREF   0x80000000  /* Weak reference */
 400
 401 #define _XPV_ALLOCATED_HEAD                                             \
 402     STRLEN      xpv_cur;        /* length of svu_pv as a C string */    \
 403     STRLEN      xpv_len         /* allocated size */
 404
 405 #define _XPV_HEAD       \
 406     union _xnvu xnv_u;  \
 407     _XPV_ALLOCATED_HEAD
 408
 409 union _xnvu {
 410     NV      xnv_nv;             /* numeric value, if any */
 411     HV *    xgv_stash;
 412     struct {
 413         U32 xlow;
 414         U32 xhigh;
 415     }       xpad_cop_seq;       /* used by pad.c for cop_sequence */
 416     struct {
 417         U32 xbm_previous;       /* how many characters in string before rare? */
 418         U8  xbm_flags;
 419         U8  xbm_rare;           /* rarest character in string */
 420     }       xbm_s;              /* fields from PVBM */
 421 };
 422
 423 union _xivu {
 424     IV      xivu_iv;            /* integer value */
 425                                 /* xpvfm: lines */
 426     UV      xivu_uv;
 427     void *  xivu_p1;
 428     I32     xivu_i32;
 429     HEK *   xivu_namehek;       /* xpvlv, xpvgv: GvNAME */
 430     HV *    xivu_hv;            /* regexp: paren_names */
 431 };
 432
 433 union _xmgu {
 434     MAGIC*  xmg_magic;          /* linked list of magicalness */
 435     HV*     xmg_ourstash;       /* Stash for our (when SvPAD_OUR is true) */
 436 };
 437
 438 struct xpv {
 439     _XPV_HEAD;
 440 };
 441
 442 typedef struct {
 443     _XPV_ALLOCATED_HEAD;
 444 } xpv_allocated;
 445
 446 struct xpviv {
 447     _XPV_HEAD;
 448     union _xivu xiv_u;
 449 };
 450
 451 typedef struct {
 452     _XPV_ALLOCATED_HEAD;
 453     union _xivu xiv_u;
 454 } xpviv_allocated;
 455
 456 #define xiv_iv xiv_u.xivu_iv
 457
 458 struct xpvuv {
 459     _XPV_HEAD;
 460     union _xivu xuv_u;
 461 };
 462
 463 #define xuv_uv xuv_u.xivu_uv
 464
 465 struct xpvnv {
 466     _XPV_HEAD;
 467     union _xivu xiv_u;
 468 };
 469
 470 #define _XPVMG_HEAD                                 \
 471     union _xivu xiv_u;                              \
 472     union _xmgu xmg_u;                              \
 473     HV*         xmg_stash       /* class package */
 474
 475 /* These structure must match the beginning of struct xpvhv in hv.h. */
 476 struct xpvmg {
 477     _XPV_HEAD;
 478     _XPVMG_HEAD;
 479 };
 480
 481 struct xpvlv {
 482     _XPV_HEAD;
 483     _XPVMG_HEAD;
 484
 485     STRLEN      xlv_targoff;
 486     STRLEN      xlv_targlen;
 487     SV*         xlv_targ;
 488     char        xlv_type;       /* k=keys .=pos x=substr v=vec /=join/re
 489                                  * y=alem/helem/iter t=tie T=tied HE */
 490 };
 491
 492 /* This structure works in 3 ways - regular scalar, GV with GP, or fast
 493    Boyer-Moore.  */
 494 struct xpvgv {
 495     _XPV_HEAD;
 496     _XPVMG_HEAD;
 497 };
 498
 499 /* This structure must match XPVCV in cv.h */
 500
 501 typedef U16 cv_flags_t;
 502
 503 #define _XPVCV_COMMON                                                           \
 504     HV *        xcv_stash;                                                      \
 505     union {                                                                     \
 506         OP *    xcv_start;                                                      \
 507         ANY     xcv_xsubany;                                                    \
 508     }           xcv_start_u;                                                    \
 509     union {                                                                     \
 510         OP *    xcv_root;                                                       \
 511         void    (*xcv_xsub) (pTHX_ CV*);                                        \
 512     }           xcv_root_u;                                                     \
 513     GV *        xcv_gv;                                                         \
 514     char *      xcv_file;                                                       \
 515     AV *        xcv_padlist;                                                    \
 516     CV *        xcv_outside;                                                    \
 517     U32         xcv_outside_seq; /* the COP sequence (at the point of our       \
 518                                   * compilation) in the lexically enclosing     \
 519                                   * sub */                                      \
 520     cv_flags_t  xcv_flags
 521
 522 struct xpvfm {
 523     _XPV_HEAD;
 524     _XPVMG_HEAD;
 525     _XPVCV_COMMON;
 526 };
 527
 528 typedef struct {
 529     _XPV_ALLOCATED_HEAD;
 530     _XPVMG_HEAD;
 531     _XPVCV_COMMON;
 532 } xpvfm_allocated;
 533
 534 #define _XPVIO_TAIL                                                     \
 535     PerlIO *    xio_ifp;        /* ifp and ofp are normally the same */ \
 536     PerlIO *    xio_ofp;        /* but sockets need separate streams */ \
 537     /* Cray addresses everything by word boundaries (64 bits) and       \
 538      * code and data pointers cannot be mixed (which is exactly what    \
 539      * Perl_filter_add() tries to do with the dirp), hence the          \
 540      *  following union trick (as suggested by Gurusamy Sarathy).       \
 541      * For further information see Geir Johansen's problem report       \
 542      * titled [ID 20000612.002] Perl problem on Cray system             \
 543      * The any pointer (known as IoANY()) will also be a good place     \
 544      * to hang any IO disciplines to.                                   \
 545      */                                                                 \
 546     union {                                                             \
 547         DIR *   xiou_dirp;      /* for opendir, readdir, etc */         \
 548         void *  xiou_any;       /* for alignment */                     \
 549     } xio_dirpu;                                                        \
 550     IV          xio_lines;      /* $. */                                \
 551     IV          xio_page;       /* $% */                                \
 552     IV          xio_page_len;   /* $= */                                \
 553     IV          xio_lines_left; /* $- */                                \
 554     char *      xio_top_name;   /* $^ */                                \
 555     GV *        xio_top_gv;     /* $^ */                                \
 556     char *      xio_fmt_name;   /* $~ */                                \
 557     GV *        xio_fmt_gv;     /* $~ */                                \
 558     char *      xio_bottom_name;/* $^B */                               \
 559     GV *        xio_bottom_gv;  /* $^B */                               \
 560     char        xio_type;                                               \
 561     U8          xio_flags
 562
 563
 564 struct xpvio {
 565     _XPV_HEAD;
 566     _XPVMG_HEAD;
 567     _XPVIO_TAIL;
 568 };
 569
 570 #define xio_dirp        xio_dirpu.xiou_dirp
 571 #define xio_any         xio_dirpu.xiou_any
 572
 573 #define IOf_ARGV        1       /* this fp iterates over ARGV */
 574 #define IOf_START       2       /* check for null ARGV and substitute '-' */
 575 #define IOf_FLUSH       4       /* this fp wants a flush after write op */
 576 #define IOf_DIDTOP      8       /* just did top of form */
 577 #define IOf_UNTAINT     16      /* consider this fp (and its data) "safe" */
 578 #define IOf_NOLINE      32      /* slurped a pseudo-line from empty file */
 579 #define IOf_FAKE_DIRP   64      /* xio_dirp is fake (source filters kludge) */
 580
 581 /* The following macros define implementation-independent predicates on SVs. */
 582
 583 /*
 584 =for apidoc Am|U32|SvNIOK|SV* sv
 585 Returns a U32 value indicating whether the SV contains a number, integer or
 586 double.
 587
 588 =for apidoc Am|U32|SvNIOKp|SV* sv
 589 Returns a U32 value indicating whether the SV contains a number, integer or
 590 double.  Checks the B<private> setting.  Use C<SvNIOK> instead.
 591
 592 =for apidoc Am|void|SvNIOK_off|SV* sv
 593 Unsets the NV/IV status of an SV.
 594
 595 =for apidoc Am|U32|SvOK|SV* sv
 596 Returns a U32 value indicating whether the value is defined. This is
 597 only meaningful for scalars.
 598
 599 =for apidoc Am|U32|SvIOKp|SV* sv
 600 Returns a U32 value indicating whether the SV contains an integer.  Checks
 601 the B<private> setting.  Use C<SvIOK> instead.
 602
 603 =for apidoc Am|U32|SvNOKp|SV* sv
 604 Returns a U32 value indicating whether the SV contains a double.  Checks the
 605 B<private> setting.  Use C<SvNOK> instead.
 606
 607 =for apidoc Am|U32|SvPOKp|SV* sv
 608 Returns a U32 value indicating whether the SV contains a character string.
 609 Checks the B<private> setting.  Use C<SvPOK> instead.
 610
 611 =for apidoc Am|U32|SvIOK|SV* sv
 612 Returns a U32 value indicating whether the SV contains an integer.
 613
 614 =for apidoc Am|void|SvIOK_on|SV* sv
 615 Tells an SV that it is an integer.
 616
 617 =for apidoc Am|void|SvIOK_off|SV* sv
 618 Unsets the IV status of an SV.
 619
 620 =for apidoc Am|void|SvIOK_only|SV* sv
 621 Tells an SV that it is an integer and disables all other OK bits.
 622
 623 =for apidoc Am|void|SvIOK_only_UV|SV* sv
 624 Tells and SV that it is an unsigned integer and disables all other OK bits.
 625
 626 =for apidoc Am|bool|SvIOK_UV|SV* sv
 627 Returns a boolean indicating whether the SV contains an unsigned integer.
 628
 629 =for apidoc Am|bool|SvUOK|SV* sv
 630 Returns a boolean indicating whether the SV contains an unsigned integer.
 631
 632 =for apidoc Am|bool|SvIOK_notUV|SV* sv
 633 Returns a boolean indicating whether the SV contains a signed integer.
 634
 635 =for apidoc Am|U32|SvNOK|SV* sv
 636 Returns a U32 value indicating whether the SV contains a double.
 637
 638 =for apidoc Am|void|SvNOK_on|SV* sv
 639 Tells an SV that it is a double.
 640
 641 =for apidoc Am|void|SvNOK_off|SV* sv
 642 Unsets the NV status of an SV.
 643
 644 =for apidoc Am|void|SvNOK_only|SV* sv
 645 Tells an SV that it is a double and disables all other OK bits.
 646
 647 =for apidoc Am|U32|SvPOK|SV* sv
 648 Returns a U32 value indicating whether the SV contains a character
 649 string.
 650
 651 =for apidoc Am|void|SvPOK_on|SV* sv
 652 Tells an SV that it is a string.
 653
 654 =for apidoc Am|void|SvPOK_off|SV* sv
 655 Unsets the PV status of an SV.
 656
 657 =for apidoc Am|void|SvPOK_only|SV* sv
 658 Tells an SV that it is a string and disables all other OK bits.
 659 Will also turn off the UTF-8 status.
 660
 661 =for apidoc Am|bool|SvVOK|SV* sv
 662 Returns a boolean indicating whether the SV contains a v-string.
 663
 664 =for apidoc Am|U32|SvOOK|SV* sv
 665 Returns a U32 indicating whether the pointer to the string buffer is offset.
 666 This hack is used internally to speed up removal of characters from the
 667 beginning of a SvPV.  When SvOOK is true, then the start of the
 668 allocated string buffer is actually C<SvOOK_offset()> bytes before SvPVX.
 669 This offset used to be stored in SvIVX, but is now stored within the spare
 670 part of the buffer.
 671
 672 =for apidoc Am|U32|SvROK|SV* sv
 673 Tests if the SV is an RV.
 674
 675 =for apidoc Am|void|SvROK_on|SV* sv
 676 Tells an SV that it is an RV.
 677
 678 =for apidoc Am|void|SvROK_off|SV* sv
 679 Unsets the RV status of an SV.
 680
 681 =for apidoc Am|SV*|SvRV|SV* sv
 682 Dereferences an RV to return the SV.
 683
 684 =for apidoc Am|IV|SvIVX|SV* sv
 685 Returns the raw value in the SV's IV slot, without checks or conversions.
 686 Only use when you are sure SvIOK is true. See also C<SvIV()>.
 687
 688 =for apidoc Am|UV|SvUVX|SV* sv
 689 Returns the raw value in the SV's UV slot, without checks or conversions.
 690 Only use when you are sure SvIOK is true. See also C<SvUV()>.
 691
 692 =for apidoc Am|NV|SvNVX|SV* sv
 693 Returns the raw value in the SV's NV slot, without checks or conversions.
 694 Only use when you are sure SvNOK is true. See also C<SvNV()>.
 695
 696 =for apidoc Am|char*|SvPVX|SV* sv
 697 Returns a pointer to the physical string in the SV.  The SV must contain a
 698 string.
 699
 700 =for apidoc Am|STRLEN|SvCUR|SV* sv
 701 Returns the length of the string which is in the SV.  See C<SvLEN>.
 702
 703 =for apidoc Am|STRLEN|SvLEN|SV* sv
 704 Returns the size of the string buffer in the SV, not including any part
 705 attributable to C<SvOOK>.  See C<SvCUR>.
 706
 707 =for apidoc Am|char*|SvEND|SV* sv
 708 Returns a pointer to the last character in the string which is in the SV.
 709 See C<SvCUR>.  Access the character as *(SvEND(sv)).
 710
 711 =for apidoc Am|HV*|SvSTASH|SV* sv
 712 Returns the stash of the SV.
 713
 714 =for apidoc Am|void|SvIV_set|SV* sv|IV val
 715 Set the value of the IV pointer in sv to val.  It is possible to perform
 716 the same function of this macro with an lvalue assignment to C<SvIVX>.
 717 With future Perls, however, it will be more efficient to use
 718 C<SvIV_set> instead of the lvalue assignment to C<SvIVX>.
 719
 720 =for apidoc Am|void|SvNV_set|SV* sv|NV val
 721 Set the value of the NV pointer in sv to val.  See C<SvIV_set>.
 722
 723 =for apidoc Am|void|SvPV_set|SV* sv|char* val
 724 Set the value of the PV pointer in sv to val.  See C<SvIV_set>.
 725
 726 =for apidoc Am|void|SvUV_set|SV* sv|UV val
 727 Set the value of the UV pointer in sv to val.  See C<SvIV_set>.
 728
 729 =for apidoc Am|void|SvRV_set|SV* sv|SV* val
 730 Set the value of the RV pointer in sv to val.  See C<SvIV_set>.
 731
 732 =for apidoc Am|void|SvMAGIC_set|SV* sv|MAGIC* val
 733 Set the value of the MAGIC pointer in sv to val.  See C<SvIV_set>.
 734
 735 =for apidoc Am|void|SvSTASH_set|SV* sv|HV* val
 736 Set the value of the STASH pointer in sv to val.  See C<SvIV_set>.
 737
 738 =for apidoc Am|void|SvCUR_set|SV* sv|STRLEN len
 739 Set the current length of the string which is in the SV.  See C<SvCUR>
 740 and C<SvIV_set>.
 741
 742 =for apidoc Am|void|SvLEN_set|SV* sv|STRLEN len
 743 Set the actual length of the string which is in the SV.  See C<SvIV_set>.
 744
 745 =cut
 746 */
 747
 748 #define SvNIOK(sv)              (SvFLAGS(sv) & (SVf_IOK|SVf_NOK))
 749 #define SvNIOKp(sv)             (SvFLAGS(sv) & (SVp_IOK|SVp_NOK))
 750 #define SvNIOK_off(sv)          (SvFLAGS(sv) &= ~(SVf_IOK|SVf_NOK| \
 751                                                   SVp_IOK|SVp_NOK|SVf_IVisUV))
 752
 753 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
 754 #define assert_not_ROK(sv)      ({assert(!SvROK(sv) || !SvRV(sv));}),
 755 #define assert_not_glob(sv)     ({assert(!isGV_with_GP(sv));}),
 756 #else
 757 #define assert_not_ROK(sv)
 758 #define assert_not_glob(sv)
 759 #endif
 760
 761 #define SvOK(sv)                ((SvTYPE(sv) == SVt_BIND)               \
 762                                  ? (SvFLAGS(SvRV(sv)) & SVf_OK)         \
 763                                  : (SvFLAGS(sv) & SVf_OK))
 764 #define SvOK_off(sv)            (assert_not_ROK(sv) assert_not_glob(sv) \
 765                                  SvFLAGS(sv) &= ~(SVf_OK|               \
 766                                                   SVf_IVisUV|SVf_UTF8), \
 767                                                         SvOOK_off(sv))
 768 #define SvOK_off_exc_UV(sv)     (assert_not_ROK(sv)                     \
 769                                  SvFLAGS(sv) &= ~(SVf_OK|               \
 770                                                   SVf_UTF8),            \
 771                                                         SvOOK_off(sv))
 772
 773 #define SvOKp(sv)               (SvFLAGS(sv) & (SVp_IOK|SVp_NOK|SVp_POK))
 774 #define SvIOKp(sv)              (SvFLAGS(sv) & SVp_IOK)
 775 #define SvIOKp_on(sv)           (assert_not_glob(sv) SvRELEASE_IVX_(sv) \
 776                                     SvFLAGS(sv) |= SVp_IOK)
 777 #define SvNOKp(sv)              (SvFLAGS(sv) & SVp_NOK)
 778 #define SvNOKp_on(sv)           (assert_not_glob(sv) SvFLAGS(sv) |= SVp_NOK)
 779 #define SvPOKp(sv)              (SvFLAGS(sv) & SVp_POK)
 780 #define SvPOKp_on(sv)           (assert_not_ROK(sv) assert_not_glob(sv) \
 781                                  SvFLAGS(sv) |= SVp_POK)
 782
 783 #define SvIOK(sv)               (SvFLAGS(sv) & SVf_IOK)
 784 #define SvIOK_on(sv)            (assert_not_glob(sv) SvRELEASE_IVX_(sv) \
 785                                     SvFLAGS(sv) |= (SVf_IOK|SVp_IOK))
 786 #define SvIOK_off(sv)           (SvFLAGS(sv) &= ~(SVf_IOK|SVp_IOK|SVf_IVisUV))
 787 #define SvIOK_only(sv)          (SvOK_off(sv), \
 788                                     SvFLAGS(sv) |= (SVf_IOK|SVp_IOK))
 789 #define SvIOK_only_UV(sv)       (assert_not_glob(sv) SvOK_off_exc_UV(sv), \
 790                                     SvFLAGS(sv) |= (SVf_IOK|SVp_IOK))
 791
 792 #define SvIOK_UV(sv)            ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV))   \
 793                                  == (SVf_IOK|SVf_IVisUV))
 794 #define SvUOK(sv)               SvIOK_UV(sv)
 795 #define SvIOK_notUV(sv)         ((SvFLAGS(sv) & (SVf_IOK|SVf_IVisUV))   \
 796                                  == SVf_IOK)
 797
 798 #define SvIsUV(sv)              (SvFLAGS(sv) & SVf_IVisUV)
 799 #define SvIsUV_on(sv)           (SvFLAGS(sv) |= SVf_IVisUV)
 800 #define SvIsUV_off(sv)          (SvFLAGS(sv) &= ~SVf_IVisUV)
 801
 802 #define SvNOK(sv)               (SvFLAGS(sv) & SVf_NOK)
 803 #define SvNOK_on(sv)            (assert_not_glob(sv) \
 804                                  SvFLAGS(sv) |= (SVf_NOK|SVp_NOK))
 805 #define SvNOK_off(sv)           (SvFLAGS(sv) &= ~(SVf_NOK|SVp_NOK))
 806 #define SvNOK_only(sv)          (SvOK_off(sv), \
 807                                     SvFLAGS(sv) |= (SVf_NOK|SVp_NOK))
 808
 809 /*
 810 =for apidoc Am|U32|SvUTF8|SV* sv
 811 Returns a U32 value indicating whether the SV contains UTF-8 encoded data.
 812 Call this after SvPV() in case any call to string overloading updates the
 813 internal flag.
 814
 815 =for apidoc Am|void|SvUTF8_on|SV *sv
 816 Turn on the UTF-8 status of an SV (the data is not changed, just the flag).
 817 Do not use frivolously.
 818
 819 =for apidoc Am|void|SvUTF8_off|SV *sv
 820 Unsets the UTF-8 status of an SV.
 821
 822 =for apidoc Am|void|SvPOK_only_UTF8|SV* sv
 823 Tells an SV that it is a string and disables all other OK bits,
 824 and leaves the UTF-8 status as it was.
 825
 826 =cut
 827  */
 828
 829 /* Ensure the return value of this macro does not clash with the GV_ADD* flags
 830 in gv.h: */
 831 #define SvUTF8(sv)              (SvFLAGS(sv) & SVf_UTF8)
 832 #define SvUTF8_on(sv)           (SvFLAGS(sv) |= (SVf_UTF8))
 833 #define SvUTF8_off(sv)          (SvFLAGS(sv) &= ~(SVf_UTF8))
 834
 835 #define SvPOK(sv)               (SvFLAGS(sv) & SVf_POK)
 836 #define SvPOK_on(sv)            (assert_not_ROK(sv) assert_not_glob(sv) \
 837                                  SvFLAGS(sv) |= (SVf_POK|SVp_POK))
 838 #define SvPOK_off(sv)           (SvFLAGS(sv) &= ~(SVf_POK|SVp_POK))
 839 #define SvPOK_only(sv)          (assert_not_ROK(sv) assert_not_glob(sv) \
 840                                  SvFLAGS(sv) &= ~(SVf_OK|               \
 841                                                   SVf_IVisUV|SVf_UTF8), \
 842                                     SvFLAGS(sv) |= (SVf_POK|SVp_POK))
 843 #define SvPOK_only_UTF8(sv)     (assert_not_ROK(sv) assert_not_glob(sv) \
 844                                  SvFLAGS(sv) &= ~(SVf_OK|               \
 845                                                   SVf_IVisUV),          \
 846                                     SvFLAGS(sv) |= (SVf_POK|SVp_POK))
 847
 848 #define SvVOK(sv)               (SvMAGICAL(sv)                          \
 849                                  && mg_find(sv,PERL_MAGIC_vstring))
 850 /* returns the vstring magic, if any */
 851 #define SvVSTRING_mg(sv)        (SvMAGICAL(sv) \
 852                                  ? mg_find(sv,PERL_MAGIC_vstring) : NULL)
 853
 854 #define SvOOK(sv)               (SvFLAGS(sv) & SVf_OOK)
 855 #define SvOOK_on(sv)            ((void)SvIOK_off(sv), SvFLAGS(sv) |= SVf_OOK)
 856 #define SvOOK_off(sv)           ((void)(SvOOK(sv) && sv_backoff(sv)))
 857
 858 #define SvFAKE(sv)              (SvFLAGS(sv) & SVf_FAKE)
 859 #define SvFAKE_on(sv)           (SvFLAGS(sv) |= SVf_FAKE)
 860 #define SvFAKE_off(sv)          (SvFLAGS(sv) &= ~SVf_FAKE)
 861
 862 #define SvROK(sv)               (SvFLAGS(sv) & SVf_ROK)
 863 #define SvROK_on(sv)            (SvFLAGS(sv) |= SVf_ROK)
 864 #define SvROK_off(sv)           (SvFLAGS(sv) &= ~(SVf_ROK))
 865
 866 #define SvMAGICAL(sv)           (SvFLAGS(sv) & (SVs_GMG|SVs_SMG|SVs_RMG))
 867 #define SvMAGICAL_on(sv)        (SvFLAGS(sv) |= (SVs_GMG|SVs_SMG|SVs_RMG))
 868 #define SvMAGICAL_off(sv)       (SvFLAGS(sv) &= ~(SVs_GMG|SVs_SMG|SVs_RMG))
 869
 870 #define SvGMAGICAL(sv)          (SvFLAGS(sv) & SVs_GMG)
 871 #define SvGMAGICAL_on(sv)       (SvFLAGS(sv) |= SVs_GMG)
 872 #define SvGMAGICAL_off(sv)      (SvFLAGS(sv) &= ~SVs_GMG)
 873
 874 #define SvSMAGICAL(sv)          (SvFLAGS(sv) & SVs_SMG)
 875 #define SvSMAGICAL_on(sv)       (SvFLAGS(sv) |= SVs_SMG)
 876 #define SvSMAGICAL_off(sv)      (SvFLAGS(sv) &= ~SVs_SMG)
 877
 878 #define SvRMAGICAL(sv)          (SvFLAGS(sv) & SVs_RMG)
 879 #define SvRMAGICAL_on(sv)       (SvFLAGS(sv) |= SVs_RMG)
 880 #define SvRMAGICAL_off(sv)      (SvFLAGS(sv) &= ~SVs_RMG)
 881
 882 #define SvAMAGIC(sv)            (SvROK(sv) && (SvFLAGS(SvRV(sv)) & SVf_AMAGIC))
 883 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
 884 #  define SvAMAGIC_on(sv)       ({ SV * const kloink = sv;              \
 885                                    assert(SvROK(kloink));               \
 886                                    SvFLAGS(SvRV(kloink)) |= SVf_AMAGIC; \
 887                                 })
 888 #  define SvAMAGIC_off(sv)      ({ SV * const kloink = sv;              \
 889                                    if(SvROK(kloink))                    \
 890                                         SvFLAGS(SvRV(kloink)) &= ~SVf_AMAGIC;\
 891                                 })
 892 #else
 893 #  define SvAMAGIC_on(sv)       (SvFLAGS(SvRV(sv)) |= SVf_AMAGIC)
 894 #  define SvAMAGIC_off(sv) \
 895         (SvROK(sv) && (SvFLAGS(SvRV(sv)) &= ~SVf_AMAGIC))
 896 #endif
 897
 898 /*
 899 =for apidoc Am|U32|SvGAMAGIC|SV* sv
 900
 901 Returns true if the SV has get magic or overloading. If either is true then
 902 the scalar is active data, and has the potential to return a new value every
 903 time it is accessed. Hence you must be careful to only read it once per user
 904 logical operation and work with that returned value. If neither is true then
 905 the scalar's value cannot change unless written to.
 906
 907 =cut
 908 */
 909
 910 #define SvGAMAGIC(sv)           (SvGMAGICAL(sv) || SvAMAGIC(sv))
 911
 912 #define Gv_AMG(stash)           (PL_amagic_generation && Gv_AMupdate(stash, FALSE))
 913
 914 #define SvWEAKREF(sv)           ((SvFLAGS(sv) & (SVf_ROK|SVprv_WEAKREF)) \
 915                                   == (SVf_ROK|SVprv_WEAKREF))
 916 #define SvWEAKREF_on(sv)        (SvFLAGS(sv) |=  (SVf_ROK|SVprv_WEAKREF))
 917 #define SvWEAKREF_off(sv)       (SvFLAGS(sv) &= ~(SVf_ROK|SVprv_WEAKREF))
 918
 919 #define SvPCS_IMPORTED(sv)      ((SvFLAGS(sv) & (SVf_ROK|SVprv_PCS_IMPORTED)) \
 920                                  == (SVf_ROK|SVprv_PCS_IMPORTED))
 921 #define SvPCS_IMPORTED_on(sv)   (SvFLAGS(sv) |=  (SVf_ROK|SVprv_PCS_IMPORTED))
 922 #define SvPCS_IMPORTED_off(sv)  (SvFLAGS(sv) &= ~(SVf_ROK|SVprv_PCS_IMPORTED))
 923
 924 #define SvTHINKFIRST(sv)        (SvFLAGS(sv) & SVf_THINKFIRST)
 925
 926 #define SvPADSTALE(sv)          (SvFLAGS(sv) & SVs_PADSTALE)
 927 #define SvPADSTALE_on(sv)       (SvFLAGS(sv) |= SVs_PADSTALE)
 928 #define SvPADSTALE_off(sv)      (SvFLAGS(sv) &= ~SVs_PADSTALE)
 929
 930 #define SvPADTMP(sv)            (SvFLAGS(sv) & SVs_PADTMP)
 931 #define SvPADTMP_on(sv)         (SvFLAGS(sv) |= SVs_PADTMP)
 932 #define SvPADTMP_off(sv)        (SvFLAGS(sv) &= ~SVs_PADTMP)
 933
 934 #define SvPADMY(sv)             (SvFLAGS(sv) & SVs_PADMY)
 935 #define SvPADMY_on(sv)          (SvFLAGS(sv) |= SVs_PADMY)
 936
 937 #define SvTEMP(sv)              (SvFLAGS(sv) & SVs_TEMP)
 938 #define SvTEMP_on(sv)           (SvFLAGS(sv) |= SVs_TEMP)
 939 #define SvTEMP_off(sv)          (SvFLAGS(sv) &= ~SVs_TEMP)
 940
 941 #define SvOBJECT(sv)            (SvFLAGS(sv) & SVs_OBJECT)
 942 #define SvOBJECT_on(sv)         (SvFLAGS(sv) |= SVs_OBJECT)
 943 #define SvOBJECT_off(sv)        (SvFLAGS(sv) &= ~SVs_OBJECT)
 944
 945 #define SvREADONLY(sv)          (SvFLAGS(sv) & SVf_READONLY)
 946 #define SvREADONLY_on(sv)       (SvFLAGS(sv) |= SVf_READONLY)
 947 #define SvREADONLY_off(sv)      (SvFLAGS(sv) &= ~SVf_READONLY)
 948
 949 #define SvSCREAM(sv) ((SvFLAGS(sv) & (SVp_SCREAM|SVp_POK)) == (SVp_SCREAM|SVp_POK))
 950 #define SvSCREAM_on(sv)         (SvFLAGS(sv) |= SVp_SCREAM)
 951 #define SvSCREAM_off(sv)        (SvFLAGS(sv) &= ~SVp_SCREAM)
 952
 953 #define SvCOMPILED(sv)          (SvFLAGS(sv) & SVpfm_COMPILED)
 954 #define SvCOMPILED_on(sv)       (SvFLAGS(sv) |= SVpfm_COMPILED)
 955 #define SvCOMPILED_off(sv)      (SvFLAGS(sv) &= ~SVpfm_COMPILED)
 956
 957 #define SvEVALED(sv)            (SvFLAGS(sv) & SVrepl_EVAL)
 958 #define SvEVALED_on(sv)         (SvFLAGS(sv) |= SVrepl_EVAL)
 959 #define SvEVALED_off(sv)        (SvFLAGS(sv) &= ~SVrepl_EVAL)
 960
 961 #if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
 962 #  define SvVALID(sv)           ({ const SV *const _svvalid = (const SV*)(sv); \
 963                                    if (SvFLAGS(_svvalid) & SVpbm_VALID) \
 964                                        assert(!isGV_with_GP(_svvalid)); \
 965                                    (SvFLAGS(_svvalid) & SVpbm_VALID);   \
 966                                 })
 967 #  define SvVALID_on(sv)        ({ SV *const _svvalid = MUTABLE_SV(sv); \
 968                                    assert(!isGV_with_GP(_svvalid));     \
 969                                    (SvFLAGS(_svvalid) |= SVpbm_VALID);  \
 970                                 })
 971 #  define SvVALID_off(sv)       ({ SV *const _svvalid = MUTABLE_SV(sv); \
 972                                    assert(!isGV_with_GP(_svvalid));     \
 973                                    (SvFLAGS(_svvalid) &= ~SVpbm_VALID); \
 974                                 })
 975
 976 #  define SvTAIL(sv)    ({ const SV *const _svtail = (const SV *)(sv);  \
 977                             assert(SvTYPE(_svtail) != SVt_PVAV);                \
 978                             assert(SvTYPE(_svtail) != SVt_PVHV);                \
 979                             (SvFLAGS(sv) & (SVpbm_TAIL|SVpbm_VALID))    \
 980                                 == (SVpbm_TAIL|SVpbm_VALID);            \
 981                         })
 982 #else
 983 #  define SvVALID(sv)           (SvFLAGS(sv) & SVpbm_VALID)
 984 #  define SvVALID_on(sv)        (SvFLAGS(sv) |= SVpbm_VALID)
 985 #  define SvVALID_off(sv)       (SvFLAGS(sv) &= ~SVpbm_VALID)
 986 #  define SvTAIL(sv)        ((SvFLAGS(sv) & (SVpbm_TAIL|SVpbm_VALID))   \
 987                              == (SVpbm_TAIL|SVpbm_VALID))
 988
 989 #endif
 990 #define SvTAIL_on(sv)           (SvFLAGS(sv) |= SVpbm_TAIL)
 991 #define SvTAIL_off(sv)          (SvFLAGS(sv) &= ~SVpbm_TAIL)
 992
 993
 994 #define SvPAD_TYPED(sv) \
 995         ((SvFLAGS(sv) & (SVpad_NAME|SVpad_TYPED)) == (SVpad_NAME|SVpad_TYPED))
 996
 997 #define SvPAD_OUR(sv)   \
 998         ((SvFLAGS(sv) & (SVpad_NAME|SVpad_OUR)) == (SVpad_NAME|SVpad_OUR))
 999
1000 #define SvPAD_STATE(sv) \
1001         ((SvFLAGS(sv) & (SVpad_NAME|SVpad_STATE)) == (SVpad_NAME|SVpad_STATE))
1002
1003 #if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
1004 #  define SvPAD_TYPED_on(sv)    ({                                      \
1005             SV *const _svpad = MUTABLE_SV(sv);                          \
1006             assert(SvTYPE(_svpad) == SVt_PVMG);                         \
1007             (SvFLAGS(_svpad) |= SVpad_NAME|SVpad_TYPED);                \
1008         })
1009 #define SvPAD_OUR_on(sv)        ({                                      \
1010             SV *const _svpad = MUTABLE_SV(sv);                          \
1011             assert(SvTYPE(_svpad) == SVt_PVMG);                         \
1012             (SvFLAGS(_svpad) |= SVpad_NAME|SVpad_OUR);                  \
1013         })
1014 #define SvPAD_STATE_on(sv)      ({                                      \
1015             SV *const _svpad = MUTABLE_SV(sv);                          \
1016             assert(SvTYPE(_svpad) == SVt_PVNV || SvTYPE(_svpad) == SVt_PVMG); \
1017             (SvFLAGS(_svpad) |= SVpad_NAME|SVpad_STATE);                \
1018         })
1019 #else
1020 #  define SvPAD_TYPED_on(sv)    (SvFLAGS(sv) |= SVpad_NAME|SVpad_TYPED)
1021 #  define SvPAD_OUR_on(sv)      (SvFLAGS(sv) |= SVpad_NAME|SVpad_OUR)
1022 #  define SvPAD_STATE_on(sv)    (SvFLAGS(sv) |= SVpad_NAME|SVpad_STATE)
1023 #endif
1024
1025 #define SvOURSTASH(sv)  \
1026         (SvPAD_OUR(sv) ? ((XPVMG*) SvANY(sv))->xmg_u.xmg_ourstash : NULL)
1027 #define SvOURSTASH_set(sv, st)                                  \
1028         STMT_START {                                            \
1029             assert(SvTYPE(sv) == SVt_PVMG);                     \
1030             ((XPVMG*) SvANY(sv))->xmg_u.xmg_ourstash = st;      \
1031         } STMT_END
1032
1033 #ifdef PERL_DEBUG_COW
1034 #else
1035 #endif
1036 #define SvRVx(sv) SvRV(sv)
1037
1038 #ifdef PERL_DEBUG_COW
1039 /* Need -0.0 for SvNVX to preserve IEEE FP "negative zero" because
1040    +0.0 + -0.0 => +0.0 but -0.0 + -0.0 => -0.0 */
1041 #  define SvIVX(sv) (0 + ((XPVIV*) SvANY(sv))->xiv_iv)
1042 #  define SvUVX(sv) (0 + ((XPVUV*) SvANY(sv))->xuv_uv)
1043 #  define SvNVX(sv) (-0.0 + ((XPVNV*) SvANY(sv))->xnv_u.xnv_nv)
1044 #  define SvRV(sv) (0 + (sv)->sv_u.svu_rv)
1045 #  define SvRV_const(sv) (0 + (sv)->sv_u.svu_rv)
1046 /* Don't test the core XS code yet.  */
1047 #  if defined (PERL_CORE) && PERL_DEBUG_COW > 1
1048 #    define SvPVX(sv) (0 + (assert(!SvREADONLY(sv)), (sv)->sv_u.svu_pv))
1049 #  else
1050 #  define SvPVX(sv) SvPVX_mutable(sv)
1051 #  endif
1052 #  define SvCUR(sv) (0 + ((XPV*) SvANY(sv))->xpv_cur)
1053 #  define SvLEN(sv) (0 + ((XPV*) SvANY(sv))->xpv_len)
1054 #  define SvEND(sv) ((sv)->sv_u.svu_pv + ((XPV*)SvANY(sv))->xpv_cur)
1055
1056 #  ifdef DEBUGGING
1057 #    define SvMAGIC(sv) (0 + *(assert(SvTYPE(sv) >= SVt_PVMG), &((XPVMG*)  SvANY(sv))->xmg_u.xmg_magic))
1058 #    define SvSTASH(sv) (0 + *(assert(SvTYPE(sv) >= SVt_PVMG), &((XPVMG*)  SvANY(sv))->xmg_stash))
1059 #  else
1060 #    define SvMAGIC(sv) (0 + ((XPVMG*)  SvANY(sv))->xmg_u.xmg_magic)
1061 #    define SvSTASH(sv) (0 + ((XPVMG*)  SvANY(sv))->xmg_stash)
1062 #  endif
1063 #else
1064 #  define SvLEN(sv) ((XPV*) SvANY(sv))->xpv_len
1065 #  define SvEND(sv) ((sv)->sv_u.svu_pv + ((XPV*)SvANY(sv))->xpv_cur)
1066
1067 #  if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
1068 /* These get expanded inside other macros that already use a variable _sv  */
1069 #    define SvPVX(sv)                                                   \
1070         (*({ SV *const _svpvx = MUTABLE_SV(sv);                         \
1071             assert(SvTYPE(_svpvx) >= SVt_PV);                           \
1072             assert(SvTYPE(_svpvx) != SVt_PVAV);                         \
1073             assert(SvTYPE(_svpvx) != SVt_PVHV);                         \
1074             assert(!isGV_with_GP(_svpvx));                              \
1075             &((_svpvx)->sv_u.svu_pv);                                   \
1076          }))
1077 #    define SvCUR(sv)                                                   \
1078         (*({ const SV *const _svcur = (const SV *)(sv);                 \
1079             assert(SvTYPE(_svcur) >= SVt_PV);                           \
1080             assert(SvTYPE(_svcur) != SVt_PVAV);                         \
1081             assert(SvTYPE(_svcur) != SVt_PVHV);                         \
1082             assert(!isGV_with_GP(_svcur));                              \
1083             &(((XPV*) MUTABLE_PTR(SvANY(_svcur)))->xpv_cur);            \
1084          }))
1085 #    define SvIVX(sv)                                                   \
1086         (*({ const SV *const _svivx = (const SV *)(sv);                 \
1087             assert(SvTYPE(_svivx) == SVt_IV || SvTYPE(_svivx) >= SVt_PVIV); \
1088             assert(SvTYPE(_svivx) != SVt_PVAV);                         \
1089             assert(SvTYPE(_svivx) != SVt_PVHV);                         \
1090             assert(SvTYPE(_svivx) != SVt_PVCV);                         \
1091             assert(SvTYPE(_svivx) != SVt_PVFM);                         \
1092             assert(!isGV_with_GP(_svivx));                              \
1093             &(((XPVIV*) MUTABLE_PTR(SvANY(_svivx)))->xiv_iv);           \
1094          }))
1095 #    define SvUVX(sv)                                                   \
1096         (*({ const SV *const _svuvx = (const SV *)(sv);                 \
1097             assert(SvTYPE(_svuvx) == SVt_IV || SvTYPE(_svuvx) >= SVt_PVIV); \
1098             assert(SvTYPE(_svuvx) != SVt_PVAV);                         \
1099             assert(SvTYPE(_svuvx) != SVt_PVHV);                         \
1100             assert(SvTYPE(_svuvx) != SVt_PVCV);                         \
1101             assert(SvTYPE(_svuvx) != SVt_PVFM);                         \
1102             assert(!isGV_with_GP(_svuvx));                              \
1103             &(((XPVUV*) MUTABLE_PTR(SvANY(_svuvx)))->xuv_uv);           \
1104          }))
1105 #    define SvNVX(sv)                                                   \
1106         (*({ const SV *const _svnvx = (const SV *)(sv);                 \
1107             assert(SvTYPE(_svnvx) == SVt_NV || SvTYPE(_svnvx) >= SVt_PVNV); \
1108             assert(SvTYPE(_svnvx) != SVt_PVAV);                         \
1109             assert(SvTYPE(_svnvx) != SVt_PVHV);                         \
1110             assert(SvTYPE(_svnvx) != SVt_PVCV);                         \
1111             assert(SvTYPE(_svnvx) != SVt_PVFM);                         \
1112             assert(SvTYPE(_svnvx) != SVt_PVIO);                         \
1113             assert(!isGV_with_GP(_svnvx));                              \
1114             &(((XPVNV*) MUTABLE_PTR(SvANY(_svnvx)))->xnv_u.xnv_nv);     \
1115          }))
1116 #    define SvRV(sv)                                                    \
1117         (*({ SV *const _svrv = MUTABLE_SV(sv);                          \
1118             assert(SvTYPE(_svrv) >= SVt_PV || SvTYPE(_svrv) == SVt_IV); \
1119             assert(SvTYPE(_svrv) != SVt_PVAV);                          \
1120             assert(SvTYPE(_svrv) != SVt_PVHV);                          \
1121             assert(SvTYPE(_svrv) != SVt_PVCV);                          \
1122             assert(SvTYPE(_svrv) != SVt_PVFM);                          \
1123             assert(!isGV_with_GP(_svrv));                               \
1124             &((_svrv)->sv_u.svu_rv);                                    \
1125          }))
1126 #    define SvRV_const(sv)                                              \
1127         ({ const SV *const _svrv = (const SV *)(sv);                    \
1128             assert(SvTYPE(_svrv) >= SVt_PV || SvTYPE(_svrv) == SVt_IV); \
1129             assert(SvTYPE(_svrv) != SVt_PVAV);                          \
1130             assert(SvTYPE(_svrv) != SVt_PVHV);                          \
1131             assert(SvTYPE(_svrv) != SVt_PVCV);                          \
1132             assert(SvTYPE(_svrv) != SVt_PVFM);                          \
1133             assert(!isGV_with_GP(_svrv));                               \
1134             (_svrv)->sv_u.svu_rv;                                       \
1135          })
1136 #    define SvMAGIC(sv)                                                 \
1137         (*({ const SV *const _svmagic = (const SV *)(sv);               \
1138             assert(SvTYPE(_svmagic) >= SVt_PVMG);                       \
1139             if(SvTYPE(_svmagic) == SVt_PVMG)                            \
1140                 assert(!SvPAD_OUR(_svmagic));                           \
1141             &(((XPVMG*) MUTABLE_PTR(SvANY(_svmagic)))->xmg_u.xmg_magic); \
1142           }))
1143 #    define SvSTASH(sv)                                                 \
1144         (*({ const SV *const _svstash = (const SV *)(sv);               \
1145             assert(SvTYPE(_svstash) >= SVt_PVMG);                       \
1146             &(((XPVMG*) MUTABLE_PTR(SvANY(_svstash)))->xmg_stash);      \
1147           }))
1148 #  else
1149 #    define SvPVX(sv) ((sv)->sv_u.svu_pv)
1150 #    define SvCUR(sv) ((XPV*) SvANY(sv))->xpv_cur
1151 #    define SvIVX(sv) ((XPVIV*) SvANY(sv))->xiv_iv
1152 #    define SvUVX(sv) ((XPVUV*) SvANY(sv))->xuv_uv
1153 #    define SvNVX(sv) ((XPVNV*) SvANY(sv))->xnv_u.xnv_nv
1154 #    define SvRV(sv) ((sv)->sv_u.svu_rv)
1155 #    define SvRV_const(sv) (0 + (sv)->sv_u.svu_rv)
1156 #    define SvMAGIC(sv) ((XPVMG*)  SvANY(sv))->xmg_u.xmg_magic
1157 #    define SvSTASH(sv) ((XPVMG*)  SvANY(sv))->xmg_stash
1158 #  endif
1159 #endif
1160
1161 #ifndef PERL_POISON
1162 /* Given that these two are new, there can't be any existing code using them
1163  *  as LVALUEs  */
1164 #  define SvPVX_mutable(sv)     (0 + (sv)->sv_u.svu_pv)
1165 #  define SvPVX_const(sv)       ((const char*)(0 + (sv)->sv_u.svu_pv))
1166 #else
1167 /* Except for the poison code, which uses & to scribble over the pointer after
1168    free() is called.  */
1169 #  define SvPVX_mutable(sv)     ((sv)->sv_u.svu_pv)
1170 #  define SvPVX_const(sv)       ((const char*)((sv)->sv_u.svu_pv))
1171 #endif
1172
1173 #define SvIVXx(sv) SvIVX(sv)
1174 #define SvUVXx(sv) SvUVX(sv)
1175 #define SvNVXx(sv) SvNVX(sv)
1176 #define SvPVXx(sv) SvPVX(sv)
1177 #define SvLENx(sv) SvLEN(sv)
1178 #define SvENDx(sv) ((PL_Sv = (sv)), SvEND(PL_Sv))
1179
1180
1181 /* Ask a scalar nicely to try to become an IV, if possible.
1182    Not guaranteed to stay returning void */
1183 /* Macro won't actually call sv_2iv if already IOK */
1184 #define SvIV_please(sv) \
1185         STMT_START {if (!SvIOKp(sv) && (SvNOK(sv) || SvPOK(sv))) \
1186                 (void) SvIV(sv); } STMT_END
1187 #define SvIV_set(sv, val) \
1188         STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
1189                 assert(SvTYPE(sv) != SVt_PVAV);         \
1190                 assert(SvTYPE(sv) != SVt_PVHV);         \
1191                 assert(SvTYPE(sv) != SVt_PVCV);         \
1192                 assert(!isGV_with_GP(sv));              \
1193                 (((XPVIV*)  SvANY(sv))->xiv_iv = (val)); } STMT_END
1194 #define SvNV_set(sv, val) \
1195         STMT_START { assert(SvTYPE(sv) == SVt_NV || SvTYPE(sv) >= SVt_PVNV); \
1196             assert(SvTYPE(sv) != SVt_PVAV); assert(SvTYPE(sv) != SVt_PVHV); \
1197             assert(SvTYPE(sv) != SVt_PVCV); assert(SvTYPE(sv) != SVt_PVFM); \
1198                 assert(SvTYPE(sv) != SVt_PVIO);         \
1199                 assert(!isGV_with_GP(sv));              \
1200                 (((XPVNV*)SvANY(sv))->xnv_u.xnv_nv = (val)); } STMT_END
1201 #define SvPV_set(sv, val) \
1202         STMT_START { assert(SvTYPE(sv) >= SVt_PV); \
1203                 assert(SvTYPE(sv) != SVt_PVAV);         \
1204                 assert(SvTYPE(sv) != SVt_PVHV);         \
1205                 assert(!isGV_with_GP(sv));              \
1206                 ((sv)->sv_u.svu_pv = (val)); } STMT_END
1207 #define SvUV_set(sv, val) \
1208         STMT_START { assert(SvTYPE(sv) == SVt_IV || SvTYPE(sv) >= SVt_PVIV); \
1209                 assert(SvTYPE(sv) != SVt_PVAV);         \
1210                 assert(SvTYPE(sv) != SVt_PVHV);         \
1211                 assert(SvTYPE(sv) != SVt_PVCV);         \
1212                 assert(!isGV_with_GP(sv));              \
1213                 (((XPVUV*)SvANY(sv))->xuv_uv = (val)); } STMT_END
1214 #define SvRV_set(sv, val) \
1215         STMT_START { assert(SvTYPE(sv) >=  SVt_PV || SvTYPE(sv) ==  SVt_IV); \
1216                 assert(SvTYPE(sv) != SVt_PVAV);         \
1217                 assert(SvTYPE(sv) != SVt_PVHV);         \
1218                 assert(SvTYPE(sv) != SVt_PVCV);         \
1219                 assert(SvTYPE(sv) != SVt_PVFM);         \
1220                 assert(!isGV_with_GP(sv));              \
1221                 ((sv)->sv_u.svu_rv = (val)); } STMT_END
1222 #define SvMAGIC_set(sv, val) \
1223         STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
1224                 (((XPVMG*)SvANY(sv))->xmg_u.xmg_magic = (val)); } STMT_END
1225 #define SvSTASH_set(sv, val) \
1226         STMT_START { assert(SvTYPE(sv) >= SVt_PVMG); \
1227                 (((XPVMG*)  SvANY(sv))->xmg_stash = (val)); } STMT_END
1228 #define SvCUR_set(sv, val) \
1229         STMT_START { assert(SvTYPE(sv) >= SVt_PV); \
1230                 assert(SvTYPE(sv) != SVt_PVAV);         \
1231                 assert(SvTYPE(sv) != SVt_PVHV);         \
1232                 assert(!isGV_with_GP(sv));              \
1233                 (((XPV*)  SvANY(sv))->xpv_cur = (val)); } STMT_END
1234 #define SvLEN_set(sv, val) \
1235         STMT_START { assert(SvTYPE(sv) >= SVt_PV); \
1236                 assert(SvTYPE(sv) != SVt_PVAV); \
1237                 assert(SvTYPE(sv) != SVt_PVHV); \
1238                 assert(!isGV_with_GP(sv));      \
1239                 (((XPV*)  SvANY(sv))->xpv_len = (val)); } STMT_END
1240 #define SvEND_set(sv, val) \
1241         STMT_START { assert(SvTYPE(sv) >= SVt_PV); \
1242                 SvCUR_set(sv, (val) - SvPVX(sv)); } STMT_END
1243
1244 #define SvPV_renew(sv,n) \
1245         STMT_START { SvLEN_set(sv, n); \
1246                 SvPV_set((sv), (MEM_WRAP_CHECK_(n,char)                 \
1247                                 (char*)saferealloc((Malloc_t)SvPVX(sv), \
1248                                                    (MEM_SIZE)((n)))));  \
1249                  } STMT_END
1250
1251 #define SvPV_shrink_to_cur(sv) STMT_START { \
1252                    const STRLEN _lEnGtH = SvCUR(sv) + 1; \
1253                    SvPV_renew(sv, _lEnGtH); \
1254                  } STMT_END
1255
1256 #define SvPV_free(sv)                                                   \
1257     STMT_START {                                                        \
1258                      assert(SvTYPE(sv) >= SVt_PV);                      \
1259                      if (SvLEN(sv)) {                                   \
1260                          assert(!SvROK(sv));                            \
1261                          if(SvOOK(sv)) {                                \
1262                              STRLEN zok;                                \
1263                              SvOOK_offset(sv, zok);                     \
1264                              SvPV_set(sv, SvPVX_mutable(sv) - zok);     \
1265                              SvFLAGS(sv) &= ~SVf_OOK;                   \
1266                          }                                              \
1267                          Safefree(SvPVX(sv));                           \
1268                      }                                                  \
1269                  } STMT_END
1270
1271 #ifdef PERL_CORE
1272 /* Code that crops up in three places to take a scalar and ready it to hold
1273    a reference */
1274 #  define prepare_SV_for_RV(sv)                                         \
1275     STMT_START {                                                        \
1276                     if (SvTYPE(sv) < SVt_PV && SvTYPE(sv) != SVt_IV)    \
1277                         sv_upgrade(sv, SVt_IV);                         \
1278                     else if (SvTYPE(sv) >= SVt_PV) {                    \
1279                         SvPV_free(sv);                                  \
1280                         SvLEN_set(sv, 0);                               \
1281                         SvCUR_set(sv, 0);                               \
1282                     }                                                   \
1283                  } STMT_END
1284 #endif
1285
1286 #define PERL_FBM_TABLE_OFFSET 1 /* Number of bytes between EOS and table */
1287
1288 /* SvPOKp not SvPOK in the assertion because the string can be tainted! eg
1289    perl -T -e '/$^X/'
1290 */
1291 #if defined (DEBUGGING) && defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
1292 #  define BmFLAGS(sv)                                                   \
1293         (*({ SV *const _bmflags = MUTABLE_SV(sv);                       \
1294                 assert(SvTYPE(_bmflags) == SVt_PVGV);                   \
1295                 assert(SvVALID(_bmflags));                              \
1296             &(((XPVGV*) SvANY(_bmflags))->xnv_u.xbm_s.xbm_flags);       \
1297          }))
1298 #  define BmRARE(sv)                                                    \
1299         (*({ SV *const _bmrare = MUTABLE_SV(sv);                        \
1300                 assert(SvTYPE(_bmrare) == SVt_PVGV);                    \
1301                 assert(SvVALID(_bmrare));                               \
1302             &(((XPVGV*) SvANY(_bmrare))->xnv_u.xbm_s.xbm_rare);         \
1303          }))
1304 #  define BmUSEFUL(sv)                                                  \
1305         (*({ SV *const _bmuseful = MUTABLE_SV(sv);                      \
1306             assert(SvTYPE(_bmuseful) == SVt_PVGV);                      \
1307             assert(SvVALID(_bmuseful));                                 \
1308             assert(!SvIOK(_bmuseful));                                  \
1309             &(((XPVGV*) SvANY(_bmuseful))->xiv_u.xivu_i32);             \
1310          }))
1311 #  define BmPREVIOUS(sv)                                                \
1312     (*({ SV *const _bmprevious = MUTABLE_SV(sv);                        \
1313                 assert(SvTYPE(_bmprevious) == SVt_PVGV);                \
1314                 assert(SvVALID(_bmprevious));                           \
1315             &(((XPVGV*) SvANY(_bmprevious))->xnv_u.xbm_s.xbm_previous); \
1316          }))
1317 #else
1318 #  define BmFLAGS(sv)           ((XPVGV*) SvANY(sv))->xnv_u.xbm_s.xbm_flags
1319 #  define BmRARE(sv)            ((XPVGV*) SvANY(sv))->xnv_u.xbm_s.xbm_rare
1320 #  define BmUSEFUL(sv)          ((XPVGV*) SvANY(sv))->xiv_u.xivu_i32
1321 #  define BmPREVIOUS(sv)        ((XPVGV*) SvANY(sv))->xnv_u.xbm_s.xbm_previous
1322
1323 #endif
1324
1325 #define FmLINES(sv)     ((XPVFM*)  SvANY(sv))->xiv_u.xivu_iv
1326
1327 #define LvTYPE(sv)      ((XPVLV*)  SvANY(sv))->xlv_type
1328 #define LvTARG(sv)      ((XPVLV*)  SvANY(sv))->xlv_targ
1329 #define LvTARGOFF(sv)   ((XPVLV*)  SvANY(sv))->xlv_targoff
1330 #define LvTARGLEN(sv)   ((XPVLV*)  SvANY(sv))->xlv_targlen
1331
1332 #define IoIFP(sv)       ((XPVIO*)  SvANY(sv))->xio_ifp
1333 #define IoOFP(sv)       ((XPVIO*)  SvANY(sv))->xio_ofp
1334 #define IoDIRP(sv)      ((XPVIO*)  SvANY(sv))->xio_dirp
1335 #define IoANY(sv)       ((XPVIO*)  SvANY(sv))->xio_any
1336 #define IoLINES(sv)     ((XPVIO*)  SvANY(sv))->xio_lines
1337 #define IoPAGE(sv)      ((XPVIO*)  SvANY(sv))->xio_page
1338 #define IoPAGE_LEN(sv)  ((XPVIO*)  SvANY(sv))->xio_page_len
1339 #define IoLINES_LEFT(sv)((XPVIO*)  SvANY(sv))->xio_lines_left
1340 #define IoTOP_NAME(sv)  ((XPVIO*)  SvANY(sv))->xio_top_name
1341 #define IoTOP_GV(sv)    ((XPVIO*)  SvANY(sv))->xio_top_gv
1342 #define IoFMT_NAME(sv)  ((XPVIO*)  SvANY(sv))->xio_fmt_name
1343 #define IoFMT_GV(sv)    ((XPVIO*)  SvANY(sv))->xio_fmt_gv
1344 #define IoBOTTOM_NAME(sv)((XPVIO*) SvANY(sv))->xio_bottom_name
1345 #define IoBOTTOM_GV(sv) ((XPVIO*)  SvANY(sv))->xio_bottom_gv
1346 #define IoTYPE(sv)      ((XPVIO*)  SvANY(sv))->xio_type
1347 #define IoFLAGS(sv)     ((XPVIO*)  SvANY(sv))->xio_flags
1348
1349 /* IoTYPE(sv) is a single character telling the type of I/O connection. */
1350 #define IoTYPE_RDONLY           '<'
1351 #define IoTYPE_WRONLY           '>'
1352 #define IoTYPE_RDWR             '+'
1353 #define IoTYPE_APPEND           'a'
1354 #define IoTYPE_PIPE             '|'
1355 #define IoTYPE_STD              '-'     /* stdin or stdout */
1356 #define IoTYPE_SOCKET           's'
1357 #define IoTYPE_CLOSED           ' '
1358 #define IoTYPE_IMPLICIT         'I'     /* stdin or stdout or stderr */
1359 #define IoTYPE_NUMERIC          '#'     /* fdopen */
1360
1361 /*
1362 =for apidoc Am|bool|SvTAINTED|SV* sv
1363 Checks to see if an SV is tainted. Returns TRUE if it is, FALSE if
1364 not.
1365
1366 =for apidoc Am|void|SvTAINTED_on|SV* sv
1367 Marks an SV as tainted if tainting is enabled.
1368
1369 =for apidoc Am|void|SvTAINTED_off|SV* sv
1370 Untaints an SV. Be I<very> careful with this routine, as it short-circuits
1371 some of Perl's fundamental security features. XS module authors should not
1372 use this function unless they fully understand all the implications of
1373 unconditionally untainting the value. Untainting should be done in the
1374 standard perl fashion, via a carefully crafted regexp, rather than directly
1375 untainting variables.
1376
1377 =for apidoc Am|void|SvTAINT|SV* sv
1378 Taints an SV if tainting is enabled.
1379
1380 =cut
1381 */
1382
1383 #define sv_taint(sv)      sv_magic((sv), NULL, PERL_MAGIC_taint, NULL, 0)
1384
1385 #define SvTAINTED(sv)     (SvMAGICAL(sv) && sv_tainted(sv))
1386 #define SvTAINTED_on(sv)  STMT_START{ if(PL_tainting){sv_taint(sv);}   }STMT_END
1387 #define SvTAINTED_off(sv) STMT_START{ if(PL_tainting){sv_untaint(sv);} }STMT_END
1388
1389 #define SvTAINT(sv)                     \
1390     STMT_START {                        \
1391         if (PL_tainting) {              \
1392             if (PL_tainted)             \
1393                 SvTAINTED_on(sv);       \
1394         }                               \
1395     } STMT_END
1396
1397 /*
1398 =for apidoc Am|char*|SvPV_force|SV* sv|STRLEN len
1399 Like C<SvPV> but will force the SV into containing just a string
1400 (C<SvPOK_only>).  You want force if you are going to update the C<SvPVX>
1401 directly.
1402
1403 =for apidoc Am|char*|SvPV_force_nomg|SV* sv|STRLEN len
1404 Like C<SvPV> but will force the SV into containing just a string
1405 (C<SvPOK_only>).  You want force if you are going to update the C<SvPVX>
1406 directly. Doesn't process magic.
1407
1408 =for apidoc Am|char*|SvPV|SV* sv|STRLEN len
1409 Returns a pointer to the string in the SV, or a stringified form of
1410 the SV if the SV does not contain a string.  The SV may cache the
1411 stringified version becoming C<SvPOK>.  Handles 'get' magic. See also
1412 C<SvPVx> for a version which guarantees to evaluate sv only once.
1413
1414 =for apidoc Am|char*|SvPVx|SV* sv|STRLEN len
1415 A version of C<SvPV> which guarantees to evaluate C<sv> only once.
1416 Only use this if C<sv> is an expression with side effects, otherwise use the
1417 more efficient C<SvPVX>.
1418
1419 =for apidoc Am|char*|SvPV_nomg|SV* sv|STRLEN len
1420 Like C<SvPV> but doesn't process magic.
1421
1422 =for apidoc Am|char*|SvPV_nolen|SV* sv
1423 Returns a pointer to the string in the SV, or a stringified form of
1424 the SV if the SV does not contain a string.  The SV may cache the
1425 stringified form becoming C<SvPOK>.  Handles 'get' magic.
1426
1427 =for apidoc Am|IV|SvIV|SV* sv
1428 Coerces the given SV to an integer and returns it. See C<SvIVx> for a
1429 version which guarantees to evaluate sv only once.
1430
1431 =for apidoc Am|IV|SvIV_nomg|SV* sv
1432 Like C<SvIV> but doesn't process magic.
1433
1434 =for apidoc Am|IV|SvIVx|SV* sv
1435 Coerces the given SV to an integer and returns it. Guarantees to evaluate
1436 C<sv> only once. Only use this if C<sv> is an expression with side effects,
1437 otherwise use the more efficient C<SvIV>.
1438
1439 =for apidoc Am|NV|SvNV|SV* sv
1440 Coerce the given SV to a double and return it. See C<SvNVx> for a version
1441 which guarantees to evaluate sv only once.
1442
1443 =for apidoc Am|NV|SvNVx|SV* sv
1444 Coerces the given SV to a double and returns it. Guarantees to evaluate
1445 C<sv> only once. Only use this if C<sv> is an expression with side effects,
1446 otherwise use the more efficient C<SvNV>.
1447
1448 =for apidoc Am|UV|SvUV|SV* sv
1449 Coerces the given SV to an unsigned integer and returns it.  See C<SvUVx>
1450 for a version which guarantees to evaluate sv only once.
1451
1452 =for apidoc Am|UV|SvUV_nomg|SV* sv
1453 Like C<SvUV> but doesn't process magic.
1454
1455 =for apidoc Am|UV|SvUVx|SV* sv
1456 Coerces the given SV to an unsigned integer and returns it. Guarantees to
1457 C<sv> only once. Only use this if C<sv> is an expression with side effects,
1458 otherwise use the more efficient C<SvUV>.
1459
1460 =for apidoc Am|bool|SvTRUE|SV* sv
1461 Returns a boolean indicating whether Perl would evaluate the SV as true or
1462 false.  See SvOK() for a defined/undefined test.  Does not handle 'get' magic.
1463
1464 =for apidoc Am|char*|SvPVutf8_force|SV* sv|STRLEN len
1465 Like C<SvPV_force>, but converts sv to utf8 first if necessary.
1466
1467 =for apidoc Am|char*|SvPVutf8|SV* sv|STRLEN len
1468 Like C<SvPV>, but converts sv to utf8 first if necessary.
1469
1470 =for apidoc Am|char*|SvPVutf8_nolen|SV* sv
1471 Like C<SvPV_nolen>, but converts sv to utf8 first if necessary.
1472
1473 =for apidoc Am|char*|SvPVbyte_force|SV* sv|STRLEN len
1474 Like C<SvPV_force>, but converts sv to byte representation first if necessary.
1475
1476 =for apidoc Am|char*|SvPVbyte|SV* sv|STRLEN len
1477 Like C<SvPV>, but converts sv to byte representation first if necessary.
1478
1479 =for apidoc Am|char*|SvPVbyte_nolen|SV* sv
1480 Like C<SvPV_nolen>, but converts sv to byte representation first if necessary.
1481
1482 =for apidoc Am|char*|SvPVutf8x_force|SV* sv|STRLEN len
1483 Like C<SvPV_force>, but converts sv to utf8 first if necessary.
1484 Guarantees to evaluate sv only once; use the more efficient C<SvPVutf8_force>
1485 otherwise.
1486
1487 =for apidoc Am|char*|SvPVutf8x|SV* sv|STRLEN len
1488 Like C<SvPV>, but converts sv to utf8 first if necessary.
1489 Guarantees to evaluate sv only once; use the more efficient C<SvPVutf8>
1490 otherwise.
1491
1492 =for apidoc Am|char*|SvPVbytex_force|SV* sv|STRLEN len
1493 Like C<SvPV_force>, but converts sv to byte representation first if necessary.
1494 Guarantees to evaluate sv only once; use the more efficient C<SvPVbyte_force>
1495 otherwise.
1496
1497 =for apidoc Am|char*|SvPVbytex|SV* sv|STRLEN len
1498 Like C<SvPV>, but converts sv to byte representation first if necessary.
1499 Guarantees to evaluate sv only once; use the more efficient C<SvPVbyte>
1500 otherwise.
1501
1502 =for apidoc Am|bool|SvIsCOW|SV* sv
1503 Returns a boolean indicating whether the SV is Copy-On-Write. (either shared
1504 hash key scalars, or full Copy On Write scalars if 5.9.0 is configured for
1505 COW)
1506
1507 =for apidoc Am|bool|SvIsCOW_shared_hash|SV* sv
1508 Returns a boolean indicating whether the SV is Copy-On-Write shared hash key
1509 scalar.
1510
1511 =for apidoc Am|void|sv_catpvn_nomg|SV* sv|const char* ptr|STRLEN len
1512 Like C<sv_catpvn> but doesn't process magic.
1513
1514 =for apidoc Am|void|sv_setsv_nomg|SV* dsv|SV* ssv
1515 Like C<sv_setsv> but doesn't process magic.
1516
1517 =for apidoc Am|void|sv_catsv_nomg|SV* dsv|SV* ssv
1518 Like C<sv_catsv> but doesn't process magic.
1519
1520 =for apidoc Amdb|STRLEN|sv_utf8_upgrade_nomg|NN SV *sv
1521
1522 Like sv_utf8_upgrade, but doesn't do magic on C<sv>
1523
1524 =cut
1525 */
1526
1527 /* Let us hope that bitmaps for UV and IV are the same */
1528 #define SvIV(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv(sv))
1529 #define SvUV(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv(sv))
1530 #define SvNV(sv) (SvNOK(sv) ? SvNVX(sv) : sv_2nv(sv))
1531
1532 #define SvIV_nomg(sv) (SvIOK(sv) ? SvIVX(sv) : sv_2iv_flags(sv, 0))
1533 #define SvUV_nomg(sv) (SvIOK(sv) ? SvUVX(sv) : sv_2uv_flags(sv, 0))
1534
1535 /* ----*/
1536
1537 #define SvPV(sv, lp) SvPV_flags(sv, lp, SV_GMAGIC)
1538 #define SvPV_const(sv, lp) SvPV_flags_const(sv, lp, SV_GMAGIC)
1539 #define SvPV_mutable(sv, lp) SvPV_flags_mutable(sv, lp, SV_GMAGIC)
1540
1541 #define SvPV_flags(sv, lp, flags) \
1542     ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
1543      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pv_flags(sv, &lp, flags))
1544 #define SvPV_flags_const(sv, lp, flags) \
1545     ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
1546      ? ((lp = SvCUR(sv)), SvPVX_const(sv)) : \
1547      (const char*) sv_2pv_flags(sv, &lp, flags|SV_CONST_RETURN))
1548 #define SvPV_flags_const_nolen(sv, flags) \
1549     ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
1550      ? SvPVX_const(sv) : \
1551      (const char*) sv_2pv_flags(sv, 0, flags|SV_CONST_RETURN))
1552 #define SvPV_flags_mutable(sv, lp, flags) \
1553     ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
1554      ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) : \
1555      sv_2pv_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
1556
1557 #define SvPV_force(sv, lp) SvPV_force_flags(sv, lp, SV_GMAGIC)
1558 #define SvPV_force_nolen(sv) SvPV_force_flags_nolen(sv, SV_GMAGIC)
1559 #define SvPV_force_mutable(sv, lp) SvPV_force_flags_mutable(sv, lp, SV_GMAGIC)
1560
1561 #define SvPV_force_nomg(sv, lp) SvPV_force_flags(sv, lp, 0)
1562 #define SvPV_force_nomg_nolen(sv) SvPV_force_flags_nolen(sv, 0)
1563
1564 #define SvPV_force_flags(sv, lp, flags) \
1565     ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
1566     ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvn_force_flags(sv, &lp, flags))
1567 #define SvPV_force_flags_nolen(sv, flags) \
1568     ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
1569     ? SvPVX(sv) : sv_pvn_force_flags(sv, 0, flags))
1570 #define SvPV_force_flags_mutable(sv, lp, flags) \
1571     ((SvFLAGS(sv) & (SVf_POK|SVf_THINKFIRST)) == SVf_POK \
1572     ? ((lp = SvCUR(sv)), SvPVX_mutable(sv)) \
1573      : sv_pvn_force_flags(sv, &lp, flags|SV_MUTABLE_RETURN))
1574
1575 #define SvPV_nolen(sv) \
1576     ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
1577      ? SvPVX(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC))
1578
1579 #define SvPV_nolen_const(sv) \
1580     ((SvFLAGS(sv) & (SVf_POK)) == SVf_POK \
1581      ? SvPVX_const(sv) : sv_2pv_flags(sv, 0, SV_GMAGIC|SV_CONST_RETURN))
1582
1583 #define SvPV_nomg(sv, lp) SvPV_flags(sv, lp, 0)
1584 #define SvPV_nomg_const(sv, lp) SvPV_flags_const(sv, lp, 0)
1585 #define SvPV_nomg_const_nolen(sv) SvPV_flags_const_nolen(sv, 0)
1586
1587 /* ----*/
1588
1589 #define SvPVutf8(sv, lp) \
1590     ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8) \
1591      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvutf8(sv, &lp))
1592
1593 #define SvPVutf8_force(sv, lp) \
1594     ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST)) == (SVf_POK|SVf_UTF8) \
1595      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvutf8n_force(sv, &lp))
1596
1597
1598 #define SvPVutf8_nolen(sv) \
1599     ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK|SVf_UTF8)\
1600      ? SvPVX(sv) : sv_2pvutf8(sv, 0))
1601
1602 /* ----*/
1603
1604 #define SvPVbyte(sv, lp) \
1605     ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK) \
1606      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_2pvbyte(sv, &lp))
1607
1608 #define SvPVbyte_force(sv, lp) \
1609     ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8|SVf_THINKFIRST)) == (SVf_POK) \
1610      ? ((lp = SvCUR(sv)), SvPVX(sv)) : sv_pvbyten_force(sv, &lp))
1611
1612 #define SvPVbyte_nolen(sv) \
1613     ((SvFLAGS(sv) & (SVf_POK|SVf_UTF8)) == (SVf_POK)\
1614      ? SvPVX(sv) : sv_2pvbyte(sv, 0))
1615
1616
1617
1618 /* define FOOx(): idempotent versions of FOO(). If possible, use a local
1619  * var to evaluate the arg once; failing that, use a global if possible;
1620  * failing that, call a function to do the work
1621  */
1622
1623 #define SvPVx_force(sv, lp) sv_pvn_force(sv, &lp)
1624 #define SvPVutf8x_force(sv, lp) sv_pvutf8n_force(sv, &lp)
1625 #define SvPVbytex_force(sv, lp) sv_pvbyten_force(sv, &lp)
1626
1627 #if defined(__GNUC__) && !defined(PERL_GCC_BRACE_GROUPS_FORBIDDEN)
1628
1629 #  define SvIVx(sv) ({SV *_sv = MUTABLE_SV(sv); SvIV(_sv); })
1630 #  define SvUVx(sv) ({SV *_sv = MUTABLE_SV(sv); SvUV(_sv); })
1631 #  define SvNVx(sv) ({SV *_sv = MUTABLE_SV(sv); SvNV(_sv); })
1632 #  define SvPVx(sv, lp) ({SV *_sv = (sv); SvPV(_sv, lp); })
1633 #  define SvPVx_const(sv, lp) ({SV *_sv = (sv); SvPV_const(_sv, lp); })
1634 #  define SvPVx_nolen(sv) ({SV *_sv = (sv); SvPV_nolen(_sv); })
1635 #  define SvPVx_nolen_const(sv) ({SV *_sv = (sv); SvPV_nolen_const(_sv); })
1636 #  define SvPVutf8x(sv, lp) ({SV *_sv = (sv); SvPVutf8(_sv, lp); })
1637 #  define SvPVbytex(sv, lp) ({SV *_sv = (sv); SvPVbyte(_sv, lp); })
1638 #  define SvPVbytex_nolen(sv) ({SV *_sv = (sv); SvPVbyte_nolen(_sv); })
1639 #  define SvTRUE(sv) (                                          \
1640     !sv                                                         \
1641     ? 0                                                         \
1642     :    SvPOK(sv)                                              \
1643         ?   (({XPV *nxpv = (XPV*)SvANY(sv);                     \
1644              nxpv &&                                            \
1645              (nxpv->xpv_cur > 1 ||                              \
1646               (nxpv->xpv_cur && *(sv)->sv_u.svu_pv != '0')); }) \
1647              ? 1                                                \
1648              : 0)                                               \
1649         :                                                       \
1650             SvIOK(sv)                                           \
1651             ? SvIVX(sv) != 0                                    \
1652             :   SvNOK(sv)                                       \
1653                 ? SvNVX(sv) != 0.0                              \
1654                 : sv_2bool(sv) )
1655 #  define SvTRUEx(sv) ({SV *_sv = (sv); SvTRUE(_sv); })
1656
1657 #else /* __GNUC__ */
1658
1659 /* These inlined macros use globals, which will require a thread
1660  * declaration in user code, so we avoid them under threads */
1661
1662 #  define SvIVx(sv) ((PL_Sv = (sv)), SvIV(PL_Sv))
1663 #  define SvUVx(sv) ((PL_Sv = (sv)), SvUV(PL_Sv))
1664 #  define SvNVx(sv) ((PL_Sv = (sv)), SvNV(PL_Sv))
1665 #  define SvPVx(sv, lp) ((PL_Sv = (sv)), SvPV(PL_Sv, lp))
1666 #  define SvPVx_const(sv, lp) ((PL_Sv = (sv)), SvPV_const(PL_Sv, lp))
1667 #  define SvPVx_nolen(sv) ((PL_Sv = (sv)), SvPV_nolen(PL_Sv))
1668 #  define SvPVx_nolen_const(sv) ((PL_Sv = (sv)), SvPV_nolen_const(PL_Sv))
1669 #  define SvPVutf8x(sv, lp) ((PL_Sv = (sv)), SvPVutf8(PL_Sv, lp))
1670 #  define SvPVbytex(sv, lp) ((PL_Sv = (sv)), SvPVbyte(PL_Sv, lp))
1671 #  define SvPVbytex_nolen(sv) ((PL_Sv = (sv)), SvPVbyte_nolen(PL_Sv))
1672 #  define SvTRUE(sv) (                                          \
1673     !sv                                                         \
1674     ? 0                                                         \
1675     :    SvPOK(sv)                                              \
1676         ?   ((PL_Xpv = (XPV*)SvANY(PL_Sv = (sv))) &&            \
1677              (PL_Xpv->xpv_cur > 1 ||                            \
1678               (PL_Xpv->xpv_cur && *PL_Sv->sv_u.svu_pv != '0'))  \
1679              ? 1                                                \
1680              : 0)                                               \
1681         :                                                       \
1682             SvIOK(sv)                                           \
1683             ? SvIVX(sv) != 0                                    \
1684             :   SvNOK(sv)                                       \
1685                 ? SvNVX(sv) != 0.0                              \
1686                 : sv_2bool(sv) )
1687 #  define SvTRUEx(sv) ((PL_Sv = (sv)), SvTRUE(PL_Sv))
1688 #endif /* __GNU__ */
1689
1690 #define SvIsCOW(sv)             ((SvFLAGS(sv) & (SVf_FAKE | SVf_READONLY)) == \
1691                                     (SVf_FAKE | SVf_READONLY))
1692 #define SvIsCOW_shared_hash(sv) (SvIsCOW(sv) && SvLEN(sv) == 0)
1693
1694 #define SvSHARED_HEK_FROM_PV(pvx) \
1695         ((struct hek*)(pvx - STRUCT_OFFSET(struct hek, hek_key)))
1696 #define SvSHARED_HASH(sv) (0 + SvSHARED_HEK_FROM_PV(SvPVX_const(sv))->hek_hash)
1697
1698 /* flag values for sv_*_flags functions */
1699 #define SV_IMMEDIATE_UNREF      1
1700 #define SV_GMAGIC               2
1701 #define SV_COW_DROP_PV          4
1702 #define SV_UTF8_NO_ENCODING     8
1703 #define SV_NOSTEAL              16
1704 #define SV_CONST_RETURN         32
1705 #define SV_MUTABLE_RETURN       64
1706 #define SV_SMAGIC               128
1707 #define SV_HAS_TRAILING_NUL     256
1708 #define SV_COW_SHARED_HASH_KEYS 512
1709 /* This one is only enabled for PERL_OLD_COPY_ON_WRITE */
1710 #define SV_COW_OTHER_PVS        1024
1711 /* Make sv_2pv_flags return NULL if something is undefined.  */
1712 #define SV_UNDEF_RETURNS_NULL   2048
1713 /* Tell sv_utf8_upgrade() to not check to see if an upgrade is really needed.
1714  * This is used when the caller has already determined it is, and avoids
1715  * redundant work */
1716 #define SV_FORCE_UTF8_UPGRADE   4096
1717
1718 /* The core is safe for this COW optimisation. XS code on CPAN may not be.
1719    So only default to doing the COW setup if we're in the core.
1720  */
1721 #ifdef PERL_CORE
1722 #  ifndef SV_DO_COW_SVSETSV
1723 #    define SV_DO_COW_SVSETSV   SV_COW_SHARED_HASH_KEYS|SV_COW_OTHER_PVS
1724 #  endif
1725 #endif
1726
1727 #ifndef SV_DO_COW_SVSETSV
1728 #  define SV_DO_COW_SVSETSV     0
1729 #endif
1730
1731
1732 #define sv_unref(sv)            sv_unref_flags(sv, 0)
1733 #define sv_force_normal(sv)     sv_force_normal_flags(sv, 0)
1734 #define sv_usepvn(sv, p, l)     sv_usepvn_flags(sv, p, l, 0)
1735 #define sv_usepvn_mg(sv, p, l)  sv_usepvn_flags(sv, p, l, SV_SMAGIC)
1736
1737 /* We are about to replace the SV's current value. So if it's copy on write
1738    we need to normalise it. Use the SV_COW_DROP_PV flag hint to say that
1739    the value is about to get thrown away, so drop the PV rather than go to
1740    the effort of making a read-write copy only for it to get immediately
1741    discarded.  */
1742
1743 #define SV_CHECK_THINKFIRST_COW_DROP(sv) if (SvTHINKFIRST(sv)) \
1744                                     sv_force_normal_flags(sv, SV_COW_DROP_PV)
1745
1746 #ifdef PERL_OLD_COPY_ON_WRITE
1747 #define SvRELEASE_IVX(sv)   \
1748     ((SvIsCOW(sv) ? sv_force_normal_flags(sv, 0) : (void) 0), 0)
1749 #  define SvIsCOW_normal(sv)    (SvIsCOW(sv) && SvLEN(sv))
1750 #  define SvRELEASE_IVX_(sv)    SvRELEASE_IVX(sv),
1751 #else
1752 #  define SvRELEASE_IVX(sv)   0
1753 /* This little game brought to you by the need to shut this warning up:
1754 mg.c: In function `Perl_magic_get':
1755 mg.c:1024: warning: left-hand operand of comma expression has no effect
1756 */
1757 #  define SvRELEASE_IVX_(sv)  /**/
1758 #endif /* PERL_OLD_COPY_ON_WRITE */
1759
1760 #define CAN_COW_MASK    (SVs_OBJECT|SVs_GMG|SVs_SMG|SVs_RMG|SVf_IOK|SVf_NOK| \
1761                          SVf_POK|SVf_ROK|SVp_IOK|SVp_NOK|SVp_POK|SVf_FAKE| \
1762                          SVf_OOK|SVf_BREAK|SVf_READONLY)
1763 #define CAN_COW_FLAGS   (SVp_POK|SVf_POK)
1764
1765 #define SV_CHECK_THINKFIRST(sv) if (SvTHINKFIRST(sv)) \
1766                                     sv_force_normal_flags(sv, 0)
1767
1768
1769 /* all these 'functions' are now just macros */
1770
1771 #define sv_pv(sv) SvPV_nolen(sv)
1772 #define sv_pvutf8(sv) SvPVutf8_nolen(sv)
1773 #define sv_pvbyte(sv) SvPVbyte_nolen(sv)
1774
1775 #define sv_pvn_force_nomg(sv, lp) sv_pvn_force_flags(sv, lp, 0)
1776 #define sv_utf8_upgrade_flags(sv, flags) sv_utf8_upgrade_flags_grow(sv, flags, 0)
1777 #define sv_utf8_upgrade_nomg(sv) sv_utf8_upgrade_flags(sv, 0)
1778 #define sv_catpvn_nomg(dsv, sstr, slen) sv_catpvn_flags(dsv, sstr, slen, 0)
1779 #define sv_setsv(dsv, ssv) \
1780         sv_setsv_flags(dsv, ssv, SV_GMAGIC|SV_DO_COW_SVSETSV)
1781 #define sv_setsv_nomg(dsv, ssv) sv_setsv_flags(dsv, ssv, SV_DO_COW_SVSETSV)
1782 #define sv_catsv(dsv, ssv) sv_catsv_flags(dsv, ssv, SV_GMAGIC)
1783 #define sv_catsv_nomg(dsv, ssv) sv_catsv_flags(dsv, ssv, 0)
1784 #define sv_catsv_mg(dsv, ssv) sv_catsv_flags(dsv, ssv, SV_GMAGIC|SV_SMAGIC)
1785 #define sv_catpvn(dsv, sstr, slen) sv_catpvn_flags(dsv, sstr, slen, SV_GMAGIC)
1786 #define sv_catpvn_mg(sv, sstr, slen) \
1787         sv_catpvn_flags(sv, sstr, slen, SV_GMAGIC|SV_SMAGIC);
1788 #define sv_2pv(sv, lp) sv_2pv_flags(sv, lp, SV_GMAGIC)
1789 #define sv_2pv_nolen(sv) sv_2pv(sv, 0)
1790 #define sv_2pvbyte_nolen(sv) sv_2pvbyte(sv, 0)
1791 #define sv_2pvutf8_nolen(sv) sv_2pvutf8(sv, 0)
1792 #define sv_2pv_nomg(sv, lp) sv_2pv_flags(sv, lp, 0)
1793 #define sv_pvn_force(sv, lp) sv_pvn_force_flags(sv, lp, SV_GMAGIC)
1794 #define sv_utf8_upgrade(sv) sv_utf8_upgrade_flags(sv, SV_GMAGIC)
1795 #define sv_2iv(sv) sv_2iv_flags(sv, SV_GMAGIC)
1796 #define sv_2uv(sv) sv_2uv_flags(sv, SV_GMAGIC)
1797 #define sv_insert(bigstr, offset, len, little, littlelen)               \
1798         Perl_sv_insert_flags(aTHX_ (bigstr),(offset), (len), (little),  \
1799                              (littlelen), SV_GMAGIC)
1800
1801 /* Should be named SvCatPVN_utf8_upgrade? */
1802 #define sv_catpvn_utf8_upgrade(dsv, sstr, slen, nsv)    \
1803         STMT_START {                                    \
1804             if (!(nsv))                                 \
1805                 nsv = newSVpvn_flags(sstr, slen, SVs_TEMP);     \
1806             else                                        \
1807                 sv_setpvn(nsv, sstr, slen);             \
1808             SvUTF8_off(nsv);                            \
1809             sv_utf8_upgrade(nsv);                       \
1810             sv_catsv(dsv, nsv); \
1811         } STMT_END
1812
1813 /*
1814 =for apidoc Am|SV*|newRV_inc|SV* sv
1815
1816 Creates an RV wrapper for an SV.  The reference count for the original SV is
1817 incremented.
1818
1819 =cut
1820 */
1821
1822 #define newRV_inc(sv)   newRV(sv)
1823
1824 /* the following macros update any magic values this sv is associated with */
1825
1826 /*
1827 =head1 Magical Functions
1828
1829 =for apidoc Am|void|SvGETMAGIC|SV* sv
1830 Invokes C<mg_get> on an SV if it has 'get' magic.  This macro evaluates its
1831 argument more than once.
1832
1833 =for apidoc Am|void|SvSETMAGIC|SV* sv
1834 Invokes C<mg_set> on an SV if it has 'set' magic.  This macro evaluates its
1835 argument more than once.
1836
1837 =for apidoc Am|void|SvSetSV|SV* dsb|SV* ssv
1838 Calls C<sv_setsv> if dsv is not the same as ssv.  May evaluate arguments
1839 more than once.
1840
1841 =for apidoc Am|void|SvSetSV_nosteal|SV* dsv|SV* ssv
1842 Calls a non-destructive version of C<sv_setsv> if dsv is not the same as
1843 ssv. May evaluate arguments more than once.
1844
1845 =for apidoc Am|void|SvSetMagicSV|SV* dsb|SV* ssv
1846 Like C<SvSetSV>, but does any set magic required afterwards.
1847
1848 =for apidoc Am|void|SvSetMagicSV_nosteal|SV* dsv|SV* ssv
1849 Like C<SvSetSV_nosteal>, but does any set magic required afterwards.
1850
1851 =for apidoc Am|void|SvSHARE|SV* sv
1852 Arranges for sv to be shared between threads if a suitable module
1853 has been loaded.
1854
1855 =for apidoc Am|void|SvLOCK|SV* sv
1856 Arranges for a mutual exclusion lock to be obtained on sv if a suitable module
1857 has been loaded.
1858
1859 =for apidoc Am|void|SvUNLOCK|SV* sv
1860 Releases a mutual exclusion lock on sv if a suitable module
1861 has been loaded.
1862
1863 =head1 SV Manipulation Functions
1864
1865 =for apidoc Am|char *|SvGROW|SV* sv|STRLEN len
1866 Expands the character buffer in the SV so that it has room for the
1867 indicated number of bytes (remember to reserve space for an extra trailing
1868 NUL character).  Calls C<sv_grow> to perform the expansion if necessary.
1869 Returns a pointer to the character buffer.
1870
1871 =cut
1872 */
1873
1874 #define SvSHARE(sv) CALL_FPTR(PL_sharehook)(aTHX_ sv)
1875 #define SvLOCK(sv) CALL_FPTR(PL_lockhook)(aTHX_ sv)
1876 #define SvUNLOCK(sv) CALL_FPTR(PL_unlockhook)(aTHX_ sv)
1877 #define SvDESTROYABLE(sv) CALL_FPTR(PL_destroyhook)(aTHX_ sv)
1878
1879 #define SvGETMAGIC(x) STMT_START { if (SvGMAGICAL(x)) mg_get(x); } STMT_END
1880 #define SvSETMAGIC(x) STMT_START { if (SvSMAGICAL(x)) mg_set(x); } STMT_END
1881
1882 #define SvSetSV_and(dst,src,finally) \
1883         STMT_START {                                    \
1884             if ((dst) != (src)) {                       \
1885                 sv_setsv(dst, src);                     \
1886                 finally;                                \
1887             }                                           \
1888         } STMT_END
1889 #define SvSetSV_nosteal_and(dst,src,finally) \
1890         STMT_START {                                    \
1891             if ((dst) != (src)) {                       \
1892                 sv_setsv_flags(dst, src, SV_GMAGIC | SV_NOSTEAL | SV_DO_COW_SVSETSV);   \
1893                 finally;                                \
1894             }                                           \
1895         } STMT_END
1896
1897 #define SvSetSV(dst,src) \
1898                 SvSetSV_and(dst,src,/*nothing*/;)
1899 #define SvSetSV_nosteal(dst,src) \
1900                 SvSetSV_nosteal_and(dst,src,/*nothing*/;)
1901
1902 #define SvSetMagicSV(dst,src) \
1903                 SvSetSV_and(dst,src,SvSETMAGIC(dst))
1904 #define SvSetMagicSV_nosteal(dst,src) \
1905                 SvSetSV_nosteal_and(dst,src,SvSETMAGIC(dst))
1906
1907
1908 #if !defined(SKIP_DEBUGGING)
1909 #define SvPEEK(sv) sv_peek(sv)
1910 #else
1911 #define SvPEEK(sv) ""
1912 #endif
1913
1914 #define SvIMMORTAL(sv) ((sv)==&PL_sv_undef || (sv)==&PL_sv_yes || (sv)==&PL_sv_no || (sv)==&PL_sv_placeholder)
1915
1916 #define boolSV(b) ((b) ? &PL_sv_yes : &PL_sv_no)
1917
1918 #define isGV(sv) (SvTYPE(sv) == SVt_PVGV)
1919 /* If I give every macro argument a different name, then there won't be bugs
1920    where nested macros get confused. Been there, done that.  */
1921 #define isGV_with_GP(pwadak) \
1922         (((SvFLAGS(pwadak) & (SVp_POK|SVpgv_GP)) == SVpgv_GP)   \
1923         && (SvTYPE(pwadak) == SVt_PVGV || SvTYPE(pwadak) == SVt_PVLV))
1924 #define isGV_with_GP_on(sv)     STMT_START {                           \
1925         assert (SvTYPE(sv) == SVt_PVGV || SvTYPE(sv) == SVt_PVLV); \
1926         assert (!SvPOKp(sv));                                          \
1927         assert (!SvIOKp(sv));                                          \
1928         (SvFLAGS(sv) |= SVpgv_GP);                                     \
1929     } STMT_END
1930 #define isGV_with_GP_off(sv)    STMT_START {                           \
1931         assert (SvTYPE(sv) == SVt_PVGV || SvTYPE(sv) == SVt_PVLV); \
1932         assert (!SvPOKp(sv));                                          \
1933         assert (!SvIOKp(sv));                                          \
1934         (SvFLAGS(sv) &= ~SVpgv_GP);                                    \
1935     } STMT_END
1936
1937
1938 #define SvGROW(sv,len) (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX(sv))
1939 #define SvGROW_mutable(sv,len) \
1940     (SvLEN(sv) < (len) ? sv_grow(sv,len) : SvPVX_mutable(sv))
1941 #define Sv_Grow sv_grow
1942
1943 #define CLONEf_COPY_STACKS 1
1944 #define CLONEf_KEEP_PTR_TABLE 2
1945 #define CLONEf_CLONE_HOST 4
1946 #define CLONEf_JOIN_IN 8
1947
1948 struct clone_params {
1949   AV* stashes;
1950   UV  flags;
1951   PerlInterpreter *proto_perl;
1952 };
1953
1954 /*
1955 =for apidoc Am|SV*|newSVpvn_utf8|NULLOK const char* s|STRLEN len|U32 utf8
1956
1957 Creates a new SV and copies a string into it.  If utf8 is true, calls
1958 C<SvUTF8_on> on the new SV.  Implemented as a wrapper around C<newSVpvn_flags>.
1959
1960 =cut
1961 */
1962
1963 #define newSVpvn_utf8(s, len, u) newSVpvn_flags((s), (len), (u) ? SVf_UTF8 : 0)
1964
1965 /*
1966 =for apidoc Am|void|SvOOK_offset|NN SV*sv|STRLEN len
1967
1968 Reads into I<len> the offset from SvPVX back to the true start of the
1969 allocated buffer, which will be non-zero if C<sv_chop> has been used to
1970 efficiently remove characters from start of the buffer. Implemented as a
1971 macro, which takes the address of I<len>, which must be of type C<STRLEN>.
1972 Evaluates I<sv> more than once. Sets I<len> to 0 if C<SvOOK(sv)> is false.
1973
1974 =cut
1975 */
1976
1977 #ifdef DEBUGGING
1978 /* Does the bot know something I don't?
1979 10:28 <@Nicholas> metabatman
1980 10:28 <+meta> Nicholas: crash
1981 */
1982 #  define SvOOK_offset(sv, offset) STMT_START {                         \
1983         assert(sizeof(offset) == sizeof(STRLEN));                       \
1984         if (SvOOK(sv)) {                                                \
1985             const U8 *crash = (U8*)SvPVX_const(sv);                     \
1986             offset = *--crash;                                          \
1987             if (!offset) {                                              \
1988                 crash -= sizeof(STRLEN);                                \
1989                 Copy(crash, (U8 *)&offset, sizeof(STRLEN), U8);         \
1990             }                                                           \
1991             {                                                           \
1992                 /* Validate the preceding buffer's sentinels to         \
1993                    verify that no-one is using it.  */                  \
1994                 const U8 *const bonk = (U8 *) SvPVX_const(sv) - offset; \
1995                 while (crash > bonk) {                                  \
1996                     --crash;                                            \
1997                     assert (*crash == (U8)PTR2UV(crash));               \
1998                 }                                                       \
1999             }                                                           \
2000         } else {                                                        \
2001             offset = 0;                                                 \
2002         }                                                               \
2003     } STMT_END
2004 #else
2005     /* This is the same code, but avoids using any temporary variables:  */
2006 #  define SvOOK_offset(sv, offset) STMT_START {                         \
2007         assert(sizeof(offset) == sizeof(STRLEN));                       \
2008         if (SvOOK(sv)) {                                                \
2009             offset = ((U8*)SvPVX_const(sv))[-1];                        \
2010             if (!offset) {                                              \
2011                 Copy(SvPVX_const(sv) - 1 - sizeof(STRLEN),              \
2012                      (U8 *)&offset, sizeof(STRLEN), U8);                \
2013             }                                                           \
2014         } else {                                                        \
2015             offset = 0;                                                 \
2016         }                                                               \
2017     } STMT_END
2018 #endif
2019 /*
2020  * Local variables:
2021  * c-indentation-style: bsd
2022  * c-basic-offset: 4
2023  * indent-tabs-mode: t
2024  * End:
2025  *
2026  * ex: set ts=8 sts=4 sw=4 noet:
2027  */