sv_inline.h

   1 /*    sv_inline.h
   2  *
   3  *    Copyright (C) 2022 by Larry Wall and others
   4  *
   5  *    You may distribute under the terms of either the GNU General Public
   6  *    License or the Artistic License, as specified in the README file.
   7  *
   8  */
   9
  10 /* This file contains the newSV_type and newSV_type_mortal functions, as well as
  11  * the various struct and macro definitions they require. In the main, these
  12  * definitions were moved from sv.c, where many of them continue to also be used.
  13  * (In Perl_more_bodies, Perl_sv_upgrade and Perl_sv_clear, for example.) Code
  14  * comments associated with definitions and functions were also copied across
  15  * verbatim.
  16  *
  17  * The rationale for having these as inline functions, rather than in sv.c, is
  18  * that the target type is very often known at compile time, and therefore
  19  * optimum code can be emitted by the compiler, rather than having all calls
  20  * traverse the many branches of Perl_sv_upgrade at runtime.
  21  */
  22
  23 /* This definition came from perl.h*/
  24
  25 /* The old value was hard coded at 1008. (4096-16) seems to be a bit faster,
  26    at least on FreeBSD.  YMMV, so experiment.  */
  27 #ifndef PERL_ARENA_SIZE
  28 #define PERL_ARENA_SIZE 4080
  29 #endif
  30
  31 /* All other pre-existing definitions and functions that were moved into this
  32  * file originally came from sv.c. */
  33
  34 #ifdef PERL_POISON
  35 #  define SvARENA_CHAIN(sv)     ((sv)->sv_u.svu_rv)
  36 #  define SvARENA_CHAIN_SET(sv,val)     (sv)->sv_u.svu_rv = MUTABLE_SV((val))
  37 /* Whilst I'd love to do this, it seems that things like to check on
  38    unreferenced scalars
  39 #  define POISON_SV_HEAD(sv)    PoisonNew(sv, 1, struct STRUCT_SV)
  40 */
  41 #  define POISON_SV_HEAD(sv)    PoisonNew(&SvANY(sv), 1, void *), \
  42                                 PoisonNew(&SvREFCNT(sv), 1, U32)
  43 #else
  44 #  define SvARENA_CHAIN(sv)     SvANY(sv)
  45 #  define SvARENA_CHAIN_SET(sv,val)     SvANY(sv) = (void *)(val)
  46 #  define POISON_SV_HEAD(sv)
  47 #endif
  48
  49 #ifdef PERL_MEM_LOG
  50 #  define MEM_LOG_NEW_SV(sv, file, line, func)  \
  51             Perl_mem_log_new_sv(sv, file, line, func)
  52 #  define MEM_LOG_DEL_SV(sv, file, line, func)  \
  53             Perl_mem_log_del_sv(sv, file, line, func)
  54 #else
  55 #  define MEM_LOG_NEW_SV(sv, file, line, func)  NOOP
  56 #  define MEM_LOG_DEL_SV(sv, file, line, func)  NOOP
  57 #endif
  58
  59 #define uproot_SV(p) \
  60     STMT_START {                                        \
  61         (p) = PL_sv_root;                               \
  62         PL_sv_root = MUTABLE_SV(SvARENA_CHAIN(p));              \
  63         ++PL_sv_count;                                  \
  64     } STMT_END
  65
  66 /* Perl_more_sv lives in sv.c, we don't want to inline it.
  67  * but the function declaration seems to be needed. */
  68 SV* Perl_more_sv(pTHX);
  69
  70 /* new_SV(): return a new, empty SV head */
  71
  72 #ifdef DEBUG_LEAKING_SCALARS
  73 /* provide a real function for a debugger to play with */
  74 STATIC SV*
  75 S_new_SV(pTHX_ const char *file, int line, const char *func)
  76 {
  77     SV* sv;
  78
  79     if (PL_sv_root)
  80         uproot_SV(sv);
  81     else
  82         sv = Perl_more_sv(aTHX);
  83     SvANY(sv) = 0;
  84     SvREFCNT(sv) = 1;
  85     SvFLAGS(sv) = 0;
  86     sv->sv_debug_optype = PL_op ? PL_op->op_type : 0;
  87     sv->sv_debug_line = (U16) (PL_parser && PL_parser->copline != NOLINE
  88                 ? PL_parser->copline
  89                 :  PL_curcop
  90                     ? CopLINE(PL_curcop)
  91                     : 0
  92             );
  93     sv->sv_debug_inpad = 0;
  94     sv->sv_debug_parent = NULL;
  95     sv->sv_debug_file = PL_curcop ? savesharedpv(CopFILE(PL_curcop)): NULL;
  96
  97     sv->sv_debug_serial = PL_sv_serial++;
  98
  99     MEM_LOG_NEW_SV(sv, file, line, func);
 100     DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%" UVxf ": (%05ld) new_SV (from %s:%d [%s])\n",
 101             PTR2UV(sv), (long)sv->sv_debug_serial, file, line, func));
 102
 103     return sv;
 104 }
 105 #  define new_SV(p) (p)=S_new_SV(aTHX_ __FILE__, __LINE__, FUNCTION__)
 106
 107 #else
 108 #  define new_SV(p) \
 109     STMT_START {                                       \
 110         if (PL_sv_root)                                        \
 111             uproot_SV(p);                              \
 112         else                                           \
 113             (p) = Perl_more_sv(aTHX);                     \
 114         SvANY(p) = 0;                                  \
 115         SvREFCNT(p) = 1;                               \
 116         SvFLAGS(p) = 0;                                        \
 117         MEM_LOG_NEW_SV(p, __FILE__, __LINE__, FUNCTION__);  \
 118     } STMT_END
 119 #endif
 120
 121
 122 typedef struct xpvhv_with_aux XPVHV_WITH_AUX;
 123
 124 struct body_details {
 125     U8 body_size;      /* Size to allocate  */
 126     U8 copy;           /* Size of structure to copy (may be shorter)  */
 127     U8 offset;         /* Size of unalloced ghost fields to first alloced field*/
 128     PERL_BITFIELD8 type : 4;        /* We have space for a sanity check. */
 129     PERL_BITFIELD8 cant_upgrade : 1;/* Cannot upgrade this type */
 130     PERL_BITFIELD8 zero_nv : 1;     /* zero the NV when upgrading from this */
 131     PERL_BITFIELD8 arena : 1;       /* Allocated from an arena */
 132     U32 arena_size;                 /* Size of arena to allocate */
 133 };
 134
 135 #define ALIGNED_TYPE_NAME(name) name##_aligned
 136 #define ALIGNED_TYPE(name)             \
 137     typedef union {    \
 138         name align_me;                         \
 139         NV nv;                         \
 140         IV iv;                         \
 141     } ALIGNED_TYPE_NAME(name)
 142
 143 ALIGNED_TYPE(regexp);
 144 ALIGNED_TYPE(XPVGV);
 145 ALIGNED_TYPE(XPVLV);
 146 ALIGNED_TYPE(XPVAV);
 147 ALIGNED_TYPE(XPVHV);
 148 ALIGNED_TYPE(XPVHV_WITH_AUX);
 149 ALIGNED_TYPE(XPVCV);
 150 ALIGNED_TYPE(XPVFM);
 151 ALIGNED_TYPE(XPVIO);
 152
 153 #define HADNV FALSE
 154 #define NONV TRUE
 155
 156
 157 #ifdef PURIFY
 158 /* With -DPURFIY we allocate everything directly, and don't use arenas.
 159    This seems a rather elegant way to simplify some of the code below.  */
 160 #define HASARENA FALSE
 161 #else
 162 #define HASARENA TRUE
 163 #endif
 164 #define NOARENA FALSE
 165
 166 /* Size the arenas to exactly fit a given number of bodies.  A count
 167    of 0 fits the max number bodies into a PERL_ARENA_SIZE.block,
 168    simplifying the default.  If count > 0, the arena is sized to fit
 169    only that many bodies, allowing arenas to be used for large, rare
 170    bodies (XPVFM, XPVIO) without undue waste.  The arena size is
 171    limited by PERL_ARENA_SIZE, so we can safely oversize the
 172    declarations.
 173  */
 174 #define FIT_ARENA0(body_size)                          \
 175     ((size_t)(PERL_ARENA_SIZE / body_size) * body_size)
 176 #define FIT_ARENAn(count,body_size)                    \
 177     ( count * body_size <= PERL_ARENA_SIZE)            \
 178     ? count * body_size                                        \
 179     : FIT_ARENA0 (body_size)
 180 #define FIT_ARENA(count,body_size)                     \
 181    (U32)(count                                                 \
 182     ? FIT_ARENAn (count, body_size)                    \
 183     : FIT_ARENA0 (body_size))
 184
 185 /* Calculate the length to copy. Specifically work out the length less any
 186    final padding the compiler needed to add.  See the comment in sv_upgrade
 187    for why copying the padding proved to be a bug.  */
 188
 189 #define copy_length(type, last_member) \
 190         STRUCT_OFFSET(type, last_member) \
 191         + sizeof (((type*)SvANY((const SV *)0))->last_member)
 192
 193 static const struct body_details bodies_by_type[] = {
 194     /* HEs use this offset for their arena.  */
 195     { 0, 0, 0, SVt_NULL, FALSE, NONV, NOARENA, 0 },
 196
 197     /* IVs are in the head, so the allocation size is 0.  */
 198     { 0,
 199       sizeof(IV), /* This is used to copy out the IV body.  */
 200       STRUCT_OFFSET(XPVIV, xiv_iv), SVt_IV, FALSE, NONV,
 201       NOARENA /* IVS don't need an arena  */, 0
 202     },
 203
 204 #if NVSIZE <= IVSIZE
 205     { 0, sizeof(NV),
 206       STRUCT_OFFSET(XPVNV, xnv_u),
 207       SVt_NV, FALSE, HADNV, NOARENA, 0 },
 208 #else
 209     { sizeof(NV), sizeof(NV),
 210       STRUCT_OFFSET(XPVNV, xnv_u),
 211       SVt_NV, FALSE, HADNV, HASARENA, FIT_ARENA(0, sizeof(NV)) },
 212 #endif
 213
 214     { sizeof(XPV) - STRUCT_OFFSET(XPV, xpv_cur),
 215       copy_length(XPV, xpv_len) - STRUCT_OFFSET(XPV, xpv_cur),
 216       + STRUCT_OFFSET(XPV, xpv_cur),
 217       SVt_PV, FALSE, NONV, HASARENA,
 218       FIT_ARENA(0, sizeof(XPV) - STRUCT_OFFSET(XPV, xpv_cur)) },
 219
 220     { sizeof(XINVLIST) - STRUCT_OFFSET(XPV, xpv_cur),
 221       copy_length(XINVLIST, is_offset) - STRUCT_OFFSET(XPV, xpv_cur),
 222       + STRUCT_OFFSET(XPV, xpv_cur),
 223       SVt_INVLIST, TRUE, NONV, HASARENA,
 224       FIT_ARENA(0, sizeof(XINVLIST) - STRUCT_OFFSET(XPV, xpv_cur)) },
 225
 226     { sizeof(XPVIV) - STRUCT_OFFSET(XPV, xpv_cur),
 227       copy_length(XPVIV, xiv_u) - STRUCT_OFFSET(XPV, xpv_cur),
 228       + STRUCT_OFFSET(XPV, xpv_cur),
 229       SVt_PVIV, FALSE, NONV, HASARENA,
 230       FIT_ARENA(0, sizeof(XPVIV) - STRUCT_OFFSET(XPV, xpv_cur)) },
 231
 232     { sizeof(XPVNV) - STRUCT_OFFSET(XPV, xpv_cur),
 233       copy_length(XPVNV, xnv_u) - STRUCT_OFFSET(XPV, xpv_cur),
 234       + STRUCT_OFFSET(XPV, xpv_cur),
 235       SVt_PVNV, FALSE, HADNV, HASARENA,
 236       FIT_ARENA(0, sizeof(XPVNV) - STRUCT_OFFSET(XPV, xpv_cur)) },
 237
 238     { sizeof(XPVMG), copy_length(XPVMG, xnv_u), 0, SVt_PVMG, FALSE, HADNV,
 239       HASARENA, FIT_ARENA(0, sizeof(XPVMG)) },
 240
 241     { sizeof(ALIGNED_TYPE_NAME(regexp)),
 242       sizeof(regexp),
 243       0,
 244       SVt_REGEXP, TRUE, NONV, HASARENA,
 245       FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(regexp)))
 246     },
 247
 248     { sizeof(ALIGNED_TYPE_NAME(XPVGV)), sizeof(XPVGV), 0, SVt_PVGV, TRUE, HADNV,
 249       HASARENA, FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVGV))) },
 250
 251     { sizeof(ALIGNED_TYPE_NAME(XPVLV)), sizeof(XPVLV), 0, SVt_PVLV, TRUE, HADNV,
 252       HASARENA, FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVLV))) },
 253
 254     { sizeof(ALIGNED_TYPE_NAME(XPVAV)),
 255       copy_length(XPVAV, xav_alloc),
 256       0,
 257       SVt_PVAV, TRUE, NONV, HASARENA,
 258       FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVAV))) },
 259
 260     { sizeof(ALIGNED_TYPE_NAME(XPVHV)),
 261       copy_length(XPVHV, xhv_max),
 262       0,
 263       SVt_PVHV, TRUE, NONV, HASARENA,
 264       FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVHV))) },
 265
 266     { sizeof(ALIGNED_TYPE_NAME(XPVCV)),
 267       sizeof(XPVCV),
 268       0,
 269       SVt_PVCV, TRUE, NONV, HASARENA,
 270       FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVCV))) },
 271
 272     { sizeof(ALIGNED_TYPE_NAME(XPVFM)),
 273       sizeof(XPVFM),
 274       0,
 275       SVt_PVFM, TRUE, NONV, NOARENA,
 276       FIT_ARENA(20, sizeof(ALIGNED_TYPE_NAME(XPVFM))) },
 277
 278     { sizeof(ALIGNED_TYPE_NAME(XPVIO)),
 279       sizeof(XPVIO),
 280       0,
 281       SVt_PVIO, TRUE, NONV, HASARENA,
 282       FIT_ARENA(24, sizeof(ALIGNED_TYPE_NAME(XPVIO))) },
 283 };
 284
 285 #define new_body_allocated(sv_type)            \
 286     (void *)((char *)S_new_body(aTHX_ sv_type) \
 287              - bodies_by_type[sv_type].offset)
 288
 289 #ifdef PURIFY
 290 #if !(NVSIZE <= IVSIZE)
 291 #  define new_XNV()    safemalloc(sizeof(XPVNV))
 292 #endif
 293 #define new_XPVNV()    safemalloc(sizeof(XPVNV))
 294 #define new_XPVMG()    safemalloc(sizeof(XPVMG))
 295
 296 #define del_body_by_type(p, type)       safefree(p)
 297
 298 #else /* !PURIFY */
 299
 300 #if !(NVSIZE <= IVSIZE)
 301 #  define new_XNV()    new_body_allocated(SVt_NV)
 302 #endif
 303 #define new_XPVNV()    new_body_allocated(SVt_PVNV)
 304 #define new_XPVMG()    new_body_allocated(SVt_PVMG)
 305
 306 #define del_body_by_type(p, type)                               \
 307     del_body(p + bodies_by_type[(type)].offset,                 \
 308              &PL_body_roots[(type)])
 309
 310 #endif /* PURIFY */
 311
 312 /* no arena for you! */
 313
 314 #define new_NOARENA(details) \
 315         safemalloc((details)->body_size + (details)->offset)
 316 #define new_NOARENAZ(details) \
 317         safecalloc((details)->body_size + (details)->offset, 1)
 318
 319 #ifndef PURIFY
 320
 321 /* grab a new thing from the arena's free list, allocating more if necessary. */
 322 #define new_body_from_arena(xpv, root_index, type_meta) \
 323     STMT_START { \
 324         void ** const r3wt = &PL_body_roots[root_index]; \
 325         xpv = (PTR_TBL_ENT_t*) (*((void **)(r3wt))      \
 326           ? *((void **)(r3wt)) : Perl_more_bodies(aTHX_ root_index, \
 327                                              type_meta.body_size,\
 328                                              type_meta.arena_size)); \
 329         *(r3wt) = *(void**)(xpv); \
 330     } STMT_END
 331
 332 PERL_STATIC_INLINE void *
 333 S_new_body(pTHX_ const svtype sv_type)
 334 {
 335     void *xpv;
 336     new_body_from_arena(xpv, sv_type, bodies_by_type[sv_type]);
 337     return xpv;
 338 }
 339
 340 #endif
 341
 342 static const struct body_details fake_rv =
 343     { 0, 0, 0, SVt_IV, FALSE, NONV, NOARENA, 0 };
 344
 345 static const struct body_details fake_hv_with_aux =
 346     /* The SVt_IV arena is used for (larger) PVHV bodies.  */
 347     { sizeof(ALIGNED_TYPE_NAME(XPVHV_WITH_AUX)),
 348       copy_length(XPVHV, xhv_max),
 349       0,
 350       SVt_PVHV, TRUE, NONV, HASARENA,
 351       FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVHV_WITH_AUX))) };
 352
 353 /*
 354 =for apidoc newSV_type
 355
 356 Creates a new SV, of the type specified.  The reference count for the new SV
 357 is set to 1.
 358
 359 =cut
 360 */
 361
 362 PERL_STATIC_INLINE SV *
 363 Perl_newSV_type(pTHX_ const svtype type)
 364 {
 365     SV *sv;
 366     void*      new_body;
 367     const struct body_details *type_details;
 368
 369     new_SV(sv);
 370
 371     type_details = bodies_by_type + type;
 372
 373     SvFLAGS(sv) &= ~SVTYPEMASK;
 374     SvFLAGS(sv) |= type;
 375
 376     switch (type) {
 377     case SVt_NULL:
 378         break;
 379     case SVt_IV:
 380         SET_SVANY_FOR_BODYLESS_IV(sv);
 381         SvIV_set(sv, 0);
 382         break;
 383     case SVt_NV:
 384 #if NVSIZE <= IVSIZE
 385         SET_SVANY_FOR_BODYLESS_NV(sv);
 386 #else
 387         SvANY(sv) = new_XNV();
 388 #endif
 389         SvNV_set(sv, 0);
 390         break;
 391     case SVt_PVHV:
 392     case SVt_PVAV:
 393         assert(type_details->body_size);
 394
 395 #ifndef PURIFY
 396         assert(type_details->arena);
 397         assert(type_details->arena_size);
 398         /* This points to the start of the allocated area.  */
 399         new_body = S_new_body(aTHX_ type);
 400         /* xpvav and xpvhv have no offset, so no need to adjust new_body */
 401         assert(!(type_details->offset));
 402 #else
 403         /* We always allocated the full length item with PURIFY. To do this
 404            we fake things so that arena is false for all 16 types..  */
 405         new_body = new_NOARENAZ(type_details);
 406 #endif
 407         SvANY(sv) = new_body;
 408
 409         SvSTASH_set(sv, NULL);
 410         SvMAGIC_set(sv, NULL);
 411
 412         if (type == SVt_PVAV) {
 413             AvFILLp(sv) = -1;
 414             AvMAX(sv) = -1;
 415             AvALLOC(sv) = NULL;
 416
 417             AvREAL_only(sv);
 418         } else {
 419             HvTOTALKEYS(sv) = 0;
 420             /* start with PERL_HASH_DEFAULT_HvMAX+1 buckets: */
 421             HvMAX(sv) = PERL_HASH_DEFAULT_HvMAX;
 422
 423             assert(!SvOK(sv));
 424             SvOK_off(sv);
 425 #ifndef NODEFAULT_SHAREKEYS
 426             HvSHAREKEYS_on(sv);         /* key-sharing on by default */
 427 #endif
 428             /* start with PERL_HASH_DEFAULT_HvMAX+1 buckets: */
 429             HvMAX(sv) = PERL_HASH_DEFAULT_HvMAX;
 430         }
 431
 432         sv->sv_u.svu_array = NULL; /* or svu_hash  */
 433         break;
 434
 435     case SVt_PVIV:
 436     case SVt_PVIO:
 437     case SVt_PVGV:
 438     case SVt_PVCV:
 439     case SVt_PVLV:
 440     case SVt_INVLIST:
 441     case SVt_REGEXP:
 442     case SVt_PVMG:
 443     case SVt_PVNV:
 444     case SVt_PV:
 445         /* For a type known at compile time, it should be possible for the
 446          * compiler to deduce the value of (type_details->arena), resolve
 447          * that branch below, and inline the relevant values from
 448          * bodies_by_type. Except, at least for gcc, it seems not to do that.
 449          * We help it out here with two deviations from sv_upgrade:
 450          * (1) Minor rearrangement here, so that PVFM - the only type at this
 451          *     point not to be allocated from an array appears last, not PV.
 452          * (2) The ASSUME() statement here for everything that isn't PVFM.
 453          * Obviously this all only holds as long as it's a true reflection of
 454          * the bodies_by_type lookup table. */
 455 #ifndef PURIFY
 456          ASSUME(type_details->arena);
 457 #endif
 458          /* FALLTHROUGH */
 459     case SVt_PVFM:
 460
 461         assert(type_details->body_size);
 462         /* We always allocated the full length item with PURIFY. To do this
 463            we fake things so that arena is false for all 16 types..  */
 464 #ifndef PURIFY
 465         if(type_details->arena) {
 466             /* This points to the start of the allocated area.  */
 467             new_body = S_new_body(aTHX_ type);
 468             Zero(new_body, type_details->body_size, char);
 469             new_body = ((char *)new_body) - type_details->offset;
 470         } else
 471 #endif
 472         {
 473             new_body = new_NOARENAZ(type_details);
 474         }
 475         SvANY(sv) = new_body;
 476
 477         if (UNLIKELY(type == SVt_PVIO)) {
 478             IO * const io = MUTABLE_IO(sv);
 479             GV *iogv = gv_fetchpvs("IO::File::", GV_ADD, SVt_PVHV);
 480
 481             SvOBJECT_on(io);
 482             /* Clear the stashcache because a new IO could overrule a package
 483                name */
 484             DEBUG_o(Perl_deb(aTHX_ "sv_upgrade clearing PL_stashcache\n"));
 485             hv_clear(PL_stashcache);
 486
 487             SvSTASH_set(io, MUTABLE_HV(SvREFCNT_inc(GvHV(iogv))));
 488             IoPAGE_LEN(sv) = 60;
 489         }
 490
 491         sv->sv_u.svu_rv = NULL;
 492         break;
 493     default:
 494         Perl_croak(aTHX_ "panic: sv_upgrade to unknown type %lu",
 495                    (unsigned long)type);
 496     }
 497
 498     return sv;
 499 }
 500
 501 /*
 502 =for apidoc newSV_type_mortal
 503
 504 Creates a new mortal SV, of the type specified.  The reference count for the
 505 new SV is set to 1.
 506
 507 This is equivalent to
 508     SV* sv = sv_2mortal(newSV_type(<some type>))
 509 and
 510     SV* sv = sv_newmortal();
 511     sv_upgrade(sv, <some_type>)
 512 but should be more efficient than both of them. (Unless sv_2mortal is inlined
 513 at some point in the future.)
 514
 515 =cut
 516 */
 517
 518 PERL_STATIC_INLINE SV *
 519 Perl_newSV_type_mortal(pTHX_ const svtype type)
 520 {
 521     SV *sv = newSV_type(type);
 522     SSize_t ix = ++PL_tmps_ix;
 523     if (UNLIKELY(ix >= PL_tmps_max))
 524         ix = Perl_tmps_grow_p(aTHX_ ix);
 525     PL_tmps_stack[ix] = (sv);
 526     SvTEMP_on(sv);
 527     return sv;
 528 }
 529
 530 /* The following functions started out in sv.h and then moved to inline.h. They
 531  * moved again into this file during the 5.37.x development cycle. */
 532
 533 /*
 534 =for apidoc_section $SV
 535 =for apidoc SvPVXtrue
 536
 537 Returns a boolean as to whether or not C<sv> contains a PV that is considered
 538 TRUE.  FALSE is returned if C<sv> doesn't contain a PV, or if the PV it does
 539 contain is zero length, or consists of just the single character '0'.  Every
 540 other PV value is considered TRUE.
 541
 542 As of Perl v5.37.1, C<sv> is evaluated exactly once; in earlier releases, it
 543 could be evaluated more than once.
 544
 545 =cut
 546 */
 547
 548 PERL_STATIC_INLINE bool
 549 Perl_SvPVXtrue(pTHX_ SV *sv)
 550 {
 551     PERL_ARGS_ASSERT_SVPVXTRUE;
 552
 553     if (! (XPV *) SvANY(sv)) {
 554         return false;
 555     }
 556
 557     if ( ((XPV *) SvANY(sv))->xpv_cur > 1) { /* length > 1 */
 558         return true;
 559     }
 560
 561     if (( (XPV *) SvANY(sv))->xpv_cur == 0) {
 562         return false;
 563     }
 564
 565     return *sv->sv_u.svu_pv != '0';
 566 }
 567
 568 PERL_STATIC_INLINE bool
 569 Perl_SvTRUE(pTHX_ SV *sv)
 570 {
 571     PERL_ARGS_ASSERT_SVTRUE;
 572
 573     if (UNLIKELY(sv == NULL))
 574         return FALSE;
 575     SvGETMAGIC(sv);
 576     return SvTRUE_nomg_NN(sv);
 577 }
 578
 579 PERL_STATIC_INLINE bool
 580 Perl_SvTRUE_nomg(pTHX_ SV *sv)
 581 {
 582     PERL_ARGS_ASSERT_SVTRUE_NOMG;
 583
 584     if (UNLIKELY(sv == NULL))
 585         return FALSE;
 586     return SvTRUE_nomg_NN(sv);
 587 }
 588
 589 PERL_STATIC_INLINE bool
 590 Perl_SvTRUE_NN(pTHX_ SV *sv)
 591 {
 592     PERL_ARGS_ASSERT_SVTRUE_NN;
 593
 594     SvGETMAGIC(sv);
 595     return SvTRUE_nomg_NN(sv);
 596 }
 597
 598 PERL_STATIC_INLINE bool
 599 Perl_SvTRUE_common(pTHX_ SV * sv, const bool sv_2bool_is_fallback)
 600 {
 601     PERL_ARGS_ASSERT_SVTRUE_COMMON;
 602
 603     if (UNLIKELY(SvIMMORTAL_INTERP(sv)))
 604         return SvIMMORTAL_TRUE(sv);
 605
 606     if (! SvOK(sv))
 607         return FALSE;
 608
 609     if (SvPOK(sv))
 610         return SvPVXtrue(sv);
 611
 612     if (SvIOK(sv))
 613         return SvIVX(sv) != 0; /* casts to bool */
 614
 615     if (SvROK(sv) && !(SvOBJECT(SvRV(sv)) && HvAMAGIC(SvSTASH(SvRV(sv)))))
 616         return TRUE;
 617
 618     if (sv_2bool_is_fallback)
 619         return sv_2bool_nomg(sv);
 620
 621     return isGV_with_GP(sv);
 622 }
 623
 624 PERL_STATIC_INLINE SV *
 625 Perl_SvREFCNT_inc(SV *sv)
 626 {
 627     if (LIKELY(sv != NULL))
 628         SvREFCNT(sv)++;
 629     return sv;
 630 }
 631 PERL_STATIC_INLINE SV *
 632 Perl_SvREFCNT_inc_NN(SV *sv)
 633 {
 634     PERL_ARGS_ASSERT_SVREFCNT_INC_NN;
 635
 636     SvREFCNT(sv)++;
 637     return sv;
 638 }
 639 PERL_STATIC_INLINE void
 640 Perl_SvREFCNT_inc_void(SV *sv)
 641 {
 642     if (LIKELY(sv != NULL))
 643         SvREFCNT(sv)++;
 644 }
 645 PERL_STATIC_INLINE void
 646 Perl_SvREFCNT_dec(pTHX_ SV *sv)
 647 {
 648     if (LIKELY(sv != NULL)) {
 649         U32 rc = SvREFCNT(sv);
 650         if (LIKELY(rc > 1))
 651             SvREFCNT(sv) = rc - 1;
 652         else
 653             Perl_sv_free2(aTHX_ sv, rc);
 654     }
 655 }
 656
 657 PERL_STATIC_INLINE void
 658 Perl_SvREFCNT_dec_NN(pTHX_ SV *sv)
 659 {
 660     U32 rc = SvREFCNT(sv);
 661
 662     PERL_ARGS_ASSERT_SVREFCNT_DEC_NN;
 663
 664     if (LIKELY(rc > 1))
 665         SvREFCNT(sv) = rc - 1;
 666     else
 667         Perl_sv_free2(aTHX_ sv, rc);
 668 }
 669
 670 /*
 671 =for apidoc SvAMAGIC_on
 672
 673 Indicate that C<sv> has overloading (active magic) enabled.
 674
 675 =cut
 676 */
 677
 678 PERL_STATIC_INLINE void
 679 Perl_SvAMAGIC_on(SV *sv)
 680 {
 681     PERL_ARGS_ASSERT_SVAMAGIC_ON;
 682     assert(SvROK(sv));
 683
 684     if (SvOBJECT(SvRV(sv))) HvAMAGIC_on(SvSTASH(SvRV(sv)));
 685 }
 686
 687 /*
 688 =for apidoc SvAMAGIC_off
 689
 690 Indicate that C<sv> has overloading (active magic) disabled.
 691
 692 =cut
 693 */
 694
 695 PERL_STATIC_INLINE void
 696 Perl_SvAMAGIC_off(SV *sv)
 697 {
 698     PERL_ARGS_ASSERT_SVAMAGIC_OFF;
 699
 700     if (SvROK(sv) && SvOBJECT(SvRV(sv)))
 701         HvAMAGIC_off(SvSTASH(SvRV(sv)));
 702 }
 703
 704 PERL_STATIC_INLINE U32
 705 Perl_SvPADSTALE_on(SV *sv)
 706 {
 707     assert(!(SvFLAGS(sv) & SVs_PADTMP));
 708     return SvFLAGS(sv) |= SVs_PADSTALE;
 709 }
 710 PERL_STATIC_INLINE U32
 711 Perl_SvPADSTALE_off(SV *sv)
 712 {
 713     assert(!(SvFLAGS(sv) & SVs_PADTMP));
 714     return SvFLAGS(sv) &= ~SVs_PADSTALE;
 715 }
 716
 717 /*
 718 =for apidoc_section $SV
 719 =for apidoc SvIV
 720 =for apidoc_item SvIVx
 721 =for apidoc_item SvIV_nomg
 722
 723 These each coerce the given SV to IV and return it.  The returned value in many
 724 circumstances will get stored in C<sv>'s IV slot, but not in all cases.  (Use
 725 C<L</sv_setiv>> to make sure it does).
 726
 727 As of 5.37.1, all are guaranteed to evaluate C<sv> only once.
 728
 729 C<SvIVx> is now identical to C<SvIV>, but prior to 5.37.1, it was the only form
 730 guaranteed to evaluate C<sv> only once.
 731
 732 C<SvIV_nomg> is the same as C<SvIV>, but does not perform 'get' magic.
 733
 734 =for apidoc SvNV
 735 =for apidoc_item SvNVx
 736 =for apidoc_item SvNV_nomg
 737
 738 These each coerce the given SV to NV and return it.  The returned value in many
 739 circumstances will get stored in C<sv>'s NV slot, but not in all cases.  (Use
 740 C<L</sv_setnv>> to make sure it does).
 741
 742 As of 5.37.1, all are guaranteed to evaluate C<sv> only once.
 743
 744 C<SvNVx> is now identical to C<SvNV>, but prior to 5.37.1, it was the only form
 745 guaranteed to evaluate C<sv> only once.
 746
 747 C<SvNV_nomg> is the same as C<SvNV>, but does not perform 'get' magic.
 748
 749 =for apidoc SvUV
 750 =for apidoc_item SvUVx
 751 =for apidoc_item SvUV_nomg
 752
 753 These each coerce the given SV to UV and return it.  The returned value in many
 754 circumstances will get stored in C<sv>'s UV slot, but not in all cases.  (Use
 755 C<L</sv_setuv>> to make sure it does).
 756
 757 As of 5.37.1, all are guaranteed to evaluate C<sv> only once.
 758
 759 C<SvUVx> is now identical to C<SvUV>, but prior to 5.37.1, it was the only form
 760 guaranteed to evaluate C<sv> only once.
 761
 762 =cut
 763 */
 764
 765 PERL_STATIC_INLINE IV
 766 Perl_SvIV(pTHX_ SV *sv) {
 767     PERL_ARGS_ASSERT_SVIV;
 768
 769     if (SvIOK_nog(sv))
 770         return SvIVX(sv);
 771     return sv_2iv(sv);
 772 }
 773
 774 PERL_STATIC_INLINE UV
 775 Perl_SvUV(pTHX_ SV *sv) {
 776     PERL_ARGS_ASSERT_SVUV;
 777
 778     if (SvUOK_nog(sv))
 779         return SvUVX(sv);
 780     return sv_2uv(sv);
 781 }
 782
 783 PERL_STATIC_INLINE NV
 784 Perl_SvNV(pTHX_ SV *sv) {
 785     PERL_ARGS_ASSERT_SVNV;
 786
 787     if (SvNOK_nog(sv))
 788         return SvNVX(sv);
 789     return sv_2nv(sv);
 790 }
 791
 792 PERL_STATIC_INLINE IV
 793 Perl_SvIV_nomg(pTHX_ SV *sv) {
 794     PERL_ARGS_ASSERT_SVIV_NOMG;
 795
 796     if (SvIOK(sv))
 797         return SvIVX(sv);
 798     return sv_2iv_flags(sv, 0);
 799 }
 800
 801 PERL_STATIC_INLINE UV
 802 Perl_SvUV_nomg(pTHX_ SV *sv) {
 803     PERL_ARGS_ASSERT_SVUV_NOMG;
 804
 805     if (SvIOK_nog(sv))
 806         return SvUVX(sv);
 807     return sv_2uv_flags(sv, 0);
 808 }
 809
 810 PERL_STATIC_INLINE NV
 811 Perl_SvNV_nomg(pTHX_ SV *sv) {
 812     PERL_ARGS_ASSERT_SVNV_NOMG;
 813
 814     if (SvNOK_nog(sv))
 815         return SvNVX(sv);
 816     return sv_2nv_flags(sv, 0);
 817 }
 818
 819 #if defined(PERL_CORE) || defined (PERL_EXT)
 820 PERL_STATIC_INLINE STRLEN
 821 S_sv_or_pv_pos_u2b(pTHX_ SV *sv, const char *pv, STRLEN pos, STRLEN *lenp)
 822 {
 823     PERL_ARGS_ASSERT_SV_OR_PV_POS_U2B;
 824     if (SvGAMAGIC(sv)) {
 825         U8 *hopped = utf8_hop((U8 *)pv, pos);
 826         if (lenp) *lenp = (STRLEN)(utf8_hop(hopped, *lenp) - hopped);
 827         return (STRLEN)(hopped - (U8 *)pv);
 828     }
 829     return sv_pos_u2b_flags(sv,pos,lenp,SV_CONST_RETURN);
 830 }
 831 #endif
 832
 833 /*
 834  * ex: set ts=8 sts=4 sw=4 et:
 835  */