Skip to content

Fix huge inline bloat msvc sv inline h #22667

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 3 commits into
base: blead
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions MANIFEST
Original file line number Diff line number Diff line change
Expand Up @@ -188,6 +188,7 @@ SECURITY.md Add Security Policy for GitHub
sv.c Scalar value code
sv.h Scalar value header
sv_inline.h Perl_newSV_type and required defs
svfix.pl throw away script for fixing Perl_newSV_type bloat
taint.c Tainting code
TestInit.pm Preamble library for tests
thread.h Threading header
Expand Down
36 changes: 35 additions & 1 deletion embed.fnc
Original file line number Diff line number Diff line change
Expand Up @@ -2296,9 +2296,43 @@ ARdp |SV * |newSVsv_flags |NULLOK SV * const old \
|I32 flags
ARdm |SV * |newSVsv_nomg |NULLOK SV * const old
ARdp |SV * |newSV_true
ARdip |SV * |newSV_type |const svtype type
AIRdp |SV * |newSV_type_mortal \
|const svtype type
ARdip |SV * |newSV_type_mortalSVt_INVLIST
ARdip |SV * |newSV_type_mortalSVt_IV
ARdip |SV * |newSV_type_mortalSVt_NULL
ARdip |SV * |newSV_type_mortalSVt_NV
ARdip |SV * |newSV_type_mortalSVt_PV
ARdip |SV * |newSV_type_mortalSVt_PVAV
ARdip |SV * |newSV_type_mortalSVt_PVCV
ARdip |SV * |newSV_type_mortalSVt_PVFM
ARdip |SV * |newSV_type_mortalSVt_PVGV
ARdip |SV * |newSV_type_mortalSVt_PVHV
ARdip |SV * |newSV_type_mortalSVt_PVIO
ARdip |SV * |newSV_type_mortalSVt_PVIV
ARdip |SV * |newSV_type_mortalSVt_PVLV
ARdip |SV * |newSV_type_mortalSVt_PVMG
ARdip |SV * |newSV_type_mortalSVt_PVNV
ARdip |SV * |newSV_type_mortalSVt_PVOBJ
ARdip |SV * |newSV_type_mortalSVt_REGEXP
ARdip |SV * |newSV_typeSVt_INVLIST
ARdip |SV * |newSV_typeSVt_IV
ARdip |SV * |newSV_typeSVt_NULL
ARdip |SV * |newSV_typeSVt_NV
ARdip |SV * |newSV_typeSVt_PV
ARdip |SV * |newSV_typeSVt_PVAV
ARdip |SV * |newSV_typeSVt_PVCV
ARdip |SV * |newSV_typeSVt_PVFM
ARdip |SV * |newSV_typeSVt_PVGV
ARdip |SV * |newSV_typeSVt_PVHV
ARdip |SV * |newSV_typeSVt_PVIO
ARdip |SV * |newSV_typeSVt_PVIV
ARdip |SV * |newSV_typeSVt_PVLV
ARdip |SV * |newSV_typeSVt_PVMG
ARdip |SV * |newSV_typeSVt_PVNV
ARdip |SV * |newSV_typeSVt_PVOBJ
ARdip |SV * |newSV_typeSVt_REGEXP
ARdip |SV * |newSV_typeX |const svtype type
ARdp |SV * |newSVuv |const UV u
ARdpx |OP * |newTRYCATCHOP |I32 flags \
|NN OP *tryblock \
Expand Down
36 changes: 35 additions & 1 deletion embed.h
Original file line number Diff line number Diff line change
Expand Up @@ -427,8 +427,42 @@
# define newSVREF(a) Perl_newSVREF(aTHX_ a)
# 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_typeSVt_INVLIST() Perl_newSV_typeSVt_INVLIST(aTHX)
# define newSV_typeSVt_IV() Perl_newSV_typeSVt_IV(aTHX)
# define newSV_typeSVt_NULL() Perl_newSV_typeSVt_NULL(aTHX)
# define newSV_typeSVt_NV() Perl_newSV_typeSVt_NV(aTHX)
# define newSV_typeSVt_PV() Perl_newSV_typeSVt_PV(aTHX)
# define newSV_typeSVt_PVAV() Perl_newSV_typeSVt_PVAV(aTHX)
# define newSV_typeSVt_PVCV() Perl_newSV_typeSVt_PVCV(aTHX)
# define newSV_typeSVt_PVFM() Perl_newSV_typeSVt_PVFM(aTHX)
# define newSV_typeSVt_PVGV() Perl_newSV_typeSVt_PVGV(aTHX)
# define newSV_typeSVt_PVHV() Perl_newSV_typeSVt_PVHV(aTHX)
# define newSV_typeSVt_PVIO() Perl_newSV_typeSVt_PVIO(aTHX)
# define newSV_typeSVt_PVIV() Perl_newSV_typeSVt_PVIV(aTHX)
# define newSV_typeSVt_PVLV() Perl_newSV_typeSVt_PVLV(aTHX)
# define newSV_typeSVt_PVMG() Perl_newSV_typeSVt_PVMG(aTHX)
# define newSV_typeSVt_PVNV() Perl_newSV_typeSVt_PVNV(aTHX)
# define newSV_typeSVt_PVOBJ() Perl_newSV_typeSVt_PVOBJ(aTHX)
# define newSV_typeSVt_REGEXP() Perl_newSV_typeSVt_REGEXP(aTHX)
# define newSV_typeX(a) Perl_newSV_typeX(aTHX_ a)
# define newSV_type_mortal(a) Perl_newSV_type_mortal(aTHX_ a)
# define newSV_type_mortalSVt_INVLIST() Perl_newSV_type_mortalSVt_INVLIST(aTHX)
# define newSV_type_mortalSVt_IV() Perl_newSV_type_mortalSVt_IV(aTHX)
# define newSV_type_mortalSVt_NULL() Perl_newSV_type_mortalSVt_NULL(aTHX)
# define newSV_type_mortalSVt_NV() Perl_newSV_type_mortalSVt_NV(aTHX)
# define newSV_type_mortalSVt_PV() Perl_newSV_type_mortalSVt_PV(aTHX)
# define newSV_type_mortalSVt_PVAV() Perl_newSV_type_mortalSVt_PVAV(aTHX)
# define newSV_type_mortalSVt_PVCV() Perl_newSV_type_mortalSVt_PVCV(aTHX)
# define newSV_type_mortalSVt_PVFM() Perl_newSV_type_mortalSVt_PVFM(aTHX)
# define newSV_type_mortalSVt_PVGV() Perl_newSV_type_mortalSVt_PVGV(aTHX)
# define newSV_type_mortalSVt_PVHV() Perl_newSV_type_mortalSVt_PVHV(aTHX)
# define newSV_type_mortalSVt_PVIO() Perl_newSV_type_mortalSVt_PVIO(aTHX)
# define newSV_type_mortalSVt_PVIV() Perl_newSV_type_mortalSVt_PVIV(aTHX)
# define newSV_type_mortalSVt_PVLV() Perl_newSV_type_mortalSVt_PVLV(aTHX)
# define newSV_type_mortalSVt_PVMG() Perl_newSV_type_mortalSVt_PVMG(aTHX)
# define newSV_type_mortalSVt_PVNV() Perl_newSV_type_mortalSVt_PVNV(aTHX)
# define newSV_type_mortalSVt_PVOBJ() Perl_newSV_type_mortalSVt_PVOBJ(aTHX)
# define newSV_type_mortalSVt_REGEXP() Perl_newSV_type_mortalSVt_REGEXP(aTHX)
# define newSVbool(a) Perl_newSVbool(aTHX_ a)
# define newSVhek(a) Perl_newSVhek(aTHX_ a)
# define newSVhek_mortal(a) Perl_newSVhek_mortal(aTHX_ a)
Expand Down
58 changes: 46 additions & 12 deletions gv.c
Original file line number Diff line number Diff line change
Expand Up @@ -58,6 +58,7 @@ GV *
Perl_gv_add_by_type(pTHX_ GV *gv, svtype type)
{
SV **where;
static char saw [20] = {0};

if (
!gv
Expand Down Expand Up @@ -94,7 +95,39 @@ Perl_gv_add_by_type(pTHX_ GV *gv, svtype type)

if (!*where)
{
*where = newSV_type(type);
if(type == SVt_PVHV) {
*where = newSV_type(SVt_PVHV);
}
else if(type == SVt_PVAV) {
*where = newSV_type(SVt_PVAV);
}
else if(type == SVt_PVMG) {
*where = newSV_type(SVt_PVMG);
}
else if(type == SVt_PVIO) {
*where = newSV_type(SVt_PVIO);
}
else if(type == SVt_PV) {
*where = newSV_type(SVt_PV);
}
else if (type == SVt_PVGV) {
*where = newSV_type(SVt_PVGV);
}
else if(type == SVt_NULL) {
*where = newSV_type(SVt_NULL);
}
// else if(type == ) {
// *where = newSV_type();
// }
else {
if(!saw[type]) {
//__debugbreak();
saw[type] = 1;
}
*where = Perl_newSV_typeX(aTHX_ type);
}


if ( type == SVt_PVAV
&& memEQs(GvNAME(gv), GvNAMELEN(gv), "ISA"))
{
Expand Down Expand Up @@ -577,7 +610,7 @@ S_gv_init_svtype(pTHX_ GV *gv, const svtype sv_type)
case SVt_PVGV:
break;
default:
if(GvSVn(gv)) {
if(GvSVnt(gv,sv_type)) {
/* Work round what appears to be a bug in Sun C++ 5.8 2005/10/13
If we just cast GvSVn(gv) to void, it ignores evaluating it for
its side effect */
Expand Down Expand Up @@ -2330,24 +2363,24 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
storeparen:
/* Flag the capture variables with a NULL mg_ptr
Use mg_len for the array index to lookup. */
sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, NULL, paren);
sv_magic(GvSVnt(gv, SVt_PVMG), MUTABLE_SV(gv), PERL_MAGIC_sv, NULL, paren);
break;

case ':': /* $: */
sv_setpv(GvSVn(gv),PL_chopset);
sv_setpv(GvSVnt(gv, SVt_PVMG),PL_chopset);
goto magicalize;

case '?': /* $? */
#ifdef COMPLEX_STATUS
SvUPGRADE(GvSVn(gv), SVt_PVLV);
SvUPGRADE(GvSVnt(gv, SVt_PVLV), SVt_PVLV);
#endif
goto magicalize;

case '!': /* $! */
GvMULTI_on(gv);
/* If %! has been used, automatically load Errno.pm. */

sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, name, len);
sv_magic(GvSVnt(gv,SVt_PVMG), MUTABLE_SV(gv), PERL_MAGIC_sv, name, len);

/* magicalization must be done before require_tie_mod_s is called */
if (sv_type == SVt_PVHV || sv_type == SVt_PVGV)
Expand All @@ -2358,8 +2391,9 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
case '+': /* $+, %+, @+ */
GvMULTI_on(gv); /* no used once warnings here */
{ /* $- $+ */
sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, name, len);
if (*name == '+')
SV* svplusminus = GvSVnt(gv, SVt_PVMG);
sv_magic(svplusminus, MUTABLE_SV(gv), PERL_MAGIC_sv, name, len);
if (*name == '+')
SvREADONLY_on(GvSVn(gv));
}
{ /* %- %+ */
Expand Down Expand Up @@ -2388,7 +2422,7 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
goto magicalize;
case '\023': /* $^S */
ro_magicalize:
SvREADONLY_on(GvSVn(gv));
SvREADONLY_on(GvSVnt(gv,SVt_PVMG));
/* FALLTHROUGH */
case '0': /* $0 */
case '^': /* $^ */
Expand Down Expand Up @@ -2417,14 +2451,14 @@ S_gv_magicalize(pTHX_ GV *gv, HV *stash, const char *name, STRLEN len,
case '\024': /* $^T */
case '\027': /* $^W */
magicalize:
sv_magic(GvSVn(gv), MUTABLE_SV(gv), PERL_MAGIC_sv, name, len);
sv_magic(GvSVnt(gv,SVt_PVMG), MUTABLE_SV(gv), PERL_MAGIC_sv, name, len);
break;

case '\014': /* $^L */
sv_setpvs(GvSVn(gv),"\f");
sv_setpvs(GvSVnt(gv, SVt_PV),"\f");
break;
case ';': /* $; */
sv_setpvs(GvSVn(gv),"\034");
sv_setpvs(GvSVnt(gv, SVt_PV),"\034");
break;
case ']': /* $] */
{
Expand Down
16 changes: 16 additions & 0 deletions gv.h
Original file line number Diff line number Diff line change
Expand Up @@ -101,6 +101,17 @@ L<perl5100delta>.
=for apidoc Am|SV*|GvSVn|GV* gv
Like C<L</GvSV>>, but creates an empty scalar if none already exists.

=for apidoc Am|SV*|GvSVnt|GV* gv|svtype sv_type
Like C<L</GvSVn>>, but creates an empty scalar whose type is already upgraded
to the requested type if none already exists. Note, if there is an existing
scalar already stored in the GV, its type is NOT upgraded, so you still must
do an C<SvUPGRADE> unless you are absolutly the scalar slot in the GV was
empty before, or if you allocated or created the GV immediatly before.
Note, all the I<sv_set**v()> functions do all necessary C<SvUPGRADE> type
logic checks for you. This macro exists to skip a 2nd pass through the
I<SV *> allocator subsystem. That 2nd pass skipped is the slow path of
C<SvUPGRADE> and swapping SV body types in the type upgrade.

=for apidoc Am|AV*|GvAV|GV* gv

Return the AV from the GV.
Expand All @@ -121,8 +132,12 @@ Return the CV from the GV.
#define GvSVn(gv) (*(GvGP(gv)->gp_sv ? \
&(GvGP(gv)->gp_sv) : \
&(GvGP(gv_SVadd(gv))->gp_sv)))
#define GvSVnt(_gv,_sv_type) (*(GvGP(_gv)->gp_sv ? \
&(GvGP(_gv)->gp_sv) : \
&(GvGP(gv_SVadd_type(_gv,_sv_type))->gp_sv)))
#else
#define GvSVn(gv) GvSV(gv)
#define GvSVnt(_gv,_sv_type) (((void)SvUPGRADE(GvSV(_gv),_sv_type)),GvSV(_gv))
#endif

#define GvREFCNT(gv) (GvGP(gv)->gp_refcnt)
Expand Down Expand Up @@ -347,6 +362,7 @@ Make sure there is a slot of the given type (AV, HV, IO, SV) in the GV C<gv>.
#define gv_HVadd(gv) gv_add_by_type((gv), SVt_PVHV)
#define gv_IOadd(gv) gv_add_by_type((gv), SVt_PVIO)
#define gv_SVadd(gv) gv_add_by_type((gv), SVt_NULL)
#define gv_SVadd_type(_gv,_sv_type) gv_add_by_type((_gv), (_sv_type))

/*
* ex: set ts=8 sts=4 sw=4 et:
Expand Down
5 changes: 5 additions & 0 deletions inline.h
Original file line number Diff line number Diff line change
Expand Up @@ -43,6 +43,11 @@ SOFTWARE.

/* ------------------------------- av.h ------------------------------- */

#undef newSV_type
#define newSV_type(ty) Perl_newSV_type##ty(aTHX)
#undef newSV_type_mortal
#define newSV_type_mortal(ty) Perl_newSV_type_mortal##ty(aTHX)

/*
=for apidoc_section $AV
=for apidoc av_count
Expand Down
14 changes: 13 additions & 1 deletion pad.c
Original file line number Diff line number Diff line change
Expand Up @@ -2219,7 +2219,19 @@ S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside, HV *cloned)

assert(!CvUNIQUE(proto));

if (!cv) cv = MUTABLE_CV(newSV_type(SvTYPE(proto)));
if (!cv) {
// if(SvTYPE(proto) != SVt_PVCV && SvTYPE(proto) != SVt_PVFM )
// __debugbreak();
if (SvTYPE(proto) == SVt_PVCV) {
cv = MUTABLE_CV(newSV_type(SVt_PVCV));
}
else if(SvTYPE(proto) == SVt_PVFM) {
cv = MUTABLE_CV(newSV_type(SVt_PVFM));
}
else {
croak("panic: S_cv_clone strange SV %u", SvTYPE(proto));
}
}
CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC
|CVf_SLABBED);
CvCLONED_on(cv);
Expand Down
7 changes: 3 additions & 4 deletions pp.c
Original file line number Diff line number Diff line change
Expand Up @@ -5982,10 +5982,9 @@ PP(pp_emptyavhv)
{
OP * const op = PL_op;
SV * rv;
SV * const sv = MUTABLE_SV( newSV_type(
(op->op_private & OPpEMPTYAVHV_IS_HV) ?
SVt_PVHV :
SVt_PVAV ) );
SV * const sv = MUTABLE_SV( (op->op_private & OPpEMPTYAVHV_IS_HV)
? newSV_type(SVt_PVHV)
: newSV_type(SVt_PVAV) );

/* Is it an assignment, just a stack push, or both?*/
if (op->op_private & OPpTARGET_MY) {
Expand Down
6 changes: 4 additions & 2 deletions pp_hot.c
Original file line number Diff line number Diff line change
Expand Up @@ -5995,8 +5995,10 @@ Perl_leave_adjust_stacks(pTHX_ SV **from_sp, SV **to_sp, U8 gimme, int pass)
* SvTYPE(sv), where that is a SVt_PVNV or below. It is
* more efficient to create such types directly than
* upgrade to them via sv_upgrade() within sv_setsv_flags. */
SV *newsv = (SvTYPE(sv) <= SVt_PVNV)
? newSV_type(SvTYPE(sv))
SV *newsv = SvTYPE(sv) == SVt_IV ? newSV_type(SVt_IV)
#if NVSIZE <= IVSIZE
: SvTYPE(sv) == SVt_NV ? newSV_type(SVt_NV)
#endif
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I haven't had time to check, but is this really correct? I thought SvTYPE(sv) could be types greater than SVt_NV at this point.

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

those are standard boiler plate handling of body-less NV optimization that I added years ago. IV all CPUs and OSes and NV on AMD x64 are bodyless so they have a much faster escape path in that function, vs than full body types.

: newSV_type(SVt_NULL);

PL_tmps_stack[++PL_tmps_ix] = *tmps_basep;
Expand Down
Loading