Skip to content
This repository has been archived by the owner on Jun 1, 2023. It is now read-only.

Commit

Permalink
WIP keep immortals in arrays asis
Browse files Browse the repository at this point in the history
i.e. -e"print [!0]->[0]"
See GH #413

Unfortunately we cannot fix the main culprit sv_setsv_flags, as we cannot set the
pointer of dest, only the value. So we need to fix the callers.
The SV values for arrays and hashes.

Problem with this one:
cperl -Dt -e'$a=[undef,undef];$a->[0]=1'
(-e:0)	enter
(-e:0)	nextstate
(-e:1)	pushmark
(-e:1)	undef
(-e:1)	undef
(-e:1)	anonlist
(-e:1)	gvsv(main::a)
(-e:1)	sassign
(-e:1)	nextstate
(-e:1)	const(IV(1))
(-e:1)	multideref($a->[0])
(-e:1)	sassign
Modification of a read-only value attempted SV_UNDEF at sv.c:4283 at -e line 1.

Apparently array elements need to be writable, immortals are forbidden.
Which blows up memory for all arrays/sets of immortals (yes,no,undef).
So allow writing to immortals in arrays/hashes, set the SPECIAL flag to sassign,
as with const init: my $i:const = 1
The no modify warning is only to prevent undef=1 or yes=0, which is easier preventable.
  • Loading branch information
rurban committed May 18, 2020
1 parent 73cbb17 commit 0732b20
Show file tree
Hide file tree
Showing 2 changed files with 21 additions and 8 deletions.
11 changes: 8 additions & 3 deletions av.c
Original file line number Diff line number Diff line change
Expand Up @@ -477,9 +477,14 @@ Perl_av_make(pTHX_ SSize_t size, SV **strp)

SvGETMAGIC(*strp); /* before newSV, in case it dies */
AvFILLp(av)++;
ary[i] = newSV(0);
sv_setsv_flags(ary[i], *strp,
SV_DO_COW_SVSETSV|SV_NOSTEAL);
/* keep most immortals asis. cperl only. */
if (SvIMMORTAL(*strp)) {
ary[i] = *strp;
} else {
ary[i] = newSV(0);
sv_setsv_flags(ary[i], *strp,
SV_DO_COW_SVSETSV|SV_NOSTEAL);
}
strp++;
}
/* disarm av's leak guard */
Expand Down
18 changes: 13 additions & 5 deletions pp_hot.c
Original file line number Diff line number Diff line change
Expand Up @@ -264,11 +264,19 @@ PPt(pp_sassign, "(:Scalar,:Scalar):Scalar")
"Useless assignment to a temporary");
}
/* my $i :const = val; initialization must temp. lift constness */
if (UNLIKELY(OpSPECIAL(PL_op) && SvREADONLY(left))) {
SvREADONLY_off(left);
SvSetMagicSV(left, right);
SETs(left);
SvREADONLY_on(left);
else if (UNLIKELY(OpSPECIAL(PL_op) && SvREADONLY(left))) {
/* allow writing to array/hash elements */
if (SvIMMORTAL(left)) { /* $a=[undef];$a->[0]=1 */
/* left = newSV(0); */
left = right;
SvSETMAGIC(left);
SETs(left);
} else {
SvREADONLY_off(left);
SvSetMagicSV(left, right);
SETs(left);
SvREADONLY_on(left);
}
} else {
SvSetMagicSV(left, right);
SETs(left);
Expand Down

0 comments on commit 0732b20

Please sign in to comment.