Skip to content

Replace some sv_2mortal() instances with more direct equivalents #23153

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

Merged
merged 5 commits into from
Mar 31, 2025
Merged

Replace some sv_2mortal() instances with more direct equivalents #23153

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
5 commits
Select commit Hold shift + click to select a range
43cb571
Use newSVpvn_flags() rather than sv_2mortal(newSVpvn_utf8)
richardleach Mar 12, 2025
18c083d
do_readline: create new mortal with less branching
richardleach Mar 12, 2025
d1f6ac0
pp_system: use newSVtype_mortal instead of two functions
richardleach Mar 12, 2025
6cd3cbd
regcomp.c - create mortal HV/AV in one step
richardleach Mar 12, 2025
981d0f7
Perl_hv_common: sv_2mortal(newSVsv()) to sv_mortalcopy_flags()
richardleach Mar 24, 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
6 changes: 3 additions & 3 deletions class.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -472,7 +472,7 @@ static void S_ensure_module_version(pTHX_ SV *module, SV *version)
static void S_split_attr_nameval(pTHX_ SV *sv, SV **namp, SV **valp)
{
STRLEN svlen = SvCUR(sv);
bool do_utf8 = SvUTF8(sv);
U32 do_utf8 = SvUTF8(sv) ? SVf_UTF8 : 0;

const char *paren_at = (const char *)memchr(SvPVX(sv), '(', svlen);
if(paren_at) {
Expand All @@ -486,7 +486,7 @@ static void S_split_attr_nameval(pTHX_ SV *sv, SV **namp, SV **valp)
*/
/* diag_listed_as: SKIPME */
croak("Malformed attribute string");
*namp = sv_2mortal(newSVpvn_utf8(SvPVX(sv), namelen, do_utf8));
*namp = newSVpvn_flags(SvPVX(sv), namelen, SVs_TEMP|do_utf8);

const char *value_at = paren_at + 1;
const char *value_max = SvPVX(sv) + svlen - 2;
Expand All @@ -500,7 +500,7 @@ static void S_split_attr_nameval(pTHX_ SV *sv, SV **namp, SV **valp)
value_max -= 1;

if(value_max >= value_at)
*valp = sv_2mortal(newSVpvn_utf8(value_at, value_max - value_at + 1, do_utf8));
*valp = newSVpvn_flags(value_at, value_max - value_at + 1, SVs_TEMP|do_utf8);
else
*valp = NULL;
}
Expand Down
6 changes: 3 additions & 3 deletions hv.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -648,11 +648,11 @@ Perl_hv_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,

if (keysv || is_utf8) {
if (!keysv) {
keysv = newSVpvn_utf8(key, klen, TRUE);
keysv = newSVpvn_flags(key, klen, SVf_UTF8|SVs_TEMP);
} else {
keysv = newSVsv(keysv);
keysv = sv_mortalcopy_flags(keysv, SV_GMAGIC|SV_NOSTEAL);
}
mg_copy(MUTABLE_SV(hv), sv, (char *)sv_2mortal(keysv), HEf_SVKEY);
mg_copy(MUTABLE_SV(hv), sv, (char *)keysv, HEf_SVKEY);
} else {
mg_copy(MUTABLE_SV(hv), sv, key, klen);
}
Expand Down
6 changes: 4 additions & 2 deletions pp_hot.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4189,7 +4189,8 @@ Perl_do_readline(pTHX)
}
else {
/* XXX on RC builds, push on stack rather than mortalize ? */
sv = sv_2mortal(newSV(80));
sv = newSV_type_mortal(SVt_PV);
sv_grow_fresh(sv, 81);
Copy link
Contributor

Choose a reason for hiding this comment

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

What end the life of the sv head now that mortal is missing?
Why 81 bytes when old was 80?

Copy link
Contributor Author

Choose a reason for hiding this comment

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

What end the life of the sv head now that mortal is missing?

Thanks, it was meant to be newSV_type_mortal, I'll change that now.

Why 81 bytes when old was 80?

It's to keep the allocation size consistent: Perl_newSV calls sv_grow_fresh(sv, len + 1);.

Copy link
Contributor

Choose a reason for hiding this comment

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

Why 81 bytes when old was 80?

It's to keep the allocation size consistent: Perl_newSV calls sv_grow_fresh(sv, len + 1);.

Be very very careful and single step it line by line if your making assumptions about +1s and perl's PV/NewX API. This class of bugs already is sitting in stable and blead perl. "can't introduce an exploit" "safe than sorry" +1 +1, another 16 or 32 bytes just disappeared times a couple 1000. All these +1s and the PERL_STR_RNDUP macro are very fragile. Open PR with this class of bug

#22879

Copy link
Contributor

Choose a reason for hiding this comment

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

update:
the off by 1 in

#23153

goes back to your commit at

64b4056614429bb6fc7d35118e19a220459358fd

I suggest you single step the C code and verify what integer from the interp is entering glibc.so func since you/nobody else (including me) understands this area of the SVPV API anymore. Short made up demo math of the details in #23153

80/8=10, aligned!
(81+7)&(~7)=88
(81+15)&(~15)=96

Atleast use bytes 82-95 on a PP C level if you paided for them from libc, but this 1+1+15 then !0xF mask over and ever. needs to be stopped.

Copy link
Contributor

Choose a reason for hiding this comment

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

The +1 is done by the normal Perl_sv_grow() for the default COW build as well, sv_grow_fresh simply duplicates that.

That said, the exact value doesn't matter too much.

Copy link
Contributor

Choose a reason for hiding this comment

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

This commit does create/leave behind 100% unused bytes (~1 upto ~15 bytes). But probably the old code before this commit also did (an 80 byte null term PV will always be 81 bytes of real VM). So the "fix" is moving the byte length const to 72-1 or 72-2, or 88-1 or 88-2 or 96-1 or 96-2. But count 80 is the magic shell terminal line length since 1970, which might mean something in this particular area of the interp, so 72 or 96 might change some other runtime observable behavior without reading/studying more src code.

Test code to play around with on 5.41.7 winperl64.

Malloc bucket jump happens at 81 and 97. Don't ask me why CRT realloc() / HeapReAlloc() / RtlReallocateHeap() move the memory block 100% redundantly between a pair of constant addresses on each realloc() +1 call.

Spectre security fix by MS ?????

Someone else is free to try out my demo code on Win11 or Glibc or OSX.

perl cppinl.pl 71 71 1 


#use Inline  ('force', 'noclean');

use Inline C => Config =>
  PRE_HEAD => '#define PERL_NO_GET_CONTEXT 1';
 use Inline C => Config => BUILD_NOISY => 1;

 use Inline C => <<'END_OF_C_CODE';

 #define tm(_sv) if(1) { \
 int lc=0; \
 for( ;lc < 64; lc++) { \
      char * p = SvPVX(_sv); \
      char *op = p; \
      size_t ol = SvLEN(_sv); \
     size_t pl = ol+1; \
       Renew(p, pl, char); \
      SvPV_set(_sv, p); \
      SvLEN_set(_sv, pl); \
      if(p != op) \
        warn("try %3d 0x%x b4 %p af %p\n", pl, pl, p, op); \
}}

 SV* do3(int i1, int i2, int dtorsv1) {
  dTHX;
   SV* s1 = newSV(i1);
   warn("**newSV**\n");
   sv_dump(s1);
   if (dtorsv1) {
     warn("**newSV**\n");
     tm(s1);
      SvREFCNT_dec_NN(s1);
   }
   SV* s2 = newSV_type(SVt_PV);
   sv_grow_fresh(s2, i2);
   warn("**grow_fresh**\n");
   sv_dump(s2);
   
   if (! dtorsv1) {
   warn("**newSV**\n");
     tm(s1);
     }
   warn("**grow_fresh**\n");
   tm(s2);
   return s2;
}


END_OF_C_CODE


$, = "\n";

use v5.41;
do3($ARGV[0],$ARGV[1],$ARGV[2]);

**newSV**
SV = PV(0x34ac38) at 0x349fa0
  REFCNT = 1
  FLAGS = ()
  PV = 0x3781b8 ""
  CUR = 0
  LEN = 73
**newSV**
try  74 0x4a b4 378298 af 3781b8
try  75 0x4b b4 3781b8 af 378298
try  76 0x4c b4 378298 af 3781b8
try  77 0x4d b4 3781b8 af 378298
try  78 0x4e b4 378298 af 3781b8
try  79 0x4f b4 3781b8 af 378298
try  80 0x50 b4 378298 af 3781b8
try  81 0x51 b4 3665c8 af 378298
try  82 0x52 b4 3666c8 af 3665c8
try  83 0x53 b4 3665c8 af 3666c8
try  84 0x54 b4 3666c8 af 3665c8
try  85 0x55 b4 3665c8 af 3666c8
try  86 0x56 b4 3666c8 af 3665c8
try  87 0x57 b4 3665c8 af 3666c8
try  88 0x58 b4 3666c8 af 3665c8
try  89 0x59 b4 3665c8 af 3666c8
try  90 0x5a b4 3666c8 af 3665c8
try  91 0x5b b4 3665c8 af 3666c8
try  92 0x5c b4 3666c8 af 3665c8
try  93 0x5d b4 3665c8 af 3666c8
try  94 0x5e b4 3666c8 af 3665c8
try  95 0x5f b4 3665c8 af 3666c8
try  96 0x60 b4 3666c8 af 3665c8
try  97 0x61 b4 2398748 af 3666c8
try  98 0x62 b4 2398868 af 2398748
try  99 0x63 b4 2398748 af 2398868
try 100 0x64 b4 2398868 af 2398748
try 101 0x65 b4 2398748 af 2398868
try 102 0x66 b4 2398868 af 2398748
try 103 0x67 b4 2398748 af 2398868
try 104 0x68 b4 2398868 af 2398748
try 105 0x69 b4 2398748 af 2398868
try 106 0x6a b4 2398868 af 2398748
try 107 0x6b b4 2398748 af 2398868
try 108 0x6c b4 2398868 af 2398748
try 109 0x6d b4 2398748 af 2398868
try 110 0x6e b4 2398868 af 2398748
try 111 0x6f b4 2398748 af 2398868
try 112 0x70 b4 2398868 af 2398748
try 113 0x71 b4 23f32a8 af 2398868
try 114 0x72 b4 23f3168 af 23f32a8
try 115 0x73 b4 23f32a8 af 23f3168
try 116 0x74 b4 23f3168 af 23f32a8
try 117 0x75 b4 23f32a8 af 23f3168
try 118 0x76 b4 23f3168 af 23f32a8
try 119 0x77 b4 23f32a8 af 23f3168
try 120 0x78 b4 23f3168 af 23f32a8
try 121 0x79 b4 23f32a8 af 23f3168
try 122 0x7a b4 23f3168 af 23f32a8
try 123 0x7b b4 23f32a8 af 23f3168
try 124 0x7c b4 23f3168 af 23f32a8
try 125 0x7d b4 23f32a8 af 23f3168
try 126 0x7e b4 23f3168 af 23f32a8
try 127 0x7f b4 23f32a8 af 23f3168
try 128 0x80 b4 23f3168 af 23f32a8
try 129 0x81 b4 390028 af 23f3168
try 130 0x82 b4 390188 af 390028
try 131 0x83 b4 390028 af 390188
try 132 0x84 b4 390188 af 390028
try 133 0x85 b4 390028 af 390188
try 134 0x86 b4 390188 af 390028
try 135 0x87 b4 390028 af 390188
try 136 0x88 b4 390188 af 390028
try 137 0x89 b4 390028 af 390188
**grow_fresh**
SV = PV(0x34ac38) at 0x349fa0
  REFCNT = 1
  FLAGS = ()
  PV = 0x378298 ""
  CUR = 0
  LEN = 72
**grow_fresh**
try  73 0x49 b4 3781b8 af 378298
try  74 0x4a b4 378298 af 3781b8
try  75 0x4b b4 3781b8 af 378298
try  76 0x4c b4 378298 af 3781b8
try  77 0x4d b4 3781b8 af 378298
try  78 0x4e b4 378298 af 3781b8
try  79 0x4f b4 3781b8 af 378298
try  80 0x50 b4 378298 af 3781b8
try  81 0x51 b4 3666c8 af 378298
try  82 0x52 b4 3665c8 af 3666c8
try  83 0x53 b4 3666c8 af 3665c8
try  84 0x54 b4 3665c8 af 3666c8
try  85 0x55 b4 3666c8 af 3665c8
try  86 0x56 b4 3665c8 af 3666c8
try  87 0x57 b4 3666c8 af 3665c8
try  88 0x58 b4 3665c8 af 3666c8
try  89 0x59 b4 3666c8 af 3665c8
try  90 0x5a b4 3665c8 af 3666c8
try  91 0x5b b4 3666c8 af 3665c8
try  92 0x5c b4 3665c8 af 3666c8
try  93 0x5d b4 3666c8 af 3665c8
try  94 0x5e b4 3665c8 af 3666c8
try  95 0x5f b4 3666c8 af 3665c8
try  96 0x60 b4 3665c8 af 3666c8
try  97 0x61 b4 2398868 af 3665c8
try  98 0x62 b4 2398748 af 2398868
try  99 0x63 b4 2398868 af 2398748
try 100 0x64 b4 2398748 af 2398868
try 101 0x65 b4 2398868 af 2398748
try 102 0x66 b4 2398748 af 2398868
try 103 0x67 b4 2398868 af 2398748
try 104 0x68 b4 2398748 af 2398868
try 105 0x69 b4 2398868 af 2398748
try 106 0x6a b4 2398748 af 2398868
try 107 0x6b b4 2398868 af 2398748
try 108 0x6c b4 2398748 af 2398868
try 109 0x6d b4 2398868 af 2398748
try 110 0x6e b4 2398748 af 2398868
try 111 0x6f b4 2398868 af 2398748
try 112 0x70 b4 2398748 af 2398868
try 113 0x71 b4 23f3168 af 2398748
try 114 0x72 b4 23f32a8 af 23f3168
try 115 0x73 b4 23f3168 af 23f32a8
try 116 0x74 b4 23f32a8 af 23f3168
try 117 0x75 b4 23f3168 af 23f32a8
try 118 0x76 b4 23f32a8 af 23f3168
try 119 0x77 b4 23f3168 af 23f32a8
try 120 0x78 b4 23f32a8 af 23f3168
try 121 0x79 b4 23f3168 af 23f32a8
try 122 0x7a b4 23f32a8 af 23f3168
try 123 0x7b b4 23f3168 af 23f32a8
try 124 0x7c b4 23f32a8 af 23f3168
try 125 0x7d b4 23f3168 af 23f32a8
try 126 0x7e b4 23f32a8 af 23f3168
try 127 0x7f b4 23f3168 af 23f32a8
try 128 0x80 b4 23f32a8 af 23f3168
try 129 0x81 b4 390028 af 23f32a8
try 130 0x82 b4 390188 af 390028
try 131 0x83 b4 390028 af 390188
try 132 0x84 b4 390188 af 390028
try 133 0x85 b4 390028 af 390188
try 134 0x86 b4 390188 af 390028
try 135 0x87 b4 390028 af 390188
try 136 0x88 b4 390188 af 390028

Copy link
Contributor Author

Choose a reason for hiding this comment

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

But count 80 is the magic shell terminal line length since 1970, which might mean something in this particular area of the interp, so 72 or 96 might change some other runtime observable behavior without reading/studying more src code.

Yeah, this was the main motivation for preserving the 80 + 1 behaviour in that commit.

offset = 0;
}

Expand Down Expand Up @@ -4316,7 +4317,8 @@ Perl_do_readline(pTHX)
SvPV_shrink_to_cur(sv);
}
/* XXX on RC builds, push on stack rather than mortalize ? */
sv = sv_2mortal(newSV(80));
sv = newSV_type_mortal(SVt_PV);
sv_grow_fresh(sv, 81);
continue;
}

Expand Down
3 changes: 1 addition & 2 deletions pp_sys.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -4612,8 +4612,7 @@ PP_wrapped(pp_system, 0, 1)
* as numeric, not just retain the string value.
*/
if (SvNIOK(origsv) || SvNIOKp(origsv)) {
copysv = newSV_type(SVt_PVNV);
sv_2mortal(copysv);
copysv = newSV_type_mortal(SVt_PVNV);
if (SvPOK(origsv) || SvPOKp(origsv)) {
pv = SvPV_nomg(origsv, len);
sv_setpvn_fresh(copysv, pv, len);
Expand Down
10 changes: 4 additions & 6 deletions regcomp.c
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -3562,11 +3562,9 @@ S_reg(pTHX_ RExC_state_t *pRExC_state, I32 paren, I32 *flagp, U32 depth)
Perl_croak(aTHX_
"panic: reg_scan_name returned NULL");
if (!RExC_paren_names) {
RExC_paren_names = newHV();
sv_2mortal(MUTABLE_SV(RExC_paren_names));
RExC_paren_names = MUTABLE_HV(newSV_type_mortal(SVt_PVHV));
#ifdef DEBUGGING
RExC_paren_name_list = newAV();
sv_2mortal(MUTABLE_SV(RExC_paren_name_list));
RExC_paren_name_list = MUTABLE_AV(newSV_type_mortal(SVt_PVAV));
#endif
}
he_str = hv_fetch_ent( RExC_paren_names, svname, 1, 0 );
Expand Down Expand Up @@ -7685,8 +7683,8 @@ Perl_populate_anyof_bitmap_from_invlist(pTHX_ regnode *node, SV** invlist_ptr)
#define ADD_POSIX_WARNING(p, text) STMT_START { \
if (posix_warnings) { \
if (! RExC_warn_text ) RExC_warn_text = \
(AV *) sv_2mortal((SV *) newAV()); \
av_push_simple(RExC_warn_text, Perl_newSVpvf(aTHX_ \
MUTABLE_AV(newSV_type_mortal(SVt_PVAV)); \
av_push_simple(RExC_warn_text, Perl_newSVpvf(aTHX_ \
WARNING_PREFIX \
text \
REPORT_LOCATION, \
Expand Down
Loading