Make newSV_type an inline function

When a new SV is created and upgraded to a type known at compile time,
uprooting a SV head and then using the general-purpose upgrade function
(sv_upgrade) is clunky. Specifically, while uprooting a SV head is
lightweight (assuming there are unused SVs), sv_upgrade is too big to be
inlined, contains many branches that can logically be resolved at compile
time for known start & end types, and the lookup of the correct
body_details struct may add CPU cycles.

This commit tries to address that by making newSV_type an inline function
and including only the parts of sv_upgrade needed to upgrade a SVt_NULL.
When the destination type is known at compile time, a decent compiler will
inline a call to newSV_type and use the type information to throw away all
the irrelevant parts of the sv_upgrade logic.

Because of the spread of type definitions across header files, it did not
seem possible to make the necessary changed inside sv.h, and so a new
header file (sv_inline.h) was created. For the inlined function to work
outside of sv.c, many definitions from that file were moved to sv_inline.h.

Finally, in order to also benefit from this change, existing code in sv.c
that does things like this:
    SV* sv;
    new_SV(sv);
    sv_upgrade(sv, SVt_PV)
has been modified to read something like:
    SV* sv = newSV_type(SVt_PV);

1 files changed, 495 insertions, 0 deletions

diff --git a/sv_inline.h b/sv_inline.h
new file mode 100644
index 0000000000..70ebb4ae3b
--- /dev/null
+++ b/sv_inline.h
@@ -0,0 +1,495 @@
+/*    sv.h
+ *
+ *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000,
+ *    2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009 by Larry Wall and others
+ *
+ *    You may distribute under the terms of either the GNU General Public
+ *    License or the Artistic License, as specified in the README file.
+ *
+ */
+
+
+/* 2022 */
+/* BLAH BLAH BLAH */
+
+/* This came from perl.h*/
+
+/* The old value was hard coded at 1008. (4096-16) seems to be a bit faster,
+   at least on FreeBSD.  YMMV, so experiment.  */
+#ifndef PERL_ARENA_SIZE
+#define PERL_ARENA_SIZE 4080
+#endif
+
+/* All other pre-existing definitions and functions that were moved into this
+ * file originally came from sv.c. */
+
+#ifdef PERL_POISON
+#  define SvARENA_CHAIN(sv)     ((sv)->sv_u.svu_rv)
+#  define SvARENA_CHAIN_SET(sv,val)     (sv)->sv_u.svu_rv = MUTABLE_SV((val))
+/* Whilst I'd love to do this, it seems that things like to check on
+   unreferenced scalars
+#  define POISON_SV_HEAD(sv)    PoisonNew(sv, 1, struct STRUCT_SV)
+*/
+#  define POISON_SV_HEAD(sv)    PoisonNew(&SvANY(sv), 1, void *), \
+                                PoisonNew(&SvREFCNT(sv), 1, U32)
+#else
+#  define SvARENA_CHAIN(sv)     SvANY(sv)
+#  define SvARENA_CHAIN_SET(sv,val)     SvANY(sv) = (void *)(val)
+#  define POISON_SV_HEAD(sv)
+#endif
+
+#ifdef PERL_MEM_LOG
+#  define MEM_LOG_NEW_SV(sv, file, line, func)  \
+            Perl_mem_log_new_sv(sv, file, line, func)
+#  define MEM_LOG_DEL_SV(sv, file, line, func)  \
+            Perl_mem_log_del_sv(sv, file, line, func)
+#else
+#  define MEM_LOG_NEW_SV(sv, file, line, func)  NOOP
+#  define MEM_LOG_DEL_SV(sv, file, line, func)  NOOP
+#endif
+
+#define uproot_SV(p) \
+    STMT_START {                                        \
+        (p) = PL_sv_root;                               \
+        PL_sv_root = MUTABLE_SV(SvARENA_CHAIN(p));              \
+        ++PL_sv_count;                                  \
+    } STMT_END
+
+/* Perl_more_sv lives in sv.c, we don't want to inline it.
+ * but the function declaration seems to be needed? */
+SV* Perl_more_sv(pTHX);
+
+/* new_SV(): return a new, empty SV head */
+
+#ifdef DEBUG_LEAKING_SCALARS
+/* provide a real function for a debugger to play with */
+STATIC SV*
+S_new_SV(pTHX_ const char *file, int line, const char *func)
+{
+    SV* sv;
+
+    if (PL_sv_root)
+        uproot_SV(sv);
+    else
+        sv = Perl_more_sv(aTHX);
+    SvANY(sv) = 0;
+    SvREFCNT(sv) = 1;
+    SvFLAGS(sv) = 0;
+    sv->sv_debug_optype = PL_op ? PL_op->op_type : 0;
+    sv->sv_debug_line = (U16) (PL_parser && PL_parser->copline != NOLINE
+                ? PL_parser->copline
+                :  PL_curcop
+                    ? CopLINE(PL_curcop)
+                    : 0
+            );
+    sv->sv_debug_inpad = 0;
+    sv->sv_debug_parent = NULL;
+    sv->sv_debug_file = PL_curcop ? savesharedpv(CopFILE(PL_curcop)): NULL;
+
+    sv->sv_debug_serial = PL_sv_serial++;
+
+    MEM_LOG_NEW_SV(sv, file, line, func);
+    DEBUG_m(PerlIO_printf(Perl_debug_log, "0x%" UVxf ": (%05ld) new_SV (from %s:%d [%s])\n",
+            PTR2UV(sv), (long)sv->sv_debug_serial, file, line, func));
+
+    return sv;
+}
+#  define new_SV(p) (p)=S_new_SV(aTHX_ __FILE__, __LINE__, FUNCTION__)
+
+#else
+#  define new_SV(p) \
+    STMT_START {                                       \
+        if (PL_sv_root)                                        \
+            uproot_SV(p);                              \
+        else                                           \
+            (p) = Perl_more_sv(aTHX);                     \
+        SvANY(p) = 0;                                  \
+        SvREFCNT(p) = 1;                               \
+        SvFLAGS(p) = 0;                                        \
+        MEM_LOG_NEW_SV(p, __FILE__, __LINE__, FUNCTION__);  \
+    } STMT_END
+#endif
+
+
+typedef struct xpvhv_with_aux XPVHV_WITH_AUX;
+
+struct body_details {
+    U8 body_size;      /* Size to allocate  */
+    U8 copy;           /* Size of structure to copy (may be shorter)  */
+    U8 offset;         /* Size of unalloced ghost fields to first alloced field*/
+    PERL_BITFIELD8 type : 4;        /* We have space for a sanity check. */
+    PERL_BITFIELD8 cant_upgrade : 1;/* Cannot upgrade this type */
+    PERL_BITFIELD8 zero_nv : 1;     /* zero the NV when upgrading from this */
+    PERL_BITFIELD8 arena : 1;       /* Allocated from an arena */
+    U32 arena_size;                 /* Size of arena to allocate */
+};
+
+#define ALIGNED_TYPE_NAME(name) name##_aligned
+#define ALIGNED_TYPE(name)             \
+    typedef union {    \
+        name align_me;                         \
+        NV nv;                         \
+        IV iv;                         \
+    } ALIGNED_TYPE_NAME(name)
+
+ALIGNED_TYPE(regexp);
+ALIGNED_TYPE(XPVGV);
+ALIGNED_TYPE(XPVLV);
+ALIGNED_TYPE(XPVAV);
+ALIGNED_TYPE(XPVHV);
+ALIGNED_TYPE(XPVHV_WITH_AUX);
+ALIGNED_TYPE(XPVCV);
+ALIGNED_TYPE(XPVFM);
+ALIGNED_TYPE(XPVIO);
+
+#define HADNV FALSE
+#define NONV TRUE
+
+
+#ifdef PURIFY
+/* With -DPURFIY we allocate everything directly, and don't use arenas.
+   This seems a rather elegant way to simplify some of the code below.  */
+#define HASARENA FALSE
+#else
+#define HASARENA TRUE
+#endif
+#define NOARENA FALSE
+
+/* Size the arenas to exactly fit a given number of bodies.  A count
+   of 0 fits the max number bodies into a PERL_ARENA_SIZE.block,
+   simplifying the default.  If count > 0, the arena is sized to fit
+   only that many bodies, allowing arenas to be used for large, rare
+   bodies (XPVFM, XPVIO) without undue waste.  The arena size is
+   limited by PERL_ARENA_SIZE, so we can safely oversize the
+   declarations.
+ */
+#define FIT_ARENA0(body_size)                          \
+    ((size_t)(PERL_ARENA_SIZE / body_size) * body_size)
+#define FIT_ARENAn(count,body_size)                    \
+    ( count * body_size <= PERL_ARENA_SIZE)            \
+    ? count * body_size                                        \
+    : FIT_ARENA0 (body_size)
+#define FIT_ARENA(count,body_size)                     \
+   (U32)(count                                                 \
+    ? FIT_ARENAn (count, body_size)                    \
+    : FIT_ARENA0 (body_size))
+
+/* Calculate the length to copy. Specifically work out the length less any
+   final padding the compiler needed to add.  See the comment in sv_upgrade
+   for why copying the padding proved to be a bug.  */
+
+#define copy_length(type, last_member) \
+        STRUCT_OFFSET(type, last_member) \
+        + sizeof (((type*)SvANY((const SV *)0))->last_member)
+
+static const struct body_details bodies_by_type[] = {
+    /* HEs use this offset for their arena.  */
+    { 0, 0, 0, SVt_NULL, FALSE, NONV, NOARENA, 0 },
+
+    /* IVs are in the head, so the allocation size is 0.  */
+    { 0,
+      sizeof(IV), /* This is used to copy out the IV body.  */
+      STRUCT_OFFSET(XPVIV, xiv_iv), SVt_IV, FALSE, NONV,
+      NOARENA /* IVS don't need an arena  */, 0
+    },
+
+#if NVSIZE <= IVSIZE
+    { 0, sizeof(NV),
+      STRUCT_OFFSET(XPVNV, xnv_u),
+      SVt_NV, FALSE, HADNV, NOARENA, 0 },
+#else
+    { sizeof(NV), sizeof(NV),
+      STRUCT_OFFSET(XPVNV, xnv_u),
+      SVt_NV, FALSE, HADNV, HASARENA, FIT_ARENA(0, sizeof(NV)) },
+#endif
+
+    { sizeof(XPV) - STRUCT_OFFSET(XPV, xpv_cur),
+      copy_length(XPV, xpv_len) - STRUCT_OFFSET(XPV, xpv_cur),
+      + STRUCT_OFFSET(XPV, xpv_cur),
+      SVt_PV, FALSE, NONV, HASARENA,
+      FIT_ARENA(0, sizeof(XPV) - STRUCT_OFFSET(XPV, xpv_cur)) },
+
+    { sizeof(XINVLIST) - STRUCT_OFFSET(XPV, xpv_cur),
+      copy_length(XINVLIST, is_offset) - STRUCT_OFFSET(XPV, xpv_cur),
+      + STRUCT_OFFSET(XPV, xpv_cur),
+      SVt_INVLIST, TRUE, NONV, HASARENA,
+      FIT_ARENA(0, sizeof(XINVLIST) - STRUCT_OFFSET(XPV, xpv_cur)) },
+
+    { sizeof(XPVIV) - STRUCT_OFFSET(XPV, xpv_cur),
+      copy_length(XPVIV, xiv_u) - STRUCT_OFFSET(XPV, xpv_cur),
+      + STRUCT_OFFSET(XPV, xpv_cur),
+      SVt_PVIV, FALSE, NONV, HASARENA,
+      FIT_ARENA(0, sizeof(XPVIV) - STRUCT_OFFSET(XPV, xpv_cur)) },
+
+    { sizeof(XPVNV) - STRUCT_OFFSET(XPV, xpv_cur),
+      copy_length(XPVNV, xnv_u) - STRUCT_OFFSET(XPV, xpv_cur),
+      + STRUCT_OFFSET(XPV, xpv_cur),
+      SVt_PVNV, FALSE, HADNV, HASARENA,
+      FIT_ARENA(0, sizeof(XPVNV) - STRUCT_OFFSET(XPV, xpv_cur)) },
+
+    { sizeof(XPVMG), copy_length(XPVMG, xnv_u), 0, SVt_PVMG, FALSE, HADNV,
+      HASARENA, FIT_ARENA(0, sizeof(XPVMG)) },
+
+    { sizeof(ALIGNED_TYPE_NAME(regexp)),
+      sizeof(regexp),
+      0,
+      SVt_REGEXP, TRUE, NONV, HASARENA,
+      FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(regexp)))
+    },
+
+    { sizeof(ALIGNED_TYPE_NAME(XPVGV)), sizeof(XPVGV), 0, SVt_PVGV, TRUE, HADNV,
+      HASARENA, FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVGV))) },
+
+    { sizeof(ALIGNED_TYPE_NAME(XPVLV)), sizeof(XPVLV), 0, SVt_PVLV, TRUE, HADNV,
+      HASARENA, FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVLV))) },
+
+    { sizeof(ALIGNED_TYPE_NAME(XPVAV)),
+      copy_length(XPVAV, xav_alloc),
+      0,
+      SVt_PVAV, TRUE, NONV, HASARENA,
+      FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVAV))) },
+
+    { sizeof(ALIGNED_TYPE_NAME(XPVHV)),
+      copy_length(XPVHV, xhv_max),
+      0,
+      SVt_PVHV, TRUE, NONV, HASARENA,
+      FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVHV))) },
+
+    { sizeof(ALIGNED_TYPE_NAME(XPVCV)),
+      sizeof(XPVCV),
+      0,
+      SVt_PVCV, TRUE, NONV, HASARENA,
+      FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVCV))) },
+
+    { sizeof(ALIGNED_TYPE_NAME(XPVFM)),
+      sizeof(XPVFM),
+      0,
+      SVt_PVFM, TRUE, NONV, NOARENA,
+      FIT_ARENA(20, sizeof(ALIGNED_TYPE_NAME(XPVFM))) },
+
+    { sizeof(ALIGNED_TYPE_NAME(XPVIO)),
+      sizeof(XPVIO),
+      0,
+      SVt_PVIO, TRUE, NONV, HASARENA,
+      FIT_ARENA(24, sizeof(ALIGNED_TYPE_NAME(XPVIO))) },
+};
+
+#define new_body_allocated(sv_type)            \
+    (void *)((char *)S_new_body(aTHX_ sv_type) \
+             - bodies_by_type[sv_type].offset)
+
+#ifdef PURIFY
+#if !(NVSIZE <= IVSIZE)
+#  define new_XNV()    safemalloc(sizeof(XPVNV))
+#endif
+#define new_XPVNV()    safemalloc(sizeof(XPVNV))
+#define new_XPVMG()    safemalloc(sizeof(XPVMG))
+
+#define del_body_by_type(p, type)       safefree(p)
+
+#else /* !PURIFY */
+
+#if !(NVSIZE <= IVSIZE)
+#  define new_XNV()    new_body_allocated(SVt_NV)
+#endif
+#define new_XPVNV()    new_body_allocated(SVt_PVNV)
+#define new_XPVMG()    new_body_allocated(SVt_PVMG)
+
+#define del_body_by_type(p, type)                               \
+    del_body(p + bodies_by_type[(type)].offset,                 \
+             &PL_body_roots[(type)])
+
+#endif /* PURIFY */
+
+/* no arena for you! */
+
+#define new_NOARENA(details) \
+        safemalloc((details)->body_size + (details)->offset)
+#define new_NOARENAZ(details) \
+        safecalloc((details)->body_size + (details)->offset, 1)
+
+#ifndef PURIFY
+
+/* grab a new thing from the arena's free list, allocating more if necessary. */
+#define new_body_from_arena(xpv, root_index, type_meta) \
+    STMT_START { \
+        void ** const r3wt = &PL_body_roots[root_index]; \
+        xpv = (PTR_TBL_ENT_t*) (*((void **)(r3wt))      \
+          ? *((void **)(r3wt)) : Perl_more_bodies(aTHX_ root_index, \
+                                             type_meta.body_size,\
+                                             type_meta.arena_size)); \
+        *(r3wt) = *(void**)(xpv); \
+    } STMT_END
+
+PERL_STATIC_INLINE void *
+S_new_body(pTHX_ const svtype sv_type)
+{
+    void *xpv;
+    new_body_from_arena(xpv, sv_type, bodies_by_type[sv_type]);
+    return xpv;
+}
+
+#endif
+
+static const struct body_details fake_rv =
+    { 0, 0, 0, SVt_IV, FALSE, NONV, NOARENA, 0 };
+
+static const struct body_details fake_hv_with_aux =
+    /* The SVt_IV arena is used for (larger) PVHV bodies.  */
+    { sizeof(ALIGNED_TYPE_NAME(XPVHV_WITH_AUX)),
+      copy_length(XPVHV, xhv_max),
+      0,
+      SVt_PVHV, TRUE, NONV, HASARENA,
+      FIT_ARENA(0, sizeof(ALIGNED_TYPE_NAME(XPVHV_WITH_AUX))) };
+
+/*
+=for apidoc newSV_type
+
+Creates a new SV, of the type specified.  The reference count for the new SV
+is set to 1.
+
+=cut
+*/
+
+PERL_STATIC_INLINE SV *
+Perl_newSV_type(pTHX_ const svtype type)
+{
+    SV *sv;
+    void*      new_body;
+    const struct body_details *type_details;
+
+    new_SV(sv);
+
+    type_details = bodies_by_type + type;
+
+    SvFLAGS(sv) &= ~SVTYPEMASK;
+    SvFLAGS(sv) |= type;
+
+    switch (type) {
+    case SVt_NULL:
+        break;
+    case SVt_IV:
+        SET_SVANY_FOR_BODYLESS_IV(sv);
+        SvIV_set(sv, 0);
+        break;
+    case SVt_NV:
+#if NVSIZE <= IVSIZE
+        SET_SVANY_FOR_BODYLESS_NV(sv);
+#else
+        SvANY(sv) = new_XNV();
+#endif
+        SvNV_set(sv, 0);
+        break;
+    case SVt_PVHV:
+    case SVt_PVAV:
+        assert(type_details->body_size);
+
+#ifndef PURIFY
+        assert(type_details->arena);
+        assert(type_details->arena_size);
+        /* This points to the start of the allocated area.  */
+        new_body = S_new_body(aTHX_ type);
+        /* xpvav and xpvhv have no offset, so no need to adjust new_body */
+        assert(!(type_details->offset));
+#else
+        /* We always allocated the full length item with PURIFY. To do this
+           we fake things so that arena is false for all 16 types..  */
+        new_body = new_NOARENAZ(type_details);
+#endif
+        SvANY(sv) = new_body;
+
+        SvSTASH_set(sv, NULL);
+        SvMAGIC_set(sv, NULL);
+
+        if (type == SVt_PVAV) {
+            AvFILLp(sv) = -1;
+            AvMAX(sv) = -1;
+            AvALLOC(sv) = NULL;
+
+            AvREAL_only(sv);
+        } else {
+            HvTOTALKEYS(sv) = 0;
+            /* start with PERL_HASH_DEFAULT_HvMAX+1 buckets: */
+            HvMAX(sv) = PERL_HASH_DEFAULT_HvMAX;
+
+            assert(!SvOK(sv));
+            SvOK_off(sv);
+#ifndef NODEFAULT_SHAREKEYS
+            HvSHAREKEYS_on(sv);         /* key-sharing on by default */
+#endif
+            /* start with PERL_HASH_DEFAULT_HvMAX+1 buckets: */
+            HvMAX(sv) = PERL_HASH_DEFAULT_HvMAX;
+        }
+
+        sv->sv_u.svu_array = NULL; /* or svu_hash  */
+        break;
+
+    case SVt_PVIV:
+    case SVt_PVIO:
+    case SVt_PVGV:
+    case SVt_PVCV:
+    case SVt_PVLV:
+    case SVt_INVLIST:
+    case SVt_REGEXP:
+    case SVt_PVMG:
+    case SVt_PVNV:
+    case SVt_PV:
+        /* For a type known at compile time, it should be possible for the
+         * compiler to deduce the value of (type_details->arena), resolve
+         * that branch below, and inline the relevant values from
+         * bodies_by_type. Except, at least for gcc, it seems not to do that.
+         * We help it out here with two deviations from sv_upgrade:
+         * (1) Minor rearrangement here, so that PVFM - the only type at this
+         *     point not to be allocated from an array appears last, not PV.
+         * (2) The ASSUME() statement here for everything that isn't PVFM.
+         * Obviously this all only holds as long as it's a true reflection of
+         * the bodies_by_type lookup table. */
+#ifndef PURIFY
+         ASSUME(type_details->arena);
+#endif
+         /* FALLTHROUGH */
+    case SVt_PVFM:
+
+        assert(type_details->body_size);
+        /* We always allocated the full length item with PURIFY. To do this
+           we fake things so that arena is false for all 16 types..  */
+#ifndef PURIFY
+        if(type_details->arena) {
+            /* This points to the start of the allocated area.  */
+            new_body = S_new_body(aTHX_ type);
+            Zero(new_body, type_details->body_size, char);
+            new_body = ((char *)new_body) - type_details->offset;
+        } else
+#endif
+        {
+            new_body = new_NOARENAZ(type_details);
+        }
+        SvANY(sv) = new_body;
+
+        if (UNLIKELY(type == SVt_PVIO)) {
+            IO * const io = MUTABLE_IO(sv);
+            GV *iogv = gv_fetchpvs("IO::File::", GV_ADD, SVt_PVHV);
+
+            SvOBJECT_on(io);
+            /* Clear the stashcache because a new IO could overrule a package
+               name */
+            DEBUG_o(Perl_deb(aTHX_ "sv_upgrade clearing PL_stashcache\n"));
+            hv_clear(PL_stashcache);
+
+            SvSTASH_set(io, MUTABLE_HV(SvREFCNT_inc(GvHV(iogv))));
+            IoPAGE_LEN(sv) = 60;
+        }
+
+        sv->sv_u.svu_rv = NULL;
+        break;
+    default:
+        Perl_croak(aTHX_ "panic: sv_upgrade to unknown type %lu",
+                   (unsigned long)type);
+    }
+
+    return sv;
+}
+
+/*
+ * ex: set ts=8 sts=4 sw=4 et:
+ */