Skip to content

Commit

Permalink
experiment failed 48 copies of struct bodies_by_type_STAT
Browse files Browse the repository at this point in the history
  • Loading branch information
@bulk88
bulk88 committed Oct 14, 2024
1 parent c593dad commit a98b094
Show file tree
Hide file tree
Showing 7 changed files with 411 additions and 41 deletions.
59 changes: 46 additions & 13 deletions gv.c
View file
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,8 +95,39 @@ Perl_gv_add_by_type(pTHX_ GV *gv, svtype type)

if (!*where)
{
__debugbreak();
*where = Perl_newSV_typeX(pTHX_ 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 @@ -578,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 @@ -2331,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 @@ -2359,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 @@ -2389,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 @@ -2418,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
View file
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
13 changes: 11 additions & 2 deletions pad.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -2220,8 +2220,17 @@ S_cv_clone(pTHX_ CV *proto, CV *cv, CV *outside, HV *cloned)
assert(!CvUNIQUE(proto));

if (!cv) {
__debugbreak();
cv = MUTABLE_CV(Perl_newSV_typeX(pTHX_ SvTYPE(proto)));
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 {
__debugbreak();
}
}
CvFLAGS(cv) = CvFLAGS(proto) & ~(CVf_CLONE|CVf_WEAKOUTSIDE|CVf_CVGV_RC
|CVf_SLABBED);
Expand Down
4 changes: 2 additions & 2 deletions pp.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -5983,8 +5983,8 @@ PP(pp_emptyavhv)
OP * const op = PL_op;
SV * rv;
SV * const sv = MUTABLE_SV( (op->op_private & OPpEMPTYAVHV_IS_HV)
? Perl_newSV_type(SVt_PVHV)
: Perl_newSV_type(SVt_PVAV) );
? 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
9 changes: 6 additions & 3 deletions sv.c
View file
Original file line number Diff line number Diff line change
Expand Up @@ -29,6 +29,9 @@

#include "EXTERN.h"
#define PERL_IN_SV_C
//#if defined(DEBUGGING)
# define WANT_SV_BODY_DETAILS
//#endif
#include "perl.h"
#include "regcomp.h"
#ifdef __VMS
Expand Down Expand Up @@ -5441,14 +5444,14 @@ Perl_sv_force_normal_flags(pTHX_ SV *const sv, const U32 flags)
svtype new_type;
SV * temp;
if(islv) {
temp = Perl_newSV_type(SVt_NULL);
temp = newSV_type(SVt_NULL);
new_type = SVt_NULL;
} else if (SvMAGIC(sv) || SvSTASH(sv)) {
temp = Perl_newSV_type(SVt_PVMG);
temp = newSV_type(SVt_PVMG);
new_type = SVt_PVMG;
}
else {
temp = Perl_newSV_type(SVt_PV);
temp = newSV_type(SVt_PV);
new_type = SVt_PV;
}
regexp *old_rx_body;
Expand Down
Loading

0 comments on commit a98b094

Please sign in to comment.