Commit 76c1b2dcaa for perl
commit 76c1b2dcaa80e9f5acc43c0adeb0f656b9a9092c
Author: Richard Leach <rich+perl@hyphen-dash-hyphen.info>
Date: Thu Sep 10 16:20:01 2026 +0000
Add newSV_type_generic, a non-inline function for creating new SVs
`Perl_newSV_type` was introduced as an inline function several releases
back in order to overcome the inefficiencies of doing things like:
SV* sv = newSV(0);
sv_upgrade(sv, SVt_PV);
It somewhat achieved its objectives, but with lingering shortcomings:
* It was still quite large, reducing the chance of inlining
* Moving `bodies_by_type[]` into a header file caused bloatage
Really, `Perl_newSV_type` is of most use for types that are going to
regularly created in large quantities at runtime, such as `SVt_IV` and
`SVt_PV`. Something like `SVt_PVIO` isn't going to be created in the
same sort of quantities, and other types are mostly going to be created
in smaller quantities at compile time.
This commit duplicates the body of `Perl_newSV_type` into a new
function (`Perl_newSV_type_generic`) in _sv.c_. This function will be
able to create all SV types, with `Perl_newSV_type` then able to
specialize in types that are most in-demand at runtime.
A follow-up commit will also move `bodies_by_type[]` into _globals.c_.
diff --git a/embed.fnc b/embed.fnc
index 75f971b463..a9a33644fc 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -2616,6 +2616,8 @@ ARdp |SV * |newSVsv_flags_NN \
ARdmp |SV * |newSVsv_nomg |NULLOK SV * const old
ARdp |SV * |newSV_true
ARdip |SV * |newSV_type |const svtype type
+ARdp |SV * |newSV_type_generic \
+ |const svtype type
AIRdp |SV * |newSV_type_mortal \
|const svtype type
ARdp |SV * |newSVuv |const UV u
diff --git a/embed.h b/embed.h
index 8c9bcacc11..30846c83e7 100644
--- a/embed.h
+++ b/embed.h
@@ -456,6 +456,7 @@
# define newSV_false() Perl_newSV_false(aTHX)
# define newSV_true() Perl_newSV_true(aTHX)
# define newSV_type(a) Perl_newSV_type(aTHX_ a)
+# define newSV_type_generic(a) Perl_newSV_type_generic(aTHX_ a)
# define newSV_type_mortal(a) Perl_newSV_type_mortal(aTHX_ a)
# define newSVbool(a) Perl_newSVbool(aTHX_ a)
# define newSVhek(a) Perl_newSVhek(aTHX_ a)
diff --git a/proto.h b/proto.h
index f576814120..91c247d8db 100644
--- a/proto.h
+++ b/proto.h
@@ -5456,6 +5456,14 @@ Perl_newSV_true(pTHX)
STMT_START { Perl_assert_aTHX; PERL_UNUSED_CONTEXT_FOR_ARGS_ASSERT; \
} STMT_END
+PERL_CALLCONV SV *
+Perl_newSV_type_generic(pTHX_ const svtype type)
+ Perl_attribute_nonnull_aTHX
+ __attribute__warn_unused_result__;
+#define PERL_ARGS_ASSERT_NEWSV_TYPE_GENERIC \
+ STMT_START { Perl_assert_aTHX; PERL_UNUSED_CONTEXT_FOR_ARGS_ASSERT; \
+ } STMT_END
+
PERL_CALLCONV SV *
Perl_newSVavdefelem(pTHX_ AV *av, SSize_t ix, bool extendible)
Perl_attribute_nonnull_aTHX
diff --git a/sv.c b/sv.c
index d693c9fb78..94b2a1e236 100644
--- a/sv.c
+++ b/sv.c
@@ -972,6 +972,169 @@ Perl_more_bodies (pTHX_ const svtype sv_type)
}
}
+/*
+=for apidoc newSV_type_generic
+
+Creates a new SV, of the type specified.
+The reference count for the new SV is set to 1.
+
+This function can create all types of SV, whereas the inline function
+C<newSV_type> specializes in the most common SV types and calls this
+function for everything else.
+
+=cut
+*/
+
+SV *
+Perl_newSV_type_generic(pTHX_ const svtype type)
+{
+ PERL_ARGS_ASSERT_NEWSV_TYPE_GENERIC;
+
+ 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:
+ case SVt_PVOBJ:
+ 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);
+
+ switch(type) {
+ case SVt_PVAV:
+ AvFILLp(sv) = -1;
+ AvMAX(sv) = -1;
+ AvALLOC(sv) = NULL;
+
+ AvREAL_only(sv);
+ break;
+ case SVt_PVHV:
+ 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;
+ break;
+ case SVt_PVOBJ:
+ ObjectMAXFIELD(sv) = -1;
+ ObjectFIELDS(sv) = NULL;
+ break;
+ default:
+ NOT_REACHED;
+ }
+
+ 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(deb("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:
+ croak("panic: newSV_type() unknown type %lu", (unsigned long)type);
+ }
+
+ return sv;
+}
+
/*
=for apidoc sv_upgrade