Can POK CONST SVs share buffers for identical strings?

[richardleach]

Description
(Mentioned somewhere recently, I think by @bulk88, but I couldn't locate it just now.)

POK CONST OPs that happen to have the same string content will each have their own IsCOW buffer.
For example, when the following is compiled, there will be three distinct allocations containing the word "perl", each attached to a separate CONST OP's SV:

sub consts {
    my $x = "perl";
    if ($_[0] eq "perl") {
        say "perl"
    }
}

Having just one allocation for "perl" rather than three would seem nice. Is there a fundamental reason for the current implementation, or does it just predate the shared string table and COW mechanisms?

If it's just a case of tuits, what would the next steps be, and should the approach be shared strings in PL_strtab or something else that results in a shared buffers for such CONST OPs?

Note: toke.c produces OP_CONST OPs via multiple different, non-identical paths. Any sharing implementation might best be implemented as:

1. A proof-of-concept in Perl_ck_svconst that takes the OP's SVs as currently built and consolidates them.

Possibly in a later dev cycle:

2. Amend the multiple OP_CONST construction sites in toke.c such that the sharing happens earlier and more efficiently.

Perl configuration
Blead and previous.

[bulk88]

There are design problems I've stepped around, but never directly addresses, this pattern "drop the Newx() for COW->Newx()->memcpy()->Renew()->memcpy()->drop the Newx() for COW->Newx()->memcpy()->Renew()->memcpy()"

Here is a patch I didn't put up as a PR (too many open PRs sitting 0 replys), that speeds up alot of the core tests, because nothing and nobody in .xs land uses HEK*s but me, and OP tree only uses them for BAREWORD and {} literals,

0001-ext-B-B.xs-don-t-look-up-B-stashs-5K-min-to-9.8-mill.patch

I have a patch that I can't find right now that modified qw operator somewhere in toke or yy to always produce SV* HEK* COWss, since I'd love to have someone argue how qw op in src code is NOT always used for end user's identifiers, or how @EXPORT_OK will have method calls with names of -> and \x00\x00\x00. Why those EXPORT* arrays have to have COW 255 buffers or Newx() buffers inside of them all the time, makes no sense to me. They always become hash keys or subroutine names (same thing on C level) eventually in a process.

[bulk88]

This was the optimization I never published I was talking about in my last comment. Nobody normal uses => operator in PP to make a list initializer for a PP array, where left and right side of => are independent, random, isolated, pieces of data, example of abnormal => operator use:

my @last_workout_times_mins = ( 18 => 35, 32 =>27, 12 => 25);

Currently the VM forever keeps left side of => as a COW 255 or a Newx() buffer in a SV* in a (OP* || (PADSLOT in OP*) ) . Even though there is a 100% chance left side of => will flow into hv_common() as a key name at some point very soon, or at some point before proc exit.

 toke.c | 17 +++++++++++++++--
 1 file changed, 15 insertions(+), 2 deletions(-)

diff --git a/toke.c b/toke.c
index e6acb5a701..10538ba656 100644
--- a/toke.c
+++ b/toke.c
@@ -2244,6 +2244,18 @@ S_newSV_maybe_utf8(pTHX_ const char *const start, STRLEN len)
     return sv;
 }
 
+STATIC SV *
+S_newSVhek_maybe_utf8(pTHX_ const char *const start, STRLEN len)
+{
+    if ( len >= I32_MAX )
+        return S_newSV_maybe_utf8(aTHX_ start, len);
+    const bool isutf8 = !IN_BYTES && UTF && len != 0
+                        && is_utf8_non_invariant_string((const U8*)start, len)
+                        ? TRUE : FALSE;
+    SV * const sv = newSVpvn_share(start, isutf8 ? -len : len, 0);
+    return sv;
+}
+
 /*
  * S_force_word
  * When the lexer knows the next thing is a word (for instance, it has
@@ -5795,7 +5807,7 @@ yyl_secondclass_keyword(pTHX_ char *s, STRLEN len, int key, I32 *orig_keyword,
     }
     else {			/* no override */
         key = -key;
-        if (key == KEY_dump) {
+        if (key == KEY_dump,0) {
             croak("dump() must be written as CORE::dump() as of Perl 5.30");
         }
         *pgv = NULL;
@@ -7547,9 +7559,10 @@ static int
 yyl_fatcomma(pTHX_ char *s, STRLEN len)
 {
     CLINE;
+    //__debugbreak();
     pl_yylval.opval
         = newSVOP(OP_CONST, 0,
-                       S_newSV_maybe_utf8(aTHX_ PL_tokenbuf, len));
+                       S_newSVhek_maybe_utf8(aTHX_ PL_tokenbuf, len));
     pl_yylval.opval->op_private = OPpCONST_BARE;
     TERM(BAREWORD);
 }

Regarding HEK* handling in the VM. Probably for good sane design reasons, hv_common() is not allowed to rewrite into a HEK* COW the SvPVX() of the key_sv arg, that caller passed to hv_common(). But maybe that should be a new optional feature. The main reason is, if the caller in .xs or .c knows, they will never cat-on or rewrite that SV* POK because caller knows and intends for SV* POK to be a key name forever, then absolutely that SV* POK with a Newx() buf should immediately be changed to a HEK* buf the first time it ever gets passed to hv_common() and gets a PERL_HASH() executed.

There is a tragedy IMO that happens when code does

HE* he = hv_fetch_ent(hv, keysv, FALSE, 0);
if(!he) {
    hv_store_ent(hv, keysv, newSViv(3), 0);
}

PERL_HASH() executed 2x on same SV* addr, and same SvPVX() char * addr from an "opaque" allocator. Same tragedy happens, if you rewrite the demo code with hv_fetchs() and hv_stores().

[bulk88]

Why is newSVsv() not capable of COWing COW 255s or COW HEKs but sv_setsv(dsv, ssv) and sv_mortalcopy(sv) are allowed to COW COW 255s and COW HEKs #ifdef PERL_CORE?

I found this behavior while single stepping pp_unshift() along with unpublished hacks adding much more SVPV POK HEK COWs very early in the parser/op builder phase.

https://github.com/Perl/perl5/blob/b0823b6ac8032586c23cf6fa329c722fbf07e0fb/sv.h#L2559C1-L2562C57
https://github.com/Perl/perl5/blob/b0823b6ac8032586c23cf6fa329c722fbf07e0fb/sv.h#L2233C1-L2234C62

perl5/sv.h

Line 2271 in b0823b6

#define sv_mortalcopy(sv) \

////////////////////   sv.h
/* SV_NOSTEAL prevents TEMP buffers being, well, stolen, and saves games
   with SvTEMP_off and SvTEMP_on round a call to sv_setsv.  */
#define newSVsv(sv) newSVsv_flags((sv), SV_GMAGIC|SV_NOSTEAL)
#define newSVsv_nomg(sv) newSVsv_flags((sv), SV_NOSTEAL)

#define sv_setsv(dsv, ssv) \
        sv_setsv_flags(dsv, ssv, SV_GMAGIC|SV_DO_COW_SVSETSV)
#define sv_mortalcopy(sv) \
        Perl_sv_mortalcopy_flags(aTHX_ sv, SV_GMAGIC|SV_DO_COW_SVSETSV)
////////////////////   sv.c
SV *
Perl_newSVsv_flags(pTHX_ SV *const old, I32 flags)
{
    SV *sv;

    if (!old)
        return NULL;
    if (SvIS_FREED(old)) {
        ck_warner_d(packWARN(WARN_INTERNAL), "semi-panic: attempt to dup freed string");
        return NULL;
    }
    /* Do this here, otherwise we leak the new SV if this croaks. */
    if (flags & SV_GMAGIC)
        SvGETMAGIC(old);
    new_SV(sv);
    sv_setsv_flags(sv, old, flags & ~SV_GMAGIC);
    return sv;
}

[bulk88]

Inside func Perl_check_hash_fields_and_hekify(pTHX_ UNOP *rop, SVOP *key_op, int real) I noticed this maybe is the line that converts PP src code literals but IDK what kind of PP grammar literals, to SV* HEK* COWs.

Please verify the next sentence yourself on a normal unhacked blead!

What was interesting, all the old SV* head that will be freed, have sv_flags 0x18014403, and the 1 at the start means IsCOW flag, I checked SvLEN() is it 0x10 or more. So these are all COW 255s, being replaced by COW HEK*s, very "late" in the compile process.

Yeah, a ton of malloc memory will get user mode "logically" freed in the next 10 milliseconds, but I'm 80% sure, "Task Manager" will show no 4KB pages of Private Bytes were freed. After all of these 100s/1000s of free() calls done on tiny \w+ PP identifier strings held in Newx() storage aka COW 255 storage with RC==1/RC==0.

toke.c/yylex should've called newSVpvn_share() from the start, passing a ptr from PL_tokenbuf into newSVpvn_share(). No accidental PERL_HASH() calls or accidental PL_strtab HEK* entries would be added over current blead perl "baseline" behavior. I think. But this needs more thinking by more people.

        /* Make the CONST have a shared SV */
        if (   !SvIsCOW_shared_hash(sv = *svp)
            && SvTYPE(sv) < SVt_PVMG
            && SvOK(sv)
            && !SvROK(sv)
            && real)
        {
            SSize_t keylen;
            const char * const key = SvPV_const(sv, *(STRLEN*)&keylen);
            if (keylen > I32_MAX) {
                croak("Sorry, hash keys must be smaller than 2**31 bytes");
            }

            SV *nsv = newSVpvn_share(key, SvUTF8(sv) ? -(I32)keylen : (I32)keylen, 0); ///// <<<<<< HERE
            SvREFCNT_dec_NN(sv);
            *svp = nsv;
        }

Call stack show where and how COW 255s with SvREFCOUNT() == 1 and COW RC== 1 (or RC==0???) are turning into HEK COWs at BEGIN {} time. My eyes see Perl_rpeep() can do 2-6 do self-recursive calls to itself pretty often.

>	perl543.dll!Perl_newSVpvn_share(interpreter * my_perl, const char * src, long len, unsigned long hash) Line 9906	C
 	perl543.dll!Perl_check_hash_fields_and_hekify(interpreter * my_perl, unop * rop, svop * key_op, int real) Line 2795	C
 	perl543.dll!S_maybe_multideref(interpreter * my_perl, op * start, op * orig_o, unsigned __int64 orig_action, unsigned char hints) Line 2101	C
 	perl543.dll!Perl_rpeep(interpreter * my_perl, op * o) Line 2924	C
 	perl543.dll!Perl_rpeep(interpreter * my_perl, op * o) Line 2728	C
 	perl543.dll!S_process_optree(interpreter * my_perl, cv * cv, op * optree, op * start) Line 2834	C
 	perl543.dll!Perl_newATTRSUB_x(interpreter * my_perl, long floor, op * o, op * proto, op * attrs, op * block, bool o_is_gv) Line 11459	C
 	perl543.dll!Perl_yyparse(interpreter * my_perl, int gramtype) Line 455	C
 	perl543.dll!S_doeval_compile(interpreter * my_perl, unsigned char gimme, cv * outside, unsigned long seq, hv * hh) Line 4216	C
 	perl543.dll!S_require_file(interpreter * my_perl, sv * sv) Line 5316	C
 	perl543.dll!Perl_pp_require(interpreter * my_perl) Line 5350	C
 	perl543.dll!Perl_runops_standard(interpreter * my_perl) Line 41	C
 	perl543.dll!Perl_call_sv(interpreter * my_perl, sv * sv, long arg_flags) Line 3254	C
 	perl543.dll!Perl_call_list(interpreter * my_perl, long oldscope, av * paramList) Line 5323	C
 	perl543.dll!S_process_special_blocks(interpreter * my_perl, long floor, const char * const fullname, gv * const gv, cv * const cv) Line 11666	C
 	perl543.dll!Perl_newATTRSUB_x(interpreter * my_perl, long floor, op * o, op * proto, op * attrs, op * block, bool o_is_gv) Line 11500	C
 	perl543.dll!Perl_utilize(interpreter * my_perl, int aver, long floor, op * version, op * idop, op * arg) Line 8267	C
 	perl543.dll!Perl_yyparse(interpreter * my_perl, int gramtype) Line 461	C
 	perl543.dll!S_doeval_compile(interpreter * my_perl, unsigned char gimme, cv * outside, unsigned long seq, hv * hh) Line 4216	C
 	perl543.dll!S_require_file(interpreter * my_perl, sv * sv) Line 5316	C
 	perl543.dll!Perl_pp_require(interpreter * my_perl) Line 5350	C
 	perl543.dll!Perl_runops_standard(interpreter * my_perl) Line 41	C
 	perl543.dll!Perl_call_sv(interpreter * my_perl, sv * sv, long arg_flags) Line 3254	C
 	perl543.dll!Perl_call_list(interpreter * my_perl, long oldscope, av * paramList) Line 5323	C
 	perl543.dll!S_process_special_blocks(interpreter * my_perl, long floor, const char * const fullname, gv * const gv, cv * const cv) Line 11666	C
 	perl543.dll!Perl_newATTRSUB_x(interpreter * my_perl, long floor, op * o, op * proto, op * attrs, op * block, bool o_is_gv) Line 11500	C
 	perl543.dll!Perl_utilize(interpreter * my_perl, int aver, long floor, op * version, op * idop, op * arg) Line 8267	C
 	perl543.dll!Perl_yyparse(interpreter * my_perl, int gramtype) Line 461	C
 	perl543.dll!S_doeval_compile(interpreter * my_perl, unsigned char gimme, cv * outside, unsigned long seq, hv * hh) Line 4216	C
 	perl543.dll!S_require_file(interpreter * my_perl, sv * sv) Line 5316	C
 	perl543.dll!Perl_pp_require(interpreter * my_perl) Line 5350	C
 	perl543.dll!Perl_runops_standard(interpreter * my_perl) Line 41	C
 	perl543.dll!Perl_call_sv(interpreter * my_perl, sv * sv, long arg_flags) Line 3254	C
 	perl543.dll!Perl_call_list(interpreter * my_perl, long oldscope, av * paramList) Line 5323	C
 	perl543.dll!S_process_special_blocks(interpreter * my_perl, long floor, const char * const fullname, gv * const gv, cv * const cv) Line 11666	C
 	perl543.dll!Perl_newATTRSUB_x(interpreter * my_perl, long floor, op * o, op * proto, op * attrs, op * block, bool o_is_gv) Line 11500	C
 	perl543.dll!Perl_utilize(interpreter * my_perl, int aver, long floor, op * version, op * idop, op * arg) Line 8267	C
 	perl543.dll!Perl_yyparse(interpreter * my_perl, int gramtype) Line 461	C
 	perl543.dll!S_parse_body(interpreter * my_perl, char * * env, void(*)(interpreter *) xsinit) Line 2691	C
 	perl543.dll!perl_parse(interpreter * my_perl, void(*)(interpreter *) xsinit, int argc, char * * argv, char * * env) Line 1934	C
 	perl543.dll!RunPerl(int argc, char * * argv, char * * env) Line 209	C++
 	[Inline Frame] perl.exe!invoke_main() Line 78	C++
 	perl.exe!__scrt_common_main_seh() Line 288	C++
 	kernel32.dll!BaseThreadInitThunk�()	Unknown
 	ntdll.dll!RtlUserThreadStart�()	Unknown

[bulk88]

Made a trace of XSUB UNIVERSAL::can()'s 2nd arg SV* meth.

XSUB_UNIVERSAL__can_arg2_methname_trace_miniperl.txt

Why on earth are the Arg # 2'es and internal SVOPs/OP_CONSTs of UNIVERSAL::can() not BEGIN{} time turned into HEK* COWs?

And Arg # 2 will always get fed into the hv_common() on every possible permutation of if( SvPOK_on Arg # 1 && SvPOK_onArg # 2)`.

https://github.com/Perl/perl5/blob/cf7cc0a627da2ab1c0e64ac5a77bd2ca9c1a4e52/universal.c#L513C1-L521C2

    if (pkg) {
        GV * const gv = gv_fetchmethod_sv_flags(pkg, ST(1), 0);
        if (gv && isGV(gv))
            rv = sv_2mortal(newRV(MUTABLE_SV(GvCV(gv))));
    }

    ST(0) = rv;
    XSRETURN(1);
}

because pkg = gv_stashpvs("UNIVERSAL", 0); is going to always return true.

I think UNIVERSAL:: is like PL_defstash aka *main:: aka %{'main::'} or less likely *main. Your just not able to delete it from PP space or make HV* PL_defstash's RC drop to 0 and have the interp automatically set PL_defstash to NULL. Similar to perlvar.pod hash keys also can't be deleted from a stash no matter how hard you try. Or do they never become HE*->GV*->SV* sets b/c the GV*->SV* is burned into a PAD slot/op_targ slot and therefore burned into the immutable OP tree?

I've tried deleting and undefing*main::main, *main::main::, *main::, *main, %main::, %main, $main{main}, $main::{main}, $main{'main::'}, $main::{'main::'},. I wasn't successful at deleting from PP code that PP hash key and the typeglob it owns :-(

small sample of the attachment

SV = PV(0x1eef270) at 0x1e479c0
  REFCNT = 2
  FLAGS = (POK,IsCOW,pPOK)
  PV = 0x3f64a0 "canonpath"\0
  CUR = 9
  LEN = 16
  COW_REFCNT = 2
SV = PV(0x1eef270) at 0x1e479c0
  REFCNT = 2
  FLAGS = (POK,IsCOW,pPOK)
  PV = 0x3f64a0 "canonpath"\0
  CUR = 9
  LEN = 16
  COW_REFCNT = 2
SV = PV(0x1eef300) at 0x1e479d8
  REFCNT = 2
  FLAGS = (POK,IsCOW,pPOK)
  PV = 0x3f6480 "catdir"\0
  CUR = 6
  LEN = 16
  COW_REFCNT = 2
SV = PV(0x1eef300) at 0x1e479d8
  REFCNT = 2
  FLAGS = (POK,IsCOW,pPOK)
  PV = 0x3f6480 "catdir"\0
  CUR = 6
  LEN = 16
  COW_REFCNT = 2
SV = PV(0x1eef310) at 0x1e479f0
  REFCNT = 2
  FLAGS = (POK,IsCOW,pPOK)
  PV = 0x1d6fc40 "catfile"\0
  CUR = 7
  LEN = 16
  COW_REFCNT = 2
SV = PV(0x1eef310) at 0x1e479f0
  REFCNT = 2
  FLAGS = (POK,IsCOW,pPOK)
  PV = 0x1d6fc40 "catfile"\0
  CUR = 7
  LEN = 16
  COW_REFCNT = 2
SV = PV(0x1eef320) at 0x1e47a08
  REFCNT = 2
  FLAGS = (POK,IsCOW,pPOK)
  PV = 0x1d6f6e0 "curdir"\0
  CUR = 6
  LEN = 16
  COW_REFCNT = 2
SV = PV(0x1eef320) at 0x1e47a08
  REFCNT = 2
  FLAGS = (POK,IsCOW,pPOK)
  PV = 0x1d6f6e0 "curdir"\0
  CUR = 6
  LEN = 16
  COW_REFCNT = 2