Skip to content

pp_ref() builtin_pp_reftype(): strlen()+Newx()+memcpy()->100% pre-made COWs #23391

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.

Sign up for GitHub

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 2 commits into
base: blead
Choose a base branch
from
Open

pp_ref() builtin_pp_reftype(): strlen()+Newx()+memcpy()->100% pre-made COWs #23391

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
aa5e4ce
add sv_refhek, sv_reftypehek functions for better ref() performance
bulk88 Jun 29, 2025
2ad59ed
mg.c pp.c pp_sys.c inline.h add more SV_CONST() SV* HEK* hash optimiz…
bulk88 Jun 30, 2025
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
36 changes: 31 additions & 5 deletions builtin.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -563,17 +563,43 @@ PP(pp_refaddr)

PP(pp_reftype)
{
dXSTARG;
SV *arg = *PL_stack_sp;
HEK *hek;
SV *rsv;
SV ** svp = PL_stack_sp;
SV *arg = *svp;

SvGETMAGIC(arg);

if(SvROK(arg))
sv_setpv_mg(TARG, sv_reftype(SvRV(arg), FALSE));
hek = sv_reftypehek(SvRV(arg), FALSE);
else
sv_setsv(TARG, &PL_sv_undef);
hek = NULL;

/* unrolled dXSTARG; avoid slower sv_setxv_mg(sv_newmortal(), ); */
if (PL_op->op_private & OPpENTERSUB_HASTARG) {
rsv = PAD_SV(PL_op->op_targ);
if (hek)
sv_sethek(rsv, hek);
/* If a PAD TARG exists, returning &PL_sv_undef will force a slow trip
through sv_setsv() in next OP, so do the undef assignment here,
with the streamlined sv_set_undef() call, vs universal and complex
sv_setsv() call. Note, the prior code here, only fired SMG magic
on the sv_sethek()/sv_setpvs() branch, not on the sv_set_undef()
branch. */
else
sv_set_undef(rsv);
SvSETMAGIC(rsv);
rpp_replace_1_1_NN(rsv); /* no RC_STK =, RC_STK RC++ = */
}
else {
if (!hek)
rpp_replace_1_IMM_NN(&PL_sv_undef);
else {
rsv = newSVhek(hek);
rpp_replace_at_norc(svp, rsv); /* no RC_STK mortal =, RC_STK RC++ = */
}
}

rpp_replace_1_1_NN(TARG);
return NORMAL;
}

Expand Down
5 changes: 4 additions & 1 deletion embed.fnc
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3366,9 +3366,12 @@ AMTdip |SV * |SvREFCNT_inc |NULLOK SV *sv
AMTdip |SV * |SvREFCNT_inc_NN|NN SV *sv
AMTdip |void |SvREFCNT_inc_void \
|NULLOK SV *sv
EXp |HEK * |sv_refhek |NN const SV * const sv \
|const int ob
ARdp |const char *|sv_reftype|NN const SV * const sv \
|const int ob

ERXp |HEK * |sv_reftypehek |NN const SV * const sv \
|const int ob
Adp |void |sv_regex_global_pos_clear \
|NN SV *sv
ARdp |bool |sv_regex_global_pos_get \
Expand Down
2 changes: 2 additions & 0 deletions embed.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1810,6 +1810,8 @@
# define skipspace_flags(a,b) Perl_skipspace_flags(aTHX_ a,b)
# define sv_magicext_mglob(a) Perl_sv_magicext_mglob(aTHX_ a)
# define sv_only_taint_gmagic Perl_sv_only_taint_gmagic
# define sv_refhek(a,b) Perl_sv_refhek(aTHX_ a,b)
# define sv_reftypehek(a,b) Perl_sv_reftypehek(aTHX_ a,b)
# define utf16_to_utf8_base(a,b,c,d,e,f) Perl_utf16_to_utf8_base(aTHX_ a,b,c,d,e,f)
# define utf8_to_utf16_base(a,b,c,d,e,f) Perl_utf8_to_utf16_base(aTHX_ a,b,c,d,e,f)
# define validate_proto(a,b,c,d) Perl_validate_proto(aTHX_ a,b,c,d)
Expand Down
10 changes: 8 additions & 2 deletions inline.h
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1176,6 +1176,11 @@ Perl_rpp_invoke_xs(pTHX_ CV *cv)
CvXSUB(cv)(aTHX_ cv);
}

/* SV_CONST() is limited to #ifdef PERL_CORE, so make a temporary macro. */
#define x_SV_CONST(name) PL_sv_consts[SV_CONST_##name] \
? PL_sv_consts[SV_CONST_##name] \
: (PL_sv_consts[SV_CONST_##name] = newSVpv_share(#name, 0))


/* for SvCANEXISTDELETE() macro in pp.h */
PERL_STATIC_INLINE bool
Expand All @@ -1188,10 +1193,11 @@ Perl_sv_can_existdelete(pTHX_ SV *sv)

HV *stash = SvSTASH(SvRV(SvTIED_obj(sv, mg)));
return stash &&
gv_fetchmethod_autoload(stash, "EXISTS", TRUE) &&
gv_fetchmethod_autoload(stash, "DELETE", TRUE);
gv_fetchmethod_sv_flags(stash, x_SV_CONST(EXISTS), GV_AUTOLOAD) &&
gv_fetchmethod_sv_flags(stash, x_SV_CONST(DELETE), GV_AUTOLOAD);
}

#undef x_SV_CONST

/* ----------------------------- regexp.h ----------------------------- */

Expand Down
3 changes: 1 addition & 2 deletions mg.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -2306,8 +2306,7 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg)
HV * const pkg = SvSTASH((const SV *)SvRV(tied));

PERL_ARGS_ASSERT_MAGIC_SCALARPACK;

if (!gv_fetchmethod_autoload(pkg, "SCALAR", FALSE)) {
if (!gv_fetchmethod_sv_flags(pkg, SV_CONST(SCALAR), 0)) {
SV *key;
if (HvEITER_get(hv))
/* we are in an iteration so the hash cannot be empty */
Expand Down
2 changes: 1 addition & 1 deletion op.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11080,7 +11080,7 @@ Perl_newATTRSUB_x(pTHX_ I32 floor, OP *o, OP *proto, OP *attrs,
gv = gv_fetchsv(sv, gv_fetch_flags, SVt_PVCV);
has_name = TRUE;
} else if (PL_curstash) {
gv = gv_fetchpvs("__ANON__", gv_fetch_flags, SVt_PVCV);
gv = gv_fetchsv(SV_CONST(__ANON__), gv_fetch_flags, SVt_PVCV);
has_name = FALSE;
} else {
gv = gv_fetchpvs("__ANON__::__ANON__", gv_fetch_flags, SVt_PVCV);
Expand Down
12 changes: 8 additions & 4 deletions pp.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -573,13 +573,13 @@ PP(pp_ref)

do_sv_ref:
{
HEK* hek = sv_refhek(SvRV(sv), TRUE);
dTARGET;
sv_ref(TARG, SvRV(sv), TRUE);
sv_sethek(TARG, hek);
rpp_replace_1_1_NN(TARG);
SvSETMAGIC(TARG);
return NORMAL;
}

}


Expand Down Expand Up @@ -681,8 +681,12 @@ PP(pp_gelem)
case 'P':
if (memEQs(elem, len, "PACKAGE")) {
const HV * const stash = GvSTASH(gv);
const HEK * const hek = stash ? HvNAME_HEK(stash) : NULL;
sv = hek ? newSVhek(hek) : newSVpvs("__ANON__");
const HEK * hek = stash ? HvNAME_HEK(stash) : NULL;
if (!hek) {
SV * sv_hek = SV_CONST(__ANON__);
hek = SvSHARED_HEK_FROM_PV(SvPVX_const(sv_hek));
}
sv = newSVhek(hek);
}
break;
case 'S':
Expand Down
38 changes: 19 additions & 19 deletions pp_sys.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1078,7 +1078,7 @@ PP_wrapped(pp_tie, 0, 1)
GV *gv = NULL;
SV *sv;
const SSize_t markoff = MARK - PL_stack_base;
const char *methname;
SV* methname;
int how = PERL_MAGIC_tied;
SSize_t items;
SV *varsv = *++MARK;
Expand All @@ -1087,7 +1087,7 @@ PP_wrapped(pp_tie, 0, 1)
case SVt_PVHV:
{
HE *entry;
methname = "TIEHASH";
methname = SV_CONST(TIEHASH);
if (HvLAZYDEL(varsv) && (entry = HvEITER_get((HV *)varsv))) {
HvLAZYDEL_off(varsv);
hv_free_ent(NULL, entry);
Expand All @@ -1097,7 +1097,7 @@ PP_wrapped(pp_tie, 0, 1)
break;
}
case SVt_PVAV:
methname = "TIEARRAY";
methname = SV_CONST(TIEARRAY);
if (!AvREAL(varsv)) {
if (!AvREIFY(varsv))
croak("Cannot tie unreifiable array");
Expand All @@ -1109,7 +1109,7 @@ PP_wrapped(pp_tie, 0, 1)
case SVt_PVGV:
case SVt_PVLV:
if (isGV_with_GP(varsv) && !SvFAKE(varsv)) {
methname = "TIEHANDLE";
methname = SV_CONST(TIEHANDLE);
how = PERL_MAGIC_tiedscalar;
/* For tied filehandles, we apply tiedscalar magic to the IO
slot of the GP rather than the GV itself. AMS 20010812 */
Expand All @@ -1124,7 +1124,7 @@ PP_wrapped(pp_tie, 0, 1)
}
/* FALLTHROUGH */
default:
methname = "TIESCALAR";
methname = SV_CONST(TIESCALAR);
how = PERL_MAGIC_tiedscalar;
break;
}
Expand All @@ -1137,7 +1137,7 @@ PP_wrapped(pp_tie, 0, 1)
while (items--)
PUSHs(*MARK++);
PUTBACK;
call_method(methname, G_SCALAR);
call_sv(methname, G_SCALAR | G_METHOD);
}
else {
/* Can't use call_method here, else this: fileno FOO; tie @a, "FOO"
Expand All @@ -1148,37 +1148,37 @@ PP_wrapped(pp_tie, 0, 1)
stash = gv_stashsv(*MARK, 0);
if (!stash) {
if (SvROK(*MARK))
DIE(aTHX_ "Can't locate object method %" PVf_QUOTEDPREFIX
DIE(aTHX_ "Can't locate object method %" SVf_QUOTEDPREFIX
" via package %" SVf_QUOTEDPREFIX,
methname, SVfARG(*MARK));
SVfARG(methname), SVfARG(*MARK));
else if (isGV(*MARK)) {
/* If the glob doesn't name an existing package, using
* SVfARG(*MARK) would yield "*Foo::Bar" or *main::Foo. So
* generate the name for the error message explicitly. */
SV *stashname = sv_newmortal();
gv_fullname4(stashname, (GV *) *MARK, NULL, FALSE);
DIE(aTHX_ "Can't locate object method %" PVf_QUOTEDPREFIX
DIE(aTHX_ "Can't locate object method %" SVf_QUOTEDPREFIX
" via package %" SVf_QUOTEDPREFIX,
methname, SVfARG(stashname));
SVfARG(methname), SVfARG(stashname));
}
else {
SV *stashname = !SvPOK(*MARK) ? &PL_sv_no
: SvCUR(*MARK) ? *MARK
: newSVpvs_flags("main", SVs_TEMP);
DIE(aTHX_ "Can't locate object method %" PVf_QUOTEDPREFIX
DIE(aTHX_ "Can't locate object method %" SVf_QUOTEDPREFIX
" via package %" SVf_QUOTEDPREFIX
" (perhaps you forgot to load %" SVf_QUOTEDPREFIX "?)",
methname, SVfARG(stashname), SVfARG(stashname));
SVfARG(methname), SVfARG(stashname), SVfARG(stashname));
}
}
else if (!(gv = gv_fetchmethod(stash, methname))) {
else if (!(gv = gv_fetchmethod_sv_flags(stash, methname, GV_AUTOLOAD))) {
/* The effective name can only be NULL for stashes that have
* been deleted from the symbol table, which this one can't
* be, since we just looked it up by name.
*/
DIE(aTHX_ "Can't locate object method %" PVf_QUOTEDPREFIX
DIE(aTHX_ "Can't locate object method %" SVf_QUOTEDPREFIX
" via package %" HEKf_QUOTEDPREFIX ,
methname, HvENAME_HEK_NN(stash));
SVfARG(methname), HvENAME_HEK_NN(stash));
}
ENTER_with_name("call_TIE");
PUSHSTACKi(PERLSI_MAGIC);
Expand Down Expand Up @@ -1229,7 +1229,7 @@ PP_wrapped(pp_untie, 1, 0)
if ((mg = SvTIED_mg(sv, how))) {
SV * const obj = SvRV(SvTIED_obj(sv, mg));
if (obj && SvSTASH(obj)) {
GV * const gv = gv_fetchmethod_autoload(SvSTASH(obj), "UNTIE", FALSE);
GV * const gv = gv_fetchmethod_sv_flags(SvSTASH(obj), SV_CONST(UNTIE), 0);
CV *cv;
if (gv && isGV(gv) && (cv = GvCV(gv))) {
PUSHMARK(SP);
Expand Down Expand Up @@ -1295,13 +1295,13 @@ PP_wrapped(pp_dbmopen, 3, 0)
GV *gv = NULL;

HV * const hv = MUTABLE_HV(POPs);
SV * const sv = newSVpvs_flags("AnyDBM_File", SVs_TEMP);
SV * const sv = sv_2mortal(newSVpvs_share("AnyDBM_File"));
stash = gv_stashsv(sv, 0);
if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH"))) {
if (!stash || !(gv = gv_fetchmethod_sv_flags(stash, SV_CONST(TIEHASH), GV_AUTOLOAD))) {
PUTBACK;
require_pv("AnyDBM_File.pm");
SPAGAIN;
if (!stash || !(gv = gv_fetchmethod(stash, "TIEHASH")))
if (!stash || !(gv = gv_fetchmethod_sv_flags(stash, SV_CONST(TIEHASH), GV_AUTOLOAD)))
DIE(aTHX_ "No dbm on this machine");
}

Expand Down
11 changes: 11 additions & 0 deletions proto.h
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading
Loading