diff --git a/Cross/Makefile-cross-SH b/Cross/Makefile-cross-SH index 0abd0a43dd31..4ca238d90eea 100644 --- a/Cross/Makefile-cross-SH +++ b/Cross/Makefile-cross-SH @@ -333,7 +333,7 @@ unidatafiles = lib/unicore/Decomposition.pl lib/unicore/TestProp.pl \ unidatadirs = lib/unicore/To lib/unicore/lib h1 = EXTERN.h INTERN.h XSUB.h av.h xconfig.h cop.h cv.h dosish.h -h2 = embed.h form.h gv.h handy.h hv.h hv_func.h keywords.h mg.h op.h opcode.h +h2 = embed.h form.h gv.h handy.h hekpool.h hv.h hv_func.h keywords.h mg.h op.h opcode.h h3 = pad.h patchlevel.h perl.h perlapi.h perly.h pp.h proto.h regcomp.h h4 = regexp.h scope.h sv.h unixish.h util.h iperlsys.h thread.h h5 = utf8.h warnings.h diff --git a/MANIFEST b/MANIFEST index fe207f70e7df..76457e34d3a9 100644 --- a/MANIFEST +++ b/MANIFEST @@ -42,6 +42,7 @@ globvar.sym Global variables that need hiding when embedded gv.c Glob value code gv.h Glob value header handy.h Handy definitions +hekpool.h hv.c Hash value code hv.h Hash value header hv_func.h Hash value static inline function header @@ -5950,6 +5951,7 @@ regen/embed_lib.pl Reads embed.fnc and regen/opcodes regen/feature.pl Generates feature.pm regen/genpacksizetables.pl Generate the size tables for pack/unpack regen/HeaderParser.pm Module used to parse header files +regen/hekpool.pl Updates/creates hekpool.h regen/keywords.pl Program to write keywords.h regen/lib_cleanup.pl Generate lib/.gitignore from MANIFEST regen/locale.pl Program to write locale_table.h diff --git a/Makefile.SH b/Makefile.SH index 3c3b6b8d959d..d2469fb4bc86 100755 --- a/Makefile.SH +++ b/Makefile.SH @@ -531,7 +531,7 @@ unidatadirs = lib/unicore/To lib/unicore/lib h = \ EXTERN.h INTERN.h XSUB.h \ av.h charclass_invlists.h cop.h cv.h dosish.h embed.h form.h gv.h \ - handy.h hv.h hv_func.h iperlsys.h keywords.h l1_char_class_tab.h \ + handy.h hekpool.h hv.h hv_func.h iperlsys.h keywords.h l1_char_class_tab.h \ mg.h mydtrace.h op.h op_reg_common.h opcode.h pad.h patchlevel.h \ perl.h perlapi.h perly.h pp.h proto.h regcomp.h regcomp_internal.h \ regexp.h scope.h sv.h thread.h unixish.h utf8.h util.h warnings.h \ diff --git a/av.c b/av.c index 7f49ad2a155e..0b8ed1c95ca6 100644 --- a/av.c +++ b/av.c @@ -83,7 +83,7 @@ Perl_av_extend(pTHX_ AV *av, SSize_t key) * we call the tied method. */ sv_setiv(arg1, (IV)(key + 1)); - Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(EXTEND), G_DISCARD, 1, + Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST2(EXTEND), G_DISCARD, 1, arg1); return; } @@ -799,7 +799,7 @@ Perl_av_push(pTHX_ AV *av, SV *val) Perl_croak_no_modify(); if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { - Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(PUSH), G_DISCARD, 1, + Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST2(PUSH), G_DISCARD, 1, val); return; } @@ -830,7 +830,7 @@ Perl_av_pop(pTHX_ AV *av) if (SvREADONLY(av)) Perl_croak_no_modify(); if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { - retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(POP), 0, 0); + retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST2(POP), 0, 0); if (retval) retval = newSVsv(retval); return retval; @@ -890,7 +890,7 @@ Perl_av_unshift(pTHX_ AV *av, SSize_t num) Perl_croak_no_modify(); if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { - Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(UNSHIFT), + Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST2(UNSHIFT), G_DISCARD | G_UNDEF_FILL, num); return; } @@ -956,7 +956,7 @@ Perl_av_shift(pTHX_ AV *av) if (SvREADONLY(av)) Perl_croak_no_modify(); if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { - retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(SHIFT), 0, 0); + retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST2(SHIFT), 0, 0); if (retval) retval = newSVsv(retval); return retval; @@ -1034,7 +1034,7 @@ Perl_av_fill(pTHX_ AV *av, SSize_t fill) if ((mg = SvTIED_mg((const SV *)av, PERL_MAGIC_tied))) { SV *arg1 = sv_newmortal(); sv_setiv(arg1, (IV)(fill + 1)); - Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST(STORESIZE), G_DISCARD, + Perl_magic_methcall(aTHX_ MUTABLE_SV(av), mg, SV_CONST2(STORESIZE), G_DISCARD, 1, arg1); return; } diff --git a/class.c b/class.c index 3f4b6ac8dbe0..46e4faa486b0 100644 --- a/class.c +++ b/class.c @@ -463,7 +463,8 @@ static void S_ensure_module_version(pTHX_ SV *module, SV *version) PUSHMARK(PL_stack_sp); rpp_xpush_2(module, version); - call_method("VERSION", G_VOID); + /* call_method("VERSION", G_VOID); */ + call_sv(SV_CONST2(VERSION), G_VOID | G_METHOD); LEAVE; } diff --git a/configpm b/configpm index 07219d8e075c..fabfcc73fbae 100755 --- a/configpm +++ b/configpm @@ -77,7 +77,7 @@ my %Extensions = map {($_,$_)} # This is the list from MM_VMS, plus pad.h, parser.h, utf8.h # which it installs. It *doesn't* install perliol.h - FIXME. my @header_files = qw(EXTERN.h INTERN.h XSUB.h av.h config.h cop.h cv.h - embed.h embedvar.h form.h gv.h handy.h hv.h hv_func.h intrpvar.h + embed.h embedvar.h form.h gv.h handy.h hekpool.h hv.h hv_func.h intrpvar.h iperlsys.h keywords.h mg.h nostdio.h op.h opcode.h pad.h parser.h patchlevel.h perl.h perlio.h perlsdio.h perlvars.h perly.h pp.h pp_proto.h proto.h diff --git a/cop.h b/cop.h index 1d85a08cb348..c998009a1447 100644 --- a/cop.h +++ b/cop.h @@ -683,6 +683,22 @@ typedef struct rcpv RCPV; #endif /* USE_ITHREADS */ +/* A cache of the last CopFILE char *, that was turned into a HEK*, probably + to be stored in a GP*. This is a cache. HEK* might be stale, always compare + it to the current CopFILE. This cache prevents alot of repetitive work + in Perl_newGP(), PERL_HASH(), share_hek_flags(), and HvARRAY(PL_strtab). */ +struct cop_lastfile { + char * copfile_unsafe; /* unsafe to deref, ptr that was used to create + this HEK*, the ptr was originally from CopFILE(PL_curcop). + The copfile_unsafe does not have any ownership or any RC on the ptr in it. + It could be freed by now. char * copfile_unsafe is only used as a == + against the current char * (which has an undefined allocator), to skip + the memcmp(). The == will likely pass b/c of the RCPV API. RCPV is an + internals detail we don't know about. */ + HEK * cached_file; /* This field owns a RC +1 HEK*. If old HEK* + is not NULL, it must be --ed. New HEK* must be ++ed. */ +}; + #define CopSTASHPV(c) (CopSTASH(c) ? HvNAME_get(CopSTASH(c)) : NULL) /* cop_stash is not refcounted */ #define CopSTASHPV_set(c,pv) CopSTASH_set((c), gv_stashpv(pv,GV_ADD)) diff --git a/doio.c b/doio.c index 2089c91b996e..b9230d028058 100644 --- a/doio.c +++ b/doio.c @@ -1403,7 +1403,7 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) SAVEFREESV(old_out_name); if (!PL_argvoutgv) - PL_argvoutgv = gv_fetchpvs("ARGVOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO); + PL_argvoutgv = gv_fetchsv_nomg(SV_CONST2(ARGVOUT), GV_ADD|GV_NOTQUAL, SVt_PVIO); if (io && (IoFLAGS(io) & (IOf_ARGV|IOf_START)) == (IOf_ARGV|IOf_START)) { IoFLAGS(io) &= ~IOf_START; if (PL_inplace) { @@ -1473,7 +1473,7 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) TAINT_PROPER("inplace open"); if (oldlen == 1 && *PL_oldname == '-') { - setdefout(gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, + setdefout(gv_fetchsv_nomg(SV_CONST2(STDOUT), GV_ADD|GV_NOTQUAL, SVt_PVIO)); return IoIFP(GvIOp(gv)); } @@ -1604,7 +1604,7 @@ Perl_nextargv(pTHX_ GV *gv, bool nomagicopen) SvREFCNT_dec_NN(oldout); return NULL; } - setdefout(gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO)); + setdefout(gv_fetchsv_nomg(SV_CONST2(STDOUT), GV_ADD|GV_NOTQUAL, SVt_PVIO)); } return NULL; } diff --git a/embed.fnc b/embed.fnc index 6a977512583f..ed2c3425e518 100644 --- a/embed.fnc +++ b/embed.fnc @@ -1468,11 +1468,15 @@ ep |GV * |gv_override |NN const char * const name \ |const STRLEN len p |void |gv_setref |NN SV * const dsv \ |NN SV * const ssv +Ap |HV * |gv_stashhek |NN HEK *hek \ + |I32 flags Adp |HV * |gv_stashpv |NN const char *name \ |I32 flags Adp |HV * |gv_stashpvn |NN const char *name \ |U32 namelen \ |I32 flags +Xp |HV * |gv_stashpvs_p |I32 flags \ + |NN const char *name Adp |HV * |gv_stashsv |NN SV *sv \ |I32 flags Xdpx |void |gv_try_downgrade \ @@ -3587,6 +3591,9 @@ Adp |void |sv_vcatpvfn_flags \ |const Size_t sv_count \ |NULLOK bool * const maybe_tainted \ |const U32 flags +Cp |void |sv_viviall_hekpool +CRTXp |SV * |sv_vivihek |NN SV * const sv +Cp |void |sv_vivisome_hekpool Adp |void |sv_vsetpvf |NN SV * const sv \ |NN const char * const pat \ |NULLOK va_list * const args @@ -4456,13 +4463,6 @@ S |bool |find_default_stash \ |const U32 is_utf8 \ |const I32 add \ |const svtype sv_type -i |GV * |gv_fetchmeth_internal \ - |NULLOK HV *stash \ - |NULLOK SV *meth \ - |NULLOK const char *name \ - |STRLEN len \ - |I32 level \ - |U32 flags S |void |gv_init_svtype |NN GV *gv \ |const svtype sv_type S |bool |gv_is_in_main |NN const char *name \ @@ -4504,12 +4504,25 @@ S |void |require_tie_mod|NN GV *gv \ op |void |sv_add_backref |NN SV * const tsv \ |NN SV * const sv #endif +#if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) +ep |GV * |gv_fetchmeth_internal \ + |NULLOK HV *stash \ + |NULLOK SV *meth \ + |NULLOK const char *name \ + |STRLEN len \ + |I32 level \ + |U32 flags +#endif #if defined(PERL_IN_GV_C) || defined(PERL_IN_UNIVERSAL_C) EGdp |HV * |gv_stashsvpvn_cached \ |SV *namesv \ |const char *name \ |U32 namelen \ |I32 flags +EFXp |HV * |gv_stashsvpvn_cached_p \ + |I32 flags \ + |NN void *namevp \ + |... #endif #if defined(PERL_IN_HV_C) Sx |void |clear_placeholders \ diff --git a/embed.h b/embed.h index b4ec209d8ca4..bebcb488213e 100644 --- a/embed.h +++ b/embed.h @@ -294,6 +294,7 @@ # define gv_init_pvn(a,b,c,d,e) Perl_gv_init_pvn(aTHX_ a,b,c,d,e) # define gv_init_sv(a,b,c,d) Perl_gv_init_sv(aTHX_ a,b,c,d) # define gv_name_set(a,b,c,d) Perl_gv_name_set(aTHX_ a,b,c,d) +# define gv_stashhek(a,b) Perl_gv_stashhek(aTHX_ a,b) # define gv_stashpv(a,b) Perl_gv_stashpv(aTHX_ a,b) # define gv_stashpvn(a,b,c) Perl_gv_stashpvn(aTHX_ a,b,c) # define gv_stashsv(a,b) Perl_gv_stashsv(aTHX_ a,b) @@ -845,6 +846,9 @@ # define sv_vcatpvf_mg(a,b,c) Perl_sv_vcatpvf_mg(aTHX_ a,b,c) # define sv_vcatpvfn(a,b,c,d,e,f,g) Perl_sv_vcatpvfn(aTHX_ a,b,c,d,e,f,g) # define sv_vcatpvfn_flags(a,b,c,d,e,f,g,h) Perl_sv_vcatpvfn_flags(aTHX_ a,b,c,d,e,f,g,h) +# define sv_viviall_hekpool() Perl_sv_viviall_hekpool(aTHX) +# define sv_vivihek Perl_sv_vivihek +# define sv_vivisome_hekpool() Perl_sv_vivisome_hekpool(aTHX) # define sv_vsetpvf(a,b,c) Perl_sv_vsetpvf(aTHX_ a,b,c) # define sv_vsetpvf_mg(a,b,c) Perl_sv_vsetpvf_mg(aTHX_ a,b,c) # define sv_vsetpvfn(a,b,c,d,e,f,g) Perl_sv_vsetpvfn(aTHX_ a,b,c,d,e,f,g) @@ -1072,6 +1076,7 @@ # define get_opargs() Perl_get_opargs(aTHX) # define gv_override(a,b) Perl_gv_override(aTHX_ a,b) # define gv_setref(a,b) Perl_gv_setref(aTHX_ a,b) +# define gv_stashpvs_p(a,b) Perl_gv_stashpvs_p(aTHX_ a,b) # define gv_try_downgrade(a) Perl_gv_try_downgrade(aTHX_ a) # define hv_ename_add(a,b,c,d) Perl_hv_ename_add(aTHX_ a,b,c,d) # define hv_ename_delete(a,b,c,d) Perl_hv_ename_delete(aTHX_ a,b,c,d) @@ -1397,7 +1402,6 @@ # endif # if defined(PERL_IN_GV_C) # define find_default_stash(a,b,c,d,e,f) S_find_default_stash(aTHX_ a,b,c,d,e,f) -# define gv_fetchmeth_internal(a,b,c,d,e,f) S_gv_fetchmeth_internal(aTHX_ a,b,c,d,e,f) # define gv_init_svtype(a,b) S_gv_init_svtype(aTHX_ a,b) # define gv_is_in_main(a,b,c) S_gv_is_in_main(aTHX_ a,b,c) # define gv_magicalize(a,b,c,d,e) S_gv_magicalize(aTHX_ a,b,c,d,e) @@ -1407,6 +1411,9 @@ # define parse_gv_stash_name(a,b,c,d,e,f,g,h) S_parse_gv_stash_name(aTHX_ a,b,c,d,e,f,g,h) # define require_tie_mod(a,b,c,d,e) S_require_tie_mod(aTHX_ a,b,c,d,e) # endif /* defined(PERL_IN_GV_C) */ +# if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) +# define gv_fetchmeth_internal(a,b,c,d,e,f) Perl_gv_fetchmeth_internal(aTHX_ a,b,c,d,e,f) +# endif # if defined(PERL_IN_HV_C) # define clear_placeholders(a,b) S_clear_placeholders(aTHX_ a,b) # define hsplit(a,b,c) S_hsplit(aTHX_ a,b,c) @@ -1937,6 +1944,7 @@ # endif # if defined(PERL_IN_GV_C) || defined(PERL_IN_UNIVERSAL_C) # define gv_stashsvpvn_cached(a,b,c,d) Perl_gv_stashsvpvn_cached(aTHX_ a,b,c,d) +# define gv_stashsvpvn_cached_p(a,...) Perl_gv_stashsvpvn_cached_p(aTHX_ a,__VA_ARGS__) # endif # if defined(PERL_IN_OP_C) || defined(PERL_IN_REGCOMP_ANY) # define get_invlist_iter_addr S_get_invlist_iter_addr diff --git a/embedvar.h b/embedvar.h index 085df4802814..0783face2c61 100644 --- a/embedvar.h +++ b/embedvar.h @@ -155,6 +155,7 @@ # define PL_known_layers (vTHX->Iknown_layers) # define PL_langinfo_sv (vTHX->Ilanginfo_sv) # define PL_last_in_gv (vTHX->Ilast_in_gv) +# define PL_lastcopfile (vTHX->Ilastcopfile) # define PL_lastfd (vTHX->Ilastfd) # define PL_lastgotoprobe (vTHX->Ilastgotoprobe) # define PL_laststatval (vTHX->Ilaststatval) diff --git a/globvar.sym b/globvar.sym index b9cea72af64b..63cb2d5b11cd 100644 --- a/globvar.sym +++ b/globvar.sym @@ -19,6 +19,8 @@ PL_EXACT_REQ8_bitmask PL_extended_utf8_dfa_tab PL_fold PL_fold_latin1 +PL_hekpool +PL_hekpoolsv PL_hexdigit PL_inf PL_interp_size diff --git a/gv.c b/gv.c index f76a56c56e32..dc9f78a282b3 100644 --- a/gv.c +++ b/gv.c @@ -43,8 +43,9 @@ within a package. See L #include "keywords.h" #include "feature.h" -static const char S_autoload[] = "AUTOLOAD"; -#define S_autolen (sizeof("AUTOLOAD")-1) +/* static const char * S_autoload = NULL; + #define S_autolen (sizeof("AUTOLOAD")-1) */ + /* =for apidoc gv_add_by_type @@ -206,6 +207,8 @@ Perl_newGP(pTHX_ GV *const gv) U32 hash; const char *file; STRLEN len; + HEK* hek_cached; + HEK* hek; PERL_ARGS_ASSERT_NEWGP; Newxz(gp, 1, GP); @@ -234,8 +237,27 @@ Perl_newGP(pTHX_ GV *const gv) len = 0; } - PERL_HASH(hash, file, len); - gp->gp_file_hek = share_hek(file, len, hash); + hek_cached = PL_lastcopfile.cached_file; + if( hek_cached + && (file == PL_lastcopfile.copfile_unsafe + /* TODO research chances of free(); malloc(); same addr, + len I32 not STRLEN cache it also? #line and #file in PP can they + make a 4.5 GB filepath? */ + || (len == HEK_LEN(hek_cached) + && memEQ(file, HEK_KEY(hek_cached), len)))) { + hek = share_hek_hek(hek_cached); + } + else { + PERL_HASH(hash, file, len); + hek = share_hek(file, len, hash); + hek_cached = PL_lastcopfile.cached_file; + PL_lastcopfile.cached_file = share_hek_hek(hek); /* no fn calls here */ + PL_lastcopfile.copfile_unsafe = file; + if(hek_cached) { + unshare_hek(hek_cached); + } + } + gp->gp_file_hek = hek; gp->gp_refcnt = 1; return gp; @@ -846,8 +868,8 @@ Perl_gv_fetchmeth_pv(pTHX_ HV *stash, const char *name, I32 level, U32 flags) /* NOTE: No support for tied ISA */ -PERL_STATIC_INLINE GV* -S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len, I32 level, U32 flags) +GV* +Perl_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len, I32 level, U32 flags) { GV** gvp; HE* he; @@ -865,10 +887,11 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len, U32 topgen_cmp; U32 is_utf8 = flags & SVf_UTF8; + PERL_ARGS_ASSERT_GV_FETCHMETH_INTERNAL; /* UNIVERSAL methods should be callable without a stash */ if (!stash) { create = 0; /* probably appropriate */ - if(!(stash = gv_stashpvs("UNIVERSAL", 0))) + if(!(stash = gv_stashsv(SV_CONST2(UNIVERSAL), 0))) return 0; } @@ -948,14 +971,14 @@ S_gv_fetchmeth_internal(pTHX_ HV* stash, SV* meth, const char* name, STRLEN len, if ( ckWARN(WARN_SYNTAX)) { if( /* these are loaded from Perl_Gv_AMupdate() one way or another */ ( len && name[0] == '(' ) /* overload.pm related, in particular "()" */ - || ( memEQs( name, len, "DESTROY") ) + || ( memEQhp(name, len, DESTROY, "DESTROY")) ) { Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), "Can't locate package %" SVf " for @%" HEKf "::ISA", SVfARG(linear_sv), HEKfARG(HvNAME_HEK(stash))); - } else if( memEQs( name, len, "AUTOLOAD") ) { + } else if( memEQhp(name, len, AUTOLOAD, "AUTOLOAD") ) { /* gobble this warning */ } else { Perl_ck_warner(aTHX_ packWARN(WARN_SYNTAX), @@ -1074,9 +1097,9 @@ Perl_gv_fetchmeth_pvn_autoload(pTHX_ HV *stash, const char *name, STRLEN len, I3 if (!stash) return NULL; /* UNIVERSAL::AUTOLOAD could cause trouble */ - if (len == S_autolen && memEQ(name, S_autoload, S_autolen)) + if (memEQhp(name, len, AUTOLOAD, "AUTOLOAD")) return NULL; - if (!(gv = gv_fetchmeth_pvn(stash, S_autoload, S_autolen, FALSE, flags))) + if (!(gv = gv_fetchmeth_sv_nomg_x(stash, SV_CONST2(AUTOLOAD), FALSE, flags))) return NULL; cv = GvCV(gv); if (!(CvROOT(cv) || CvXSUB(cv))) @@ -1367,6 +1390,7 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags) { GV* gv; CV* cv; + HE* varhe; HV* varstash; GV* vargv; SV* varsv; @@ -1375,7 +1399,7 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags) PERL_ARGS_ASSERT_GV_AUTOLOAD_PVN; - if (len == S_autolen && memEQ(name, S_autoload, S_autolen)) + if (memEQhp(name, len, AUTOLOAD, "AUTOLOAD")) return NULL; if (stash) { if (SvTYPE(stash) < SVt_PVHV) { @@ -1389,7 +1413,7 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags) packname = newSVhek_mortal(HvNAME_HEK(stash)); if (flags & GV_SUPER) sv_catpvs(packname, "::SUPER"); } - if (!(gv = gv_fetchmeth_pvn(stash, S_autoload, S_autolen, FALSE, + if (!(gv = gv_fetchmeth_sv_nomg_x(stash, SV_CONST2(AUTOLOAD), FALSE, is_utf8 | (flags & GV_SUPER)))) return NULL; cv = GvCV(gv); @@ -1469,11 +1493,13 @@ Perl_gv_autoload_pvn(pTHX_ HV *stash, const char *name, STRLEN len, U32 flags) * original package to look up $AUTOLOAD. */ varstash = CvNAMED(cv) ? CvSTASH(cv) : GvSTASH(CvGV(cv)); - vargv = *(GV**)hv_fetch(varstash, S_autoload, S_autolen, TRUE); + varhe = hv_fetch_ent(varstash, SV_CONST2(AUTOLOAD), TRUE, 0); + vargv = (GV*)HeVAL(varhe); ENTER; if (!isGV(vargv)) { - gv_init_pvn(vargv, varstash, S_autoload, S_autolen, 0); + /* gv_init_pvn(vargv, varstash, S_autoload, S_autolen, 0); */ + gv_init_sv(vargv, varstash, SV_CONST2(AUTOLOAD), 0); /* TODO add NOVI */ #ifdef PERL_DONT_CREATE_GVSV GvSV(vargv) = newSV_type(SVt_NULL); #endif @@ -1621,7 +1647,8 @@ HV* Perl_gv_stashpv(pTHX_ const char *name, I32 create) { PERL_ARGS_ASSERT_GV_STASHPV; - return gv_stashpvn(name, strlen(name), create); + return Perl_gv_stashsvpvn_cached_p(aTHX_ create | GVCf_ISPV | GVCf_HASVA_LEN, + (void*)name, strlen(name)); } /* @@ -1696,15 +1723,73 @@ reasons. HV* Perl_gv_stashsvpvn_cached(pTHX_ SV *namesv, const char *name, U32 namelen, I32 flags) +{ + PERL_ARGS_ASSERT_GV_STASHSVPVN_CACHED; + if(namesv) + return Perl_gv_stashsvpvn_cached_p(aTHX_ flags | GVCf_ISSV, (void*)namesv); + else + return Perl_gv_stashsvpvn_cached_p(aTHX_ flags | GVCf_ISPV | GVCf_HASVA_LEN, + (void*)name, namelen); +} + +/* Not public API, "..." takes exactly 1 optional arg, "U32 namelen" for the + public facing _pvn() variant. All other varieties, pv() pvs() sv() hek() + do not use the optional 3rd arg.*/ +HV* +Perl_gv_stashsvpvn_cached_p(pTHX_ I32 flags, void * namevp, ...) { HV* stash; HE* he; + SV* namesv; + const char* name; + va_list args; + U32 namelen; + U32 hash; - PERL_ARGS_ASSERT_GV_STASHSVPVN_CACHED; + PERL_ARGS_ASSERT_GV_STASHSVPVN_CACHED_P; + va_start(args, namevp); + if(GV_CACHE_ISRC(flags)) { + if(GV_CACHE_ISHEK(flags)) { + HEK* hek = (HEK*)namevp; + I32 hek_len = HEK_LEN(hek); + if(hek_len == HEf_SVKEY) { + namesv = *(SV**)HEK_KEY(hek); + namevp = (void*)namesv; + goto have_sv; + } + namesv = NULL; + name = HEK_KEY(hek); + namelen = hek_len; + flags = (flags & ~SVf_UTF8) | (HEK_UTF8(hek) ? SVf_UTF8 : 0); +/* hv_fetchhek() isn't used here. Its a macro and doesn't currently + do the optimisation you think it is supposed to do. Using macro + hv_fetchhek() in this fn, would add needless indirection through + wrapper hv_common_key_len() instead of centralized single call sites + to hv_common(). */ + hash = HEK_HASH(hek); + } + else { + have_sv: + assert(GV_CACHE_ISSV(flags)); + namesv = (SV*)namevp; + name = NULL; + namelen = 0; + flags = (flags & ~SVf_UTF8) | SvUTF8(namesv); + hash = 0; + } + } + else { + assert(GV_CACHE_ISPV(flags)); + namesv = NULL; + name = (const char *)namevp; + namelen = GV_CACHE_HASVA_LEN(flags) + ? va_arg(args, U32) : GV_CACHE_GET_INL_LEN(flags); + hash = 0; + } he = (HE *)hv_common( PL_stashcache, namesv, name, namelen, - (flags & SVf_UTF8) ? HVhek_UTF8 : 0, 0, NULL, 0 + (flags & SVf_UTF8) ? HVhek_UTF8 : 0, 0, NULL, hash ); if (he) { @@ -1713,28 +1798,39 @@ Perl_gv_stashsvpvn_cached(pTHX_ SV *namesv, const char *name, U32 namelen, I32 f assert(SvIOK(sv)); hv = INT2PTR(HV*, SvIVX(sv)); assert(SvTYPE(hv) == SVt_PVHV); - return hv; + stash = hv; + goto end; + } + else if (flags & GV_CACHE_ONLY) { + stash = NULL; + goto end; } - else if (flags & GV_CACHE_ONLY) return NULL; if (namesv) { if (SvOK(namesv)) { /* prevent double uninit warning */ STRLEN len; name = SvPV_const(namesv, len); namelen = len; - flags |= SvUTF8(namesv); + flags = (flags & ~SVf_UTF8) | SvUTF8(namesv); } else { name = ""; namelen = 0; + namesv = NULL; flags = flags & ~SVf_UTF8; } - } + } /* Turn off bits specific to our call conv so GV_NOADD_MASK works. + Some of our call conv bits are shared with other features from + other front end gv_*() funcs. */ + flags &= ~GV_CACHE_VA_ARGS_MASK; stash = gv_stashpvn_internal(name, namelen, flags); if (stash && namelen) { SV* const ref = newSViv(PTR2IV(stash)); - (void)hv_store(PL_stashcache, name, - (flags & SVf_UTF8) ? -(I32)namelen : (I32)namelen, ref, 0); + hv_common( PL_stashcache, namesv, name, namelen, + (flags & SVf_UTF8) ? HVhek_UTF8 : 0, HV_FETCH_ISSTORE, ref, hash + ); } + end: + va_end(args); return stash; } @@ -1742,15 +1838,34 @@ HV* Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags) { PERL_ARGS_ASSERT_GV_STASHPVN; - return gv_stashsvpvn_cached(NULL, name, namelen, flags); + return Perl_gv_stashsvpvn_cached_p(aTHX_ flags | GVCf_ISPV | GVCf_HASVA_LEN, + (void*)name, namelen); } +HV* +Perl_gv_stashpvs_p(pTHX_ I32 flags, const char *name) +{ + PERL_ARGS_ASSERT_GV_STASHPVS_P; + return Perl_gv_stashsvpvn_cached_p(aTHX_ flags | GVCf_ISPV, (void*)name); +} + + HV* Perl_gv_stashsv(pTHX_ SV *sv, I32 flags) { PERL_ARGS_ASSERT_GV_STASHSV; - return gv_stashsvpvn_cached(sv, NULL, 0, flags); + return Perl_gv_stashsvpvn_cached_p(aTHX_ flags | GVCf_ISSV, (void*)sv); +} + +HV* +Perl_gv_stashhek(pTHX_ HEK *hek, I32 flags) +{ + PERL_ARGS_ASSERT_GV_STASHHEK; + return Perl_gv_stashsvpvn_cached_p(aTHX_ + flags | GVCf_ISHEK, + (void*)hek); } + GV * Perl_gv_fetchpv(pTHX_ const char *nambeg, I32 flags, const svtype sv_type) { PERL_ARGS_ASSERT_GV_FETCHPV; diff --git a/gv.h b/gv.h index 1eb6adeb8ee1..9861e2d56c56 100644 --- a/gv.h +++ b/gv.h @@ -272,6 +272,27 @@ Return the CV from the GV. #define GV_ADDMG 0x400 /* add if magical */ #define GV_NO_SVGMAGIC 0x800 /* Skip get-magic on an SV argument; used only by gv_fetchsv(_nomg) */ +#define GVCf_ISRC 0x2000 +#define GVCf_ISSV GVCf_ISRC +#define GVCf_ISPV 0x0 +#define GVCf_ISHEKORPVN 0x4000 +#define GVCf_ISHEK (GVCf_ISHEKORPVN|GVCf_ISRC) +#define GVCf_HASVA_LEN GVCf_ISHEKORPVN + +#define GV_CACHE_ISPV(_f) (((_f) & GVCf_ISRC)==0) +#define GV_CACHE_HASVA_LEN(_f) (((_f)&(GVCf_ISHEKORPVN|GVCf_ISRC)) == (GVCf_ISHEKORPVN)) +#define GV_CACHE_ISRC(_f) ((_f)&GVCf_ISRC) //0x2000 //sv #50 pv[|n|s] #184 +#define GV_CACHE_ISSV(_f) (((_f)&(GVCf_ISHEKORPVN|GVCf_ISRC)) == GVCf_ISRC) //0x2000 //sv #50 pv[|n|s] #184 +/* core .xs's sv 9, pvn 15, pv 47, pvs 4 + core .c's sv 19, pvn 14, pv 3, pvs 4 */ +#define GV_CACHE_ISHEK(_f) (((_f)&GVCf_ISHEK) == GVCf_ISHEK) +#define GV_CACHE_INL_LEN_MASK 0x00FF0000 +#define GV_CACHE_INL_LEN_MAX 0xFF +#define GV_CACHE_GET_INL_LEN(_f) ((U8)((_f)>>16)) +#define GV_CACHE_FITS_INL_LEN(_f) ((_f) <= GV_CACHE_INL_LEN_MAX) +#define GV_CACHE_PACK_INL_LEN(_f) ((U32)(((U32)((U8)(_f))) << 16)) +#define GV_CACHE_VA_ARGS_MASK (GVCf_ISRC|GVCf_ISHEKORPVN|GV_CACHE_INL_LEN_MASK) + #define GV_CACHE_ONLY 0x1000 /* return stash only if found in cache; used only in flags parameter to gv_stash* family */ @@ -287,6 +308,7 @@ Return the CV from the GV. as a flag to various gv_* functions, so ensure it lies outside this range. */ +#define GV_UTF8fprvt SVf_UTF8 /* 0x20000000 */ /* SvPV is UTF-8 encoded */ #define GV_NOADD_MASK \ (SVf_UTF8|GV_NOADD_NOINIT|GV_NOEXPAND|GV_NOTQUAL|GV_ADDMG|GV_NO_SVGMAGIC) @@ -316,6 +338,14 @@ Return the CV from the GV. #define gv_fetchmeth_autoload(stash,name,len,level) gv_fetchmeth_pvn_autoload(stash, name, len, level, 0) #define gv_fetchmethod_flags(stash,name,flags) gv_fetchmethod_pv_flags(stash, name, flags) +#if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) +/* "flags | SvUTF8(namesv)" and "if(SvPOK_nog(namesv)){}" were removed. + Arg SV* namesv, must be an immortal non-arena SV head from the + IMMORTAL HEK pool. Gaining UTF8f or GMGf or loosing POKf is not possible. */ +# define gv_fetchmeth_sv_nomg_x(stash,namesv,level,flags) \ + gv_fetchmeth_internal(stash,namesv,NULL,0,level,flags) +#endif + /* =for apidoc_defn ARmd|GV *|gv_autoload4|NULLOK HV *stash \ |NN const char *name \ diff --git a/handy.h b/handy.h index e2e5aa9e3e98..13d4d5d7adbd 100644 --- a/handy.h +++ b/handy.h @@ -455,8 +455,12 @@ Perl_xxx(aTHX_ ...) form for any API calls where it's used. =for apidoc_defn Am|HV*|gv_stashpvs|"name"|I32 create =cut */ -#define gv_stashpvs(str, create) \ - Perl_gv_stashpvn(aTHX_ STR_WITH_LEN(str), create) + +#define gv_stashpvs(str, create) Perl_gv_stashpvs_p(aTHX_ \ + ((create) | ( GV_CACHE_FITS_INL_LEN(sizeof(str)-1) \ + ? GV_CACHE_PACK_INL_LEN(sizeof(str)-1) \ + : (Perl_croak_nocontext("panic: gv_stashpvs overflow"), \ + GV_CACHE_INL_LEN_MAX))), ASSERT_IS_LITERAL(str)) /* diff --git a/hekpool.h b/hekpool.h new file mode 100644 index 000000000000..4c62018d3ebc --- /dev/null +++ b/hekpool.h @@ -0,0 +1,965 @@ +/* -*- mode: C; buffer-read-only: t -*- + + Copyright (C) 2022 by Larry Wall and others + + You may distribute under the terms of either the GNU General Public + License or the Artistic License, as specified in the README file. + + !!!!!!! DO NOT EDIT THIS FILE !!!!!!! + This file is built by regen/hekpool.pl. + Any changes made here will be lost! + QQQQFINALQQQQ */ + +typedef struct { + U16 lensv; U8 lenxpv; + union { + struct { + SV _END_; + SV _ENV_; + SV _EOF_; + SV _INC_; + SV _ISA_; + SV _POP_; + SV _REF_; + SV _SIG_; + SV _ARGV_; + SV _CODE_; + SV _CORE_; + SV _DATA_; + SV _DOES_; + SV _FILE_; + SV _GETC_; + SV _GLOB_; + SV _HASH_; + SV _HOME_; + SV _INIT_; + SV _MASK_; + SV _NAME_; + SV _NULL_; + SV _OPEN_; + SV _PATH_; + SV _PUSH_; + SV _READ_; + SV _SAFE_; + SV _SEEK_; + SV _TELL_; + SV _TERM_; + SV _ARRAY_; + SV _BEGIN_; + SV _CHECK_; + SV _CLEAR_; + SV _CLONE_; + SV _CLOSE_; + SV _DEBUG_; + SV _ERROR_; + SV _FETCH_; + SV _FLAGS_; + SV _PRINT_; + SV _SHIFT_; + SV _STDIN_; + SV _STORE_; + SV _UNTIE_; + SV _WRITE_; + SV _ADJUST_; + SV _DELETE_; + SV _EXISTS_; + SV _EXPORT_; + SV _EXTEND_; + SV _FIELDS_; + SV _FILENO_; + SV _FORMAT_; + SV _INCDIR_; + SV _LVALUE_; + SV _OBJECT_; + SV _PRINTF_; + SV _REGEXP_; + SV _SCALAR_; + SV _SPLICE_; + SV _STDERR_; + SV _STDOUT_; + SV _ARGVOUT_; + SV _BINMODE_; + SV _DESTROY_; + SV _INVLIST_; + SV _NEXTKEY_; + SV _NULLREF_; + SV _TIEHASH_; + SV _UNKNOWN_; + SV _UNSHIFT_; + SV _VERSION_; + SV _VSTRING_; + SV ___END___; + SV ___SUB___; + SV _AUTOLOAD_; + SV _FIRSTKEY_; + SV _READLINE_; + SV _TIEARRAY_; + SV ___ANON___; + SV ___DATA___; + SV ___FILE___; + SV ___LINE___; + SV _EXPORT_OK_; + SV _FETCHSIZE_; + SV _STORESIZE_; + SV _TIEHANDLE_; + SV _TIESCALAR_; + SV _UNITCHECK_; + SV _UNIVERSAL_; + SV ___CLASS___; + SV _CLONE_SKIP_; + SV _XS_VERSION_; + SV ___ANONIO___; + SV _EXPORT_TAGS_; + SV ___PACKAGE___; + SV _EXPXXXXXXXORT_TAGS_; + } st; + SV a[98]; + } u; +} SVHEKP_T; + +typedef struct { + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("END")+1];} shared_he_hek;} _END_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("ENV")+1];} shared_he_hek;} _ENV_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("EOF")+1];} shared_he_hek;} _EOF_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("INC")+1];} shared_he_hek;} _INC_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("ISA")+1];} shared_he_hek;} _ISA_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("POP")+1];} shared_he_hek;} _POP_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("REF")+1];} shared_he_hek;} _REF_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("SIG")+1];} shared_he_hek;} _SIG_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("ARGV")+1];} shared_he_hek;} _ARGV_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("CODE")+1];} shared_he_hek;} _CODE_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("CORE")+1];} shared_he_hek;} _CORE_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("DATA")+1];} shared_he_hek;} _DATA_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("DOES")+1];} shared_he_hek;} _DOES_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("FILE")+1];} shared_he_hek;} _FILE_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("GETC")+1];} shared_he_hek;} _GETC_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("GLOB")+1];} shared_he_hek;} _GLOB_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("HASH")+1];} shared_he_hek;} _HASH_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("HOME")+1];} shared_he_hek;} _HOME_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("INIT")+1];} shared_he_hek;} _INIT_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("MASK")+1];} shared_he_hek;} _MASK_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("NAME")+1];} shared_he_hek;} _NAME_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("NULL")+1];} shared_he_hek;} _NULL_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("OPEN")+1];} shared_he_hek;} _OPEN_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("PATH")+1];} shared_he_hek;} _PATH_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("PUSH")+1];} shared_he_hek;} _PUSH_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("READ")+1];} shared_he_hek;} _READ_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("SAFE")+1];} shared_he_hek;} _SAFE_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("SEEK")+1];} shared_he_hek;} _SEEK_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("TELL")+1];} shared_he_hek;} _TELL_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("TERM")+1];} shared_he_hek;} _TERM_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("ARRAY")+1];} shared_he_hek;} _ARRAY_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("BEGIN")+1];} shared_he_hek;} _BEGIN_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("CHECK")+1];} shared_he_hek;} _CHECK_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("CLEAR")+1];} shared_he_hek;} _CLEAR_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("CLONE")+1];} shared_he_hek;} _CLONE_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("CLOSE")+1];} shared_he_hek;} _CLOSE_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("DEBUG")+1];} shared_he_hek;} _DEBUG_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("ERROR")+1];} shared_he_hek;} _ERROR_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("FETCH")+1];} shared_he_hek;} _FETCH_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("FLAGS")+1];} shared_he_hek;} _FLAGS_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("PRINT")+1];} shared_he_hek;} _PRINT_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("SHIFT")+1];} shared_he_hek;} _SHIFT_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("STDIN")+1];} shared_he_hek;} _STDIN_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("STORE")+1];} shared_he_hek;} _STORE_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("UNTIE")+1];} shared_he_hek;} _UNTIE_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("WRITE")+1];} shared_he_hek;} _WRITE_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("ADJUST")+1];} shared_he_hek;} _ADJUST_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("DELETE")+1];} shared_he_hek;} _DELETE_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("EXISTS")+1];} shared_he_hek;} _EXISTS_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("EXPORT")+1];} shared_he_hek;} _EXPORT_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("EXTEND")+1];} shared_he_hek;} _EXTEND_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("FIELDS")+1];} shared_he_hek;} _FIELDS_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("FILENO")+1];} shared_he_hek;} _FILENO_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("FORMAT")+1];} shared_he_hek;} _FORMAT_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("INCDIR")+1];} shared_he_hek;} _INCDIR_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("LVALUE")+1];} shared_he_hek;} _LVALUE_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("OBJECT")+1];} shared_he_hek;} _OBJECT_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("PRINTF")+1];} shared_he_hek;} _PRINTF_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("REGEXP")+1];} shared_he_hek;} _REGEXP_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("SCALAR")+1];} shared_he_hek;} _SCALAR_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("SPLICE")+1];} shared_he_hek;} _SPLICE_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("STDERR")+1];} shared_he_hek;} _STDERR_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("STDOUT")+1];} shared_he_hek;} _STDOUT_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("ARGVOUT")+1];} shared_he_hek;} _ARGVOUT_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("BINMODE")+1];} shared_he_hek;} _BINMODE_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("DESTROY")+1];} shared_he_hek;} _DESTROY_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("INVLIST")+1];} shared_he_hek;} _INVLIST_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("NEXTKEY")+1];} shared_he_hek;} _NEXTKEY_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("NULLREF")+1];} shared_he_hek;} _NULLREF_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("TIEHASH")+1];} shared_he_hek;} _TIEHASH_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("UNKNOWN")+1];} shared_he_hek;} _UNKNOWN_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("UNSHIFT")+1];} shared_he_hek;} _UNSHIFT_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("VERSION")+1];} shared_he_hek;} _VERSION_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("VSTRING")+1];} shared_he_hek;} _VSTRING_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("__END__")+1];} shared_he_hek;} ___END___; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("__SUB__")+1];} shared_he_hek;} ___SUB___; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("AUTOLOAD")+1];} shared_he_hek;} _AUTOLOAD_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("FIRSTKEY")+1];} shared_he_hek;} _FIRSTKEY_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("READLINE")+1];} shared_he_hek;} _READLINE_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("TIEARRAY")+1];} shared_he_hek;} _TIEARRAY_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("__ANON__")+1];} shared_he_hek;} ___ANON___; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("__DATA__")+1];} shared_he_hek;} ___DATA___; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("__FILE__")+1];} shared_he_hek;} ___FILE___; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("__LINE__")+1];} shared_he_hek;} ___LINE___; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("EXPORT_OK")+1];} shared_he_hek;} _EXPORT_OK_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("FETCHSIZE")+1];} shared_he_hek;} _FETCHSIZE_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("STORESIZE")+1];} shared_he_hek;} _STORESIZE_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("TIEHANDLE")+1];} shared_he_hek;} _TIEHANDLE_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("TIESCALAR")+1];} shared_he_hek;} _TIESCALAR_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("UNITCHECK")+1];} shared_he_hek;} _UNITCHECK_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("UNIVERSAL")+1];} shared_he_hek;} _UNIVERSAL_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("__CLASS__")+1];} shared_he_hek;} ___CLASS___; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("CLONE_SKIP")+1];} shared_he_hek;} _CLONE_SKIP_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("XS_VERSION")+1];} shared_he_hek;} _XS_VERSION_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("__ANONIO__")+1];} shared_he_hek;} ___ANONIO___; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("EXPORT_TAGS")+1];} shared_he_hek;} _EXPORT_TAGS_; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("__PACKAGE__")+1];} shared_he_hek;} ___PACKAGE___; + struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len; + char hek_key [sizeof("EXPXXXXXXXORT_TAGS")+1];} shared_he_hek;} _EXPXXXXXXXORT_TAGS_; +} HEKP_T; + + +typedef struct { + STRLEN cur; + STRLEN len; +} XPVIMM_T; + +typedef struct { + XPVIMM_T len3; XPVIMM_T len4; XPVIMM_T len5; XPVIMM_T len6; + XPVIMM_T len7; XPVIMM_T len8; XPVIMM_T len9; XPVIMM_T len10; + XPVIMM_T len11; XPVIMM_T len18; +} XPVS_IMM_T; + + +#if defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C) +typedef struct { + U32 fastmask; + U16 svoffst; /* offset in bytes, not idx, to region of same len SV heads */ + U16 svoffend; /* +1 after last SV head, use < */ +} HPOOL_FASTM_T; + +typedef struct { + U8 lenlow; + U8 lenhi; + HPOOL_FASTM_T leninfo [16]; +} HPOOL_FASTMS_T; +#define HPOOLPV_MIN 3 +#define HPOOLPV_MAX 18 + +#define HEKPOOL_LENMASK ((1<<3)|(1<<4)|(1<<5)|(1<<6)|(1<<7)|(1<<8)|(1<<9)|(1<<10)|(1<<11)|(1<<18)) + + +#if defined(PERL_IS_MINIPERL) +# define IS_MAYBE_HPOOL(_s, _l) if(0){0;} +#else +# define IS_MAYBE_HPOOL(_s, _l) XXXDISABLED; if((_l) < 32 && ((1<<(_l))&HEKPOOL_LENMASK) \ + && PL_hpfastm.leninfo[(_l)-HPOOLPV_MIN].fastmask \ + && (*((U32*)_s)&~PL_hpfastm.leninfo[(_l)-HPOOLPV_MIN].fastmask == 0) {\ + __debugbreak();\ + } +#endif + + + +static const HPOOL_FASTMS_T PL_hpfastm = { 3, 18, { + {(vtohl(('E'|('N'<<8)|('D'<<16)|('\0'<<24))) + |vtohl(('E'|('N'<<8)|('V'<<16)|('\0'<<24))) + |vtohl(('E'|('O'<<8)|('F'<<16)|('\0'<<24))) + |vtohl(('I'|('N'<<8)|('C'<<16)|('\0'<<24))) + |vtohl(('I'|('S'<<8)|('A'<<16)|('\0'<<24))) + |vtohl(('P'|('O'<<8)|('P'<<16)|('\0'<<24))) + |vtohl(('R'|('E'<<8)|('F'<<16)|('\0'<<24))) + |vtohl(('S'|('I'<<8)|('G'<<16)|('\0'<<24)))), + STRUCT_OFFSET(SVHEKP_T,u.st._END_)-STRUCT_OFFSET(SVHEKP_T,u.st), + (STRUCT_OFFSET(SVHEKP_T,u.st._SIG_)-STRUCT_OFFSET(SVHEKP_T,u.st))+sizeof(SV)}, + {(vtohl(('A'|('R'<<8)|('G'<<16)|('V'<<24))) + |vtohl(('C'|('O'<<8)|('D'<<16)|('E'<<24))) + |vtohl(('C'|('O'<<8)|('R'<<16)|('E'<<24))) + |vtohl(('D'|('A'<<8)|('T'<<16)|('A'<<24))) + |vtohl(('D'|('O'<<8)|('E'<<16)|('S'<<24))) + |vtohl(('F'|('I'<<8)|('L'<<16)|('E'<<24))) + |vtohl(('G'|('E'<<8)|('T'<<16)|('C'<<24))) + |vtohl(('G'|('L'<<8)|('O'<<16)|('B'<<24))) + |vtohl(('H'|('A'<<8)|('S'<<16)|('H'<<24))) + |vtohl(('H'|('O'<<8)|('M'<<16)|('E'<<24))) + |vtohl(('I'|('N'<<8)|('I'<<16)|('T'<<24))) + |vtohl(('M'|('A'<<8)|('S'<<16)|('K'<<24))) + |vtohl(('N'|('A'<<8)|('M'<<16)|('E'<<24))) + |vtohl(('N'|('U'<<8)|('L'<<16)|('L'<<24))) + |vtohl(('O'|('P'<<8)|('E'<<16)|('N'<<24))) + |vtohl(('P'|('A'<<8)|('T'<<16)|('H'<<24))) + |vtohl(('P'|('U'<<8)|('S'<<16)|('H'<<24))) + |vtohl(('R'|('E'<<8)|('A'<<16)|('D'<<24))) + |vtohl(('S'|('A'<<8)|('F'<<16)|('E'<<24))) + |vtohl(('S'|('E'<<8)|('E'<<16)|('K'<<24))) + |vtohl(('T'|('E'<<8)|('L'<<16)|('L'<<24))) + |vtohl(('T'|('E'<<8)|('R'<<16)|('M'<<24)))), + STRUCT_OFFSET(SVHEKP_T,u.st._ARGV_)-STRUCT_OFFSET(SVHEKP_T,u.st), + (STRUCT_OFFSET(SVHEKP_T,u.st._TERM_)-STRUCT_OFFSET(SVHEKP_T,u.st))+sizeof(SV)}, + {(vtohl(('A'|('R'<<8)|('R'<<16)|('A'<<24))) + |vtohl(('B'|('E'<<8)|('G'<<16)|('I'<<24))) + |vtohl(('C'|('H'<<8)|('E'<<16)|('C'<<24))) + |vtohl(('C'|('L'<<8)|('E'<<16)|('A'<<24))) + |vtohl(('C'|('L'<<8)|('O'<<16)|('N'<<24))) + |vtohl(('C'|('L'<<8)|('O'<<16)|('S'<<24))) + |vtohl(('D'|('E'<<8)|('B'<<16)|('U'<<24))) + |vtohl(('E'|('R'<<8)|('R'<<16)|('O'<<24))) + |vtohl(('F'|('E'<<8)|('T'<<16)|('C'<<24))) + |vtohl(('F'|('L'<<8)|('A'<<16)|('G'<<24))) + |vtohl(('P'|('R'<<8)|('I'<<16)|('N'<<24))) + |vtohl(('S'|('H'<<8)|('I'<<16)|('F'<<24))) + |vtohl(('S'|('T'<<8)|('D'<<16)|('I'<<24))) + |vtohl(('S'|('T'<<8)|('O'<<16)|('R'<<24))) + |vtohl(('U'|('N'<<8)|('T'<<16)|('I'<<24))) + |vtohl(('W'|('R'<<8)|('I'<<16)|('T'<<24)))), + STRUCT_OFFSET(SVHEKP_T,u.st._ARRAY_)-STRUCT_OFFSET(SVHEKP_T,u.st), + (STRUCT_OFFSET(SVHEKP_T,u.st._WRITE_)-STRUCT_OFFSET(SVHEKP_T,u.st))+sizeof(SV)}, + {(vtohl(('A'|('D'<<8)|('J'<<16)|('U'<<24))) + |vtohl(('D'|('E'<<8)|('L'<<16)|('E'<<24))) + |vtohl(('E'|('X'<<8)|('I'<<16)|('S'<<24))) + |vtohl(('E'|('X'<<8)|('P'<<16)|('O'<<24))) + |vtohl(('E'|('X'<<8)|('T'<<16)|('E'<<24))) + |vtohl(('F'|('I'<<8)|('E'<<16)|('L'<<24))) + |vtohl(('F'|('I'<<8)|('L'<<16)|('E'<<24))) + |vtohl(('F'|('O'<<8)|('R'<<16)|('M'<<24))) + |vtohl(('I'|('N'<<8)|('C'<<16)|('D'<<24))) + |vtohl(('L'|('V'<<8)|('A'<<16)|('L'<<24))) + |vtohl(('O'|('B'<<8)|('J'<<16)|('E'<<24))) + |vtohl(('P'|('R'<<8)|('I'<<16)|('N'<<24))) + |vtohl(('R'|('E'<<8)|('G'<<16)|('E'<<24))) + |vtohl(('S'|('C'<<8)|('A'<<16)|('L'<<24))) + |vtohl(('S'|('P'<<8)|('L'<<16)|('I'<<24))) + |vtohl(('S'|('T'<<8)|('D'<<16)|('E'<<24))) + |vtohl(('S'|('T'<<8)|('D'<<16)|('O'<<24)))), + STRUCT_OFFSET(SVHEKP_T,u.st._ADJUST_)-STRUCT_OFFSET(SVHEKP_T,u.st), + (STRUCT_OFFSET(SVHEKP_T,u.st._STDOUT_)-STRUCT_OFFSET(SVHEKP_T,u.st))+sizeof(SV)}, + {(vtohl(('A'|('R'<<8)|('G'<<16)|('V'<<24))) + |vtohl(('B'|('I'<<8)|('N'<<16)|('M'<<24))) + |vtohl(('D'|('E'<<8)|('S'<<16)|('T'<<24))) + |vtohl(('I'|('N'<<8)|('V'<<16)|('L'<<24))) + |vtohl(('N'|('E'<<8)|('X'<<16)|('T'<<24))) + |vtohl(('N'|('U'<<8)|('L'<<16)|('L'<<24))) + |vtohl(('T'|('I'<<8)|('E'<<16)|('H'<<24))) + |vtohl(('U'|('N'<<8)|('K'<<16)|('N'<<24))) + |vtohl(('U'|('N'<<8)|('S'<<16)|('H'<<24))) + |vtohl(('V'|('E'<<8)|('R'<<16)|('S'<<24))) + |vtohl(('V'|('S'<<8)|('T'<<16)|('R'<<24))) + |vtohl(('_'|('_'<<8)|('E'<<16)|('N'<<24))) + |vtohl(('_'|('_'<<8)|('S'<<16)|('U'<<24)))), + STRUCT_OFFSET(SVHEKP_T,u.st._ARGVOUT_)-STRUCT_OFFSET(SVHEKP_T,u.st), + (STRUCT_OFFSET(SVHEKP_T,u.st.___SUB___)-STRUCT_OFFSET(SVHEKP_T,u.st))+sizeof(SV)}, + {(vtohl(('A'|('U'<<8)|('T'<<16)|('O'<<24))) + |vtohl(('F'|('I'<<8)|('R'<<16)|('S'<<24))) + |vtohl(('R'|('E'<<8)|('A'<<16)|('D'<<24))) + |vtohl(('T'|('I'<<8)|('E'<<16)|('A'<<24))) + |vtohl(('_'|('_'<<8)|('A'<<16)|('N'<<24))) + |vtohl(('_'|('_'<<8)|('D'<<16)|('A'<<24))) + |vtohl(('_'|('_'<<8)|('F'<<16)|('I'<<24))) + |vtohl(('_'|('_'<<8)|('L'<<16)|('I'<<24)))), + STRUCT_OFFSET(SVHEKP_T,u.st._AUTOLOAD_)-STRUCT_OFFSET(SVHEKP_T,u.st), + (STRUCT_OFFSET(SVHEKP_T,u.st.___LINE___)-STRUCT_OFFSET(SVHEKP_T,u.st))+sizeof(SV)}, + {(vtohl(('E'|('X'<<8)|('P'<<16)|('O'<<24))) + |vtohl(('F'|('E'<<8)|('T'<<16)|('C'<<24))) + |vtohl(('S'|('T'<<8)|('O'<<16)|('R'<<24))) + |vtohl(('T'|('I'<<8)|('E'<<16)|('H'<<24))) + |vtohl(('T'|('I'<<8)|('E'<<16)|('S'<<24))) + |vtohl(('U'|('N'<<8)|('I'<<16)|('T'<<24))) + |vtohl(('U'|('N'<<8)|('I'<<16)|('V'<<24))) + |vtohl(('_'|('_'<<8)|('C'<<16)|('L'<<24)))), + STRUCT_OFFSET(SVHEKP_T,u.st._EXPORT_OK_)-STRUCT_OFFSET(SVHEKP_T,u.st), + (STRUCT_OFFSET(SVHEKP_T,u.st.___CLASS___)-STRUCT_OFFSET(SVHEKP_T,u.st))+sizeof(SV)}, + {(vtohl(('C'|('L'<<8)|('O'<<16)|('N'<<24))) + |vtohl(('X'|('S'<<8)|('_'<<16)|('V'<<24))) + |vtohl(('_'|('_'<<8)|('A'<<16)|('N'<<24)))), + STRUCT_OFFSET(SVHEKP_T,u.st._CLONE_SKIP_)-STRUCT_OFFSET(SVHEKP_T,u.st), + (STRUCT_OFFSET(SVHEKP_T,u.st.___ANONIO___)-STRUCT_OFFSET(SVHEKP_T,u.st))+sizeof(SV)}, + {(vtohl(('E'|('X'<<8)|('P'<<16)|('O'<<24))) + |vtohl(('_'|('_'<<8)|('P'<<16)|('A'<<24)))), + STRUCT_OFFSET(SVHEKP_T,u.st._EXPORT_TAGS_)-STRUCT_OFFSET(SVHEKP_T,u.st), + (STRUCT_OFFSET(SVHEKP_T,u.st.___PACKAGE___)-STRUCT_OFFSET(SVHEKP_T,u.st))+sizeof(SV)}, + {0,0,0}, + {0,0,0}, + {0,0,0}, + {0,0,0}, + {0,0,0}, + {0,0,0}, + {(vtohl(('E'|('X'<<8)|('P'<<16)|('X'<<24)))), + STRUCT_OFFSET(SVHEKP_T,u.st._EXPXXXXXXXORT_TAGS_)-STRUCT_OFFSET(SVHEKP_T,u.st), + (STRUCT_OFFSET(SVHEKP_T,u.st._EXPXXXXXXXORT_TAGS_)-STRUCT_OFFSET(SVHEKP_T,u.st))+sizeof(SV)} + } +}; +#endif + + +#ifndef DOINIT +PERLVAR(G, hekpool, HEKP_T) +#else +HEKP_T PL_hekpool = { + {{NULL, (HEK*)&PL_hekpool._END_.shared_he_hek, {(SV*)1}},{0,sizeof("END")-1,"END"}}, + {{NULL, (HEK*)&PL_hekpool._ENV_.shared_he_hek, {(SV*)1}},{0,sizeof("ENV")-1,"ENV"}}, + {{NULL, (HEK*)&PL_hekpool._EOF_.shared_he_hek, {(SV*)1}},{0,sizeof("EOF")-1,"EOF"}}, + {{NULL, (HEK*)&PL_hekpool._INC_.shared_he_hek, {(SV*)1}},{0,sizeof("INC")-1,"INC"}}, + {{NULL, (HEK*)&PL_hekpool._ISA_.shared_he_hek, {(SV*)1}},{0,sizeof("ISA")-1,"ISA"}}, + {{NULL, (HEK*)&PL_hekpool._POP_.shared_he_hek, {(SV*)1}},{0,sizeof("POP")-1,"POP"}}, + {{NULL, (HEK*)&PL_hekpool._REF_.shared_he_hek, {(SV*)1}},{0,sizeof("REF")-1,"REF"}}, + {{NULL, (HEK*)&PL_hekpool._SIG_.shared_he_hek, {(SV*)1}},{0,sizeof("SIG")-1,"SIG"}}, + {{NULL, (HEK*)&PL_hekpool._ARGV_.shared_he_hek, {(SV*)1}},{0,sizeof("ARGV")-1,"ARGV"}}, + {{NULL, (HEK*)&PL_hekpool._CODE_.shared_he_hek, {(SV*)1}},{0,sizeof("CODE")-1,"CODE"}}, + {{NULL, (HEK*)&PL_hekpool._CORE_.shared_he_hek, {(SV*)1}},{0,sizeof("CORE")-1,"CORE"}}, + {{NULL, (HEK*)&PL_hekpool._DATA_.shared_he_hek, {(SV*)1}},{0,sizeof("DATA")-1,"DATA"}}, + {{NULL, (HEK*)&PL_hekpool._DOES_.shared_he_hek, {(SV*)1}},{0,sizeof("DOES")-1,"DOES"}}, + {{NULL, (HEK*)&PL_hekpool._FILE_.shared_he_hek, {(SV*)1}},{0,sizeof("FILE")-1,"FILE"}}, + {{NULL, (HEK*)&PL_hekpool._GETC_.shared_he_hek, {(SV*)1}},{0,sizeof("GETC")-1,"GETC"}}, + {{NULL, (HEK*)&PL_hekpool._GLOB_.shared_he_hek, {(SV*)1}},{0,sizeof("GLOB")-1,"GLOB"}}, + {{NULL, (HEK*)&PL_hekpool._HASH_.shared_he_hek, {(SV*)1}},{0,sizeof("HASH")-1,"HASH"}}, + {{NULL, (HEK*)&PL_hekpool._HOME_.shared_he_hek, {(SV*)1}},{0,sizeof("HOME")-1,"HOME"}}, + {{NULL, (HEK*)&PL_hekpool._INIT_.shared_he_hek, {(SV*)1}},{0,sizeof("INIT")-1,"INIT"}}, + {{NULL, (HEK*)&PL_hekpool._MASK_.shared_he_hek, {(SV*)1}},{0,sizeof("MASK")-1,"MASK"}}, + {{NULL, (HEK*)&PL_hekpool._NAME_.shared_he_hek, {(SV*)1}},{0,sizeof("NAME")-1,"NAME"}}, + {{NULL, (HEK*)&PL_hekpool._NULL_.shared_he_hek, {(SV*)1}},{0,sizeof("NULL")-1,"NULL"}}, + {{NULL, (HEK*)&PL_hekpool._OPEN_.shared_he_hek, {(SV*)1}},{0,sizeof("OPEN")-1,"OPEN"}}, + {{NULL, (HEK*)&PL_hekpool._PATH_.shared_he_hek, {(SV*)1}},{0,sizeof("PATH")-1,"PATH"}}, + {{NULL, (HEK*)&PL_hekpool._PUSH_.shared_he_hek, {(SV*)1}},{0,sizeof("PUSH")-1,"PUSH"}}, + {{NULL, (HEK*)&PL_hekpool._READ_.shared_he_hek, {(SV*)1}},{0,sizeof("READ")-1,"READ"}}, + {{NULL, (HEK*)&PL_hekpool._SAFE_.shared_he_hek, {(SV*)1}},{0,sizeof("SAFE")-1,"SAFE"}}, + {{NULL, (HEK*)&PL_hekpool._SEEK_.shared_he_hek, {(SV*)1}},{0,sizeof("SEEK")-1,"SEEK"}}, + {{NULL, (HEK*)&PL_hekpool._TELL_.shared_he_hek, {(SV*)1}},{0,sizeof("TELL")-1,"TELL"}}, + {{NULL, (HEK*)&PL_hekpool._TERM_.shared_he_hek, {(SV*)1}},{0,sizeof("TERM")-1,"TERM"}}, + {{NULL, (HEK*)&PL_hekpool._ARRAY_.shared_he_hek, {(SV*)1}},{0,sizeof("ARRAY")-1,"ARRAY"}}, + {{NULL, (HEK*)&PL_hekpool._BEGIN_.shared_he_hek, {(SV*)1}},{0,sizeof("BEGIN")-1,"BEGIN"}}, + {{NULL, (HEK*)&PL_hekpool._CHECK_.shared_he_hek, {(SV*)1}},{0,sizeof("CHECK")-1,"CHECK"}}, + {{NULL, (HEK*)&PL_hekpool._CLEAR_.shared_he_hek, {(SV*)1}},{0,sizeof("CLEAR")-1,"CLEAR"}}, + {{NULL, (HEK*)&PL_hekpool._CLONE_.shared_he_hek, {(SV*)1}},{0,sizeof("CLONE")-1,"CLONE"}}, + {{NULL, (HEK*)&PL_hekpool._CLOSE_.shared_he_hek, {(SV*)1}},{0,sizeof("CLOSE")-1,"CLOSE"}}, + {{NULL, (HEK*)&PL_hekpool._DEBUG_.shared_he_hek, {(SV*)1}},{0,sizeof("DEBUG")-1,"DEBUG"}}, + {{NULL, (HEK*)&PL_hekpool._ERROR_.shared_he_hek, {(SV*)1}},{0,sizeof("ERROR")-1,"ERROR"}}, + {{NULL, (HEK*)&PL_hekpool._FETCH_.shared_he_hek, {(SV*)1}},{0,sizeof("FETCH")-1,"FETCH"}}, + {{NULL, (HEK*)&PL_hekpool._FLAGS_.shared_he_hek, {(SV*)1}},{0,sizeof("FLAGS")-1,"FLAGS"}}, + {{NULL, (HEK*)&PL_hekpool._PRINT_.shared_he_hek, {(SV*)1}},{0,sizeof("PRINT")-1,"PRINT"}}, + {{NULL, (HEK*)&PL_hekpool._SHIFT_.shared_he_hek, {(SV*)1}},{0,sizeof("SHIFT")-1,"SHIFT"}}, + {{NULL, (HEK*)&PL_hekpool._STDIN_.shared_he_hek, {(SV*)1}},{0,sizeof("STDIN")-1,"STDIN"}}, + {{NULL, (HEK*)&PL_hekpool._STORE_.shared_he_hek, {(SV*)1}},{0,sizeof("STORE")-1,"STORE"}}, + {{NULL, (HEK*)&PL_hekpool._UNTIE_.shared_he_hek, {(SV*)1}},{0,sizeof("UNTIE")-1,"UNTIE"}}, + {{NULL, (HEK*)&PL_hekpool._WRITE_.shared_he_hek, {(SV*)1}},{0,sizeof("WRITE")-1,"WRITE"}}, + {{NULL, (HEK*)&PL_hekpool._ADJUST_.shared_he_hek, {(SV*)1}},{0,sizeof("ADJUST")-1,"ADJUST"}}, + {{NULL, (HEK*)&PL_hekpool._DELETE_.shared_he_hek, {(SV*)1}},{0,sizeof("DELETE")-1,"DELETE"}}, + {{NULL, (HEK*)&PL_hekpool._EXISTS_.shared_he_hek, {(SV*)1}},{0,sizeof("EXISTS")-1,"EXISTS"}}, + {{NULL, (HEK*)&PL_hekpool._EXPORT_.shared_he_hek, {(SV*)1}},{0,sizeof("EXPORT")-1,"EXPORT"}}, + {{NULL, (HEK*)&PL_hekpool._EXTEND_.shared_he_hek, {(SV*)1}},{0,sizeof("EXTEND")-1,"EXTEND"}}, + {{NULL, (HEK*)&PL_hekpool._FIELDS_.shared_he_hek, {(SV*)1}},{0,sizeof("FIELDS")-1,"FIELDS"}}, + {{NULL, (HEK*)&PL_hekpool._FILENO_.shared_he_hek, {(SV*)1}},{0,sizeof("FILENO")-1,"FILENO"}}, + {{NULL, (HEK*)&PL_hekpool._FORMAT_.shared_he_hek, {(SV*)1}},{0,sizeof("FORMAT")-1,"FORMAT"}}, + {{NULL, (HEK*)&PL_hekpool._INCDIR_.shared_he_hek, {(SV*)1}},{0,sizeof("INCDIR")-1,"INCDIR"}}, + {{NULL, (HEK*)&PL_hekpool._LVALUE_.shared_he_hek, {(SV*)1}},{0,sizeof("LVALUE")-1,"LVALUE"}}, + {{NULL, (HEK*)&PL_hekpool._OBJECT_.shared_he_hek, {(SV*)1}},{0,sizeof("OBJECT")-1,"OBJECT"}}, + {{NULL, (HEK*)&PL_hekpool._PRINTF_.shared_he_hek, {(SV*)1}},{0,sizeof("PRINTF")-1,"PRINTF"}}, + {{NULL, (HEK*)&PL_hekpool._REGEXP_.shared_he_hek, {(SV*)1}},{0,sizeof("REGEXP")-1,"REGEXP"}}, + {{NULL, (HEK*)&PL_hekpool._SCALAR_.shared_he_hek, {(SV*)1}},{0,sizeof("SCALAR")-1,"SCALAR"}}, + {{NULL, (HEK*)&PL_hekpool._SPLICE_.shared_he_hek, {(SV*)1}},{0,sizeof("SPLICE")-1,"SPLICE"}}, + {{NULL, (HEK*)&PL_hekpool._STDERR_.shared_he_hek, {(SV*)1}},{0,sizeof("STDERR")-1,"STDERR"}}, + {{NULL, (HEK*)&PL_hekpool._STDOUT_.shared_he_hek, {(SV*)1}},{0,sizeof("STDOUT")-1,"STDOUT"}}, + {{NULL, (HEK*)&PL_hekpool._ARGVOUT_.shared_he_hek, {(SV*)1}},{0,sizeof("ARGVOUT")-1,"ARGVOUT"}}, + {{NULL, (HEK*)&PL_hekpool._BINMODE_.shared_he_hek, {(SV*)1}},{0,sizeof("BINMODE")-1,"BINMODE"}}, + {{NULL, (HEK*)&PL_hekpool._DESTROY_.shared_he_hek, {(SV*)1}},{0,sizeof("DESTROY")-1,"DESTROY"}}, + {{NULL, (HEK*)&PL_hekpool._INVLIST_.shared_he_hek, {(SV*)1}},{0,sizeof("INVLIST")-1,"INVLIST"}}, + {{NULL, (HEK*)&PL_hekpool._NEXTKEY_.shared_he_hek, {(SV*)1}},{0,sizeof("NEXTKEY")-1,"NEXTKEY"}}, + {{NULL, (HEK*)&PL_hekpool._NULLREF_.shared_he_hek, {(SV*)1}},{0,sizeof("NULLREF")-1,"NULLREF"}}, + {{NULL, (HEK*)&PL_hekpool._TIEHASH_.shared_he_hek, {(SV*)1}},{0,sizeof("TIEHASH")-1,"TIEHASH"}}, + {{NULL, (HEK*)&PL_hekpool._UNKNOWN_.shared_he_hek, {(SV*)1}},{0,sizeof("UNKNOWN")-1,"UNKNOWN"}}, + {{NULL, (HEK*)&PL_hekpool._UNSHIFT_.shared_he_hek, {(SV*)1}},{0,sizeof("UNSHIFT")-1,"UNSHIFT"}}, + {{NULL, (HEK*)&PL_hekpool._VERSION_.shared_he_hek, {(SV*)1}},{0,sizeof("VERSION")-1,"VERSION"}}, + {{NULL, (HEK*)&PL_hekpool._VSTRING_.shared_he_hek, {(SV*)1}},{0,sizeof("VSTRING")-1,"VSTRING"}}, + {{NULL, (HEK*)&PL_hekpool.___END___.shared_he_hek, {(SV*)1}},{0,sizeof("__END__")-1,"__END__"}}, + {{NULL, (HEK*)&PL_hekpool.___SUB___.shared_he_hek, {(SV*)1}},{0,sizeof("__SUB__")-1,"__SUB__"}}, + {{NULL, (HEK*)&PL_hekpool._AUTOLOAD_.shared_he_hek, {(SV*)1}},{0,sizeof("AUTOLOAD")-1,"AUTOLOAD"}}, + {{NULL, (HEK*)&PL_hekpool._FIRSTKEY_.shared_he_hek, {(SV*)1}},{0,sizeof("FIRSTKEY")-1,"FIRSTKEY"}}, + {{NULL, (HEK*)&PL_hekpool._READLINE_.shared_he_hek, {(SV*)1}},{0,sizeof("READLINE")-1,"READLINE"}}, + {{NULL, (HEK*)&PL_hekpool._TIEARRAY_.shared_he_hek, {(SV*)1}},{0,sizeof("TIEARRAY")-1,"TIEARRAY"}}, + {{NULL, (HEK*)&PL_hekpool.___ANON___.shared_he_hek, {(SV*)1}},{0,sizeof("__ANON__")-1,"__ANON__"}}, + {{NULL, (HEK*)&PL_hekpool.___DATA___.shared_he_hek, {(SV*)1}},{0,sizeof("__DATA__")-1,"__DATA__"}}, + {{NULL, (HEK*)&PL_hekpool.___FILE___.shared_he_hek, {(SV*)1}},{0,sizeof("__FILE__")-1,"__FILE__"}}, + {{NULL, (HEK*)&PL_hekpool.___LINE___.shared_he_hek, {(SV*)1}},{0,sizeof("__LINE__")-1,"__LINE__"}}, + {{NULL, (HEK*)&PL_hekpool._EXPORT_OK_.shared_he_hek, {(SV*)1}},{0,sizeof("EXPORT_OK")-1,"EXPORT_OK"}}, + {{NULL, (HEK*)&PL_hekpool._FETCHSIZE_.shared_he_hek, {(SV*)1}},{0,sizeof("FETCHSIZE")-1,"FETCHSIZE"}}, + {{NULL, (HEK*)&PL_hekpool._STORESIZE_.shared_he_hek, {(SV*)1}},{0,sizeof("STORESIZE")-1,"STORESIZE"}}, + {{NULL, (HEK*)&PL_hekpool._TIEHANDLE_.shared_he_hek, {(SV*)1}},{0,sizeof("TIEHANDLE")-1,"TIEHANDLE"}}, + {{NULL, (HEK*)&PL_hekpool._TIESCALAR_.shared_he_hek, {(SV*)1}},{0,sizeof("TIESCALAR")-1,"TIESCALAR"}}, + {{NULL, (HEK*)&PL_hekpool._UNITCHECK_.shared_he_hek, {(SV*)1}},{0,sizeof("UNITCHECK")-1,"UNITCHECK"}}, + {{NULL, (HEK*)&PL_hekpool._UNIVERSAL_.shared_he_hek, {(SV*)1}},{0,sizeof("UNIVERSAL")-1,"UNIVERSAL"}}, + {{NULL, (HEK*)&PL_hekpool.___CLASS___.shared_he_hek, {(SV*)1}},{0,sizeof("__CLASS__")-1,"__CLASS__"}}, + {{NULL, (HEK*)&PL_hekpool._CLONE_SKIP_.shared_he_hek, {(SV*)1}},{0,sizeof("CLONE_SKIP")-1,"CLONE_SKIP"}}, + {{NULL, (HEK*)&PL_hekpool._XS_VERSION_.shared_he_hek, {(SV*)1}},{0,sizeof("XS_VERSION")-1,"XS_VERSION"}}, + {{NULL, (HEK*)&PL_hekpool.___ANONIO___.shared_he_hek, {(SV*)1}},{0,sizeof("__ANONIO__")-1,"__ANONIO__"}}, + {{NULL, (HEK*)&PL_hekpool._EXPORT_TAGS_.shared_he_hek, {(SV*)1}},{0,sizeof("EXPORT_TAGS")-1,"EXPORT_TAGS"}}, + {{NULL, (HEK*)&PL_hekpool.___PACKAGE___.shared_he_hek, {(SV*)1}},{0,sizeof("__PACKAGE__")-1,"__PACKAGE__"}}, + {{NULL, (HEK*)&PL_hekpool._EXPXXXXXXXORT_TAGS_.shared_he_hek, {(SV*)1}},{0,sizeof("EXPXXXXXXXORT_TAGS")-1,"EXPXXXXXXXORT_TAGS"}} +} +; +#endif + +#ifdef DOINIT +static const XPVS_IMM_T hekpool_xpvs = { + {3,0},{4,0},{5,0},{6,0},{7,0},{8,0},{9,0},{10,0},{11,0},{18,0} +}; +#endif + + +#ifndef DOINIT +PERLVAR(G, hekpoolsv, SVHEKP_T) +#else +SVHEKP_T PL_hekpoolsv = { + C_ARRAY_LENGTH(PL_hekpoolsv.u.a), + (U8)((Size_t)(sizeof(XPVS_IMM_T)/sizeof(XPVIMM_T))), + {{ + {(void*)(((Size_t)(&hekpool_xpvs.len3))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._END_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len3))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._ENV_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len3))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._EOF_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len3))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._INC_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len3))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._ISA_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len3))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._POP_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len3))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._REF_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len3))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._SIG_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._ARGV_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._CODE_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._CORE_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._DATA_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._DOES_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._FILE_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._GETC_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._GLOB_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._HASH_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._HOME_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._INIT_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._MASK_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._NAME_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._NULL_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._OPEN_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._PATH_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._PUSH_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._READ_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._SAFE_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._SEEK_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._TELL_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len4))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._TERM_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len5))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._ARRAY_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len5))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._BEGIN_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len5))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._CHECK_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len5))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._CLEAR_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len5))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._CLONE_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len5))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._CLOSE_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len5))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._DEBUG_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len5))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._ERROR_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len5))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._FETCH_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len5))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._FLAGS_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len5))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._PRINT_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len5))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._SHIFT_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len5))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._STDIN_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len5))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._STORE_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len5))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._UNTIE_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len5))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._WRITE_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len6))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._ADJUST_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len6))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._DELETE_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len6))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._EXISTS_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len6))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._EXPORT_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len6))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._EXTEND_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len6))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._FIELDS_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len6))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._FILENO_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len6))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._FORMAT_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len6))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._INCDIR_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len6))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._LVALUE_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len6))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._OBJECT_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len6))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._PRINTF_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len6))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._REGEXP_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len6))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._SCALAR_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len6))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._SPLICE_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len6))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._STDERR_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len6))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._STDOUT_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len7))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._ARGVOUT_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len7))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._BINMODE_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len7))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._DESTROY_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len7))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._INVLIST_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len7))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._NEXTKEY_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len7))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._NULLREF_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len7))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._TIEHASH_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len7))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._UNKNOWN_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len7))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._UNSHIFT_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len7))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._VERSION_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len7))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._VSTRING_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len7))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool.___END___.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len7))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool.___SUB___.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len8))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._AUTOLOAD_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len8))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._FIRSTKEY_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len8))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._READLINE_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len8))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._TIEARRAY_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len8))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool.___ANON___.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len8))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool.___DATA___.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len8))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool.___FILE___.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len8))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool.___LINE___.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len9))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._EXPORT_OK_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len9))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._FETCHSIZE_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len9))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._STORESIZE_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len9))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._TIEHANDLE_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len9))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._TIESCALAR_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len9))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._UNITCHECK_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len9))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._UNIVERSAL_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len9))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool.___CLASS___.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len10))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._CLONE_SKIP_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len10))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._XS_VERSION_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len10))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool.___ANONIO___.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len11))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._EXPORT_TAGS_.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len11))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool.___PACKAGE___.shared_he_hek.hek_key}}, + {(void*)(((Size_t)(&hekpool_xpvs.len18))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool._EXPXXXXXXXORT_TAGS_.shared_he_hek.hek_key}} +}} +} +; +#endif + +#ifdef WANT_HEKPOOL_ASSERT +static SV* +S_assert_hekpool(pTHX){ + const char * lbl = NULL; + if(0) + NOOP; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._END_), SvCUR(&PL_hekpoolsv.u.st._END_),"END")) + lbl = "END"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._ENV_), SvCUR(&PL_hekpoolsv.u.st._ENV_),"ENV")) + lbl = "ENV"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._EOF_), SvCUR(&PL_hekpoolsv.u.st._EOF_),"EOF")) + lbl = "EOF"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._INC_), SvCUR(&PL_hekpoolsv.u.st._INC_),"INC")) + lbl = "INC"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._ISA_), SvCUR(&PL_hekpoolsv.u.st._ISA_),"ISA")) + lbl = "ISA"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._POP_), SvCUR(&PL_hekpoolsv.u.st._POP_),"POP")) + lbl = "POP"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._REF_), SvCUR(&PL_hekpoolsv.u.st._REF_),"REF")) + lbl = "REF"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._SIG_), SvCUR(&PL_hekpoolsv.u.st._SIG_),"SIG")) + lbl = "SIG"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._ARGV_), SvCUR(&PL_hekpoolsv.u.st._ARGV_),"ARGV")) + lbl = "ARGV"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._CODE_), SvCUR(&PL_hekpoolsv.u.st._CODE_),"CODE")) + lbl = "CODE"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._CORE_), SvCUR(&PL_hekpoolsv.u.st._CORE_),"CORE")) + lbl = "CORE"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._DATA_), SvCUR(&PL_hekpoolsv.u.st._DATA_),"DATA")) + lbl = "DATA"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._DOES_), SvCUR(&PL_hekpoolsv.u.st._DOES_),"DOES")) + lbl = "DOES"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._FILE_), SvCUR(&PL_hekpoolsv.u.st._FILE_),"FILE")) + lbl = "FILE"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._GETC_), SvCUR(&PL_hekpoolsv.u.st._GETC_),"GETC")) + lbl = "GETC"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._GLOB_), SvCUR(&PL_hekpoolsv.u.st._GLOB_),"GLOB")) + lbl = "GLOB"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._HASH_), SvCUR(&PL_hekpoolsv.u.st._HASH_),"HASH")) + lbl = "HASH"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._HOME_), SvCUR(&PL_hekpoolsv.u.st._HOME_),"HOME")) + lbl = "HOME"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._INIT_), SvCUR(&PL_hekpoolsv.u.st._INIT_),"INIT")) + lbl = "INIT"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._MASK_), SvCUR(&PL_hekpoolsv.u.st._MASK_),"MASK")) + lbl = "MASK"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._NAME_), SvCUR(&PL_hekpoolsv.u.st._NAME_),"NAME")) + lbl = "NAME"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._NULL_), SvCUR(&PL_hekpoolsv.u.st._NULL_),"NULL")) + lbl = "NULL"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._OPEN_), SvCUR(&PL_hekpoolsv.u.st._OPEN_),"OPEN")) + lbl = "OPEN"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._PATH_), SvCUR(&PL_hekpoolsv.u.st._PATH_),"PATH")) + lbl = "PATH"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._PUSH_), SvCUR(&PL_hekpoolsv.u.st._PUSH_),"PUSH")) + lbl = "PUSH"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._READ_), SvCUR(&PL_hekpoolsv.u.st._READ_),"READ")) + lbl = "READ"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._SAFE_), SvCUR(&PL_hekpoolsv.u.st._SAFE_),"SAFE")) + lbl = "SAFE"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._SEEK_), SvCUR(&PL_hekpoolsv.u.st._SEEK_),"SEEK")) + lbl = "SEEK"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._TELL_), SvCUR(&PL_hekpoolsv.u.st._TELL_),"TELL")) + lbl = "TELL"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._TERM_), SvCUR(&PL_hekpoolsv.u.st._TERM_),"TERM")) + lbl = "TERM"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._ARRAY_), SvCUR(&PL_hekpoolsv.u.st._ARRAY_),"ARRAY")) + lbl = "ARRAY"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._BEGIN_), SvCUR(&PL_hekpoolsv.u.st._BEGIN_),"BEGIN")) + lbl = "BEGIN"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._CHECK_), SvCUR(&PL_hekpoolsv.u.st._CHECK_),"CHECK")) + lbl = "CHECK"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._CLEAR_), SvCUR(&PL_hekpoolsv.u.st._CLEAR_),"CLEAR")) + lbl = "CLEAR"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._CLONE_), SvCUR(&PL_hekpoolsv.u.st._CLONE_),"CLONE")) + lbl = "CLONE"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._CLOSE_), SvCUR(&PL_hekpoolsv.u.st._CLOSE_),"CLOSE")) + lbl = "CLOSE"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._DEBUG_), SvCUR(&PL_hekpoolsv.u.st._DEBUG_),"DEBUG")) + lbl = "DEBUG"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._ERROR_), SvCUR(&PL_hekpoolsv.u.st._ERROR_),"ERROR")) + lbl = "ERROR"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._FETCH_), SvCUR(&PL_hekpoolsv.u.st._FETCH_),"FETCH")) + lbl = "FETCH"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._FLAGS_), SvCUR(&PL_hekpoolsv.u.st._FLAGS_),"FLAGS")) + lbl = "FLAGS"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._PRINT_), SvCUR(&PL_hekpoolsv.u.st._PRINT_),"PRINT")) + lbl = "PRINT"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._SHIFT_), SvCUR(&PL_hekpoolsv.u.st._SHIFT_),"SHIFT")) + lbl = "SHIFT"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._STDIN_), SvCUR(&PL_hekpoolsv.u.st._STDIN_),"STDIN")) + lbl = "STDIN"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._STORE_), SvCUR(&PL_hekpoolsv.u.st._STORE_),"STORE")) + lbl = "STORE"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._UNTIE_), SvCUR(&PL_hekpoolsv.u.st._UNTIE_),"UNTIE")) + lbl = "UNTIE"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._WRITE_), SvCUR(&PL_hekpoolsv.u.st._WRITE_),"WRITE")) + lbl = "WRITE"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._ADJUST_), SvCUR(&PL_hekpoolsv.u.st._ADJUST_),"ADJUST")) + lbl = "ADJUST"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._DELETE_), SvCUR(&PL_hekpoolsv.u.st._DELETE_),"DELETE")) + lbl = "DELETE"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._EXISTS_), SvCUR(&PL_hekpoolsv.u.st._EXISTS_),"EXISTS")) + lbl = "EXISTS"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._EXPORT_), SvCUR(&PL_hekpoolsv.u.st._EXPORT_),"EXPORT")) + lbl = "EXPORT"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._EXTEND_), SvCUR(&PL_hekpoolsv.u.st._EXTEND_),"EXTEND")) + lbl = "EXTEND"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._FIELDS_), SvCUR(&PL_hekpoolsv.u.st._FIELDS_),"FIELDS")) + lbl = "FIELDS"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._FILENO_), SvCUR(&PL_hekpoolsv.u.st._FILENO_),"FILENO")) + lbl = "FILENO"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._FORMAT_), SvCUR(&PL_hekpoolsv.u.st._FORMAT_),"FORMAT")) + lbl = "FORMAT"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._INCDIR_), SvCUR(&PL_hekpoolsv.u.st._INCDIR_),"INCDIR")) + lbl = "INCDIR"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._LVALUE_), SvCUR(&PL_hekpoolsv.u.st._LVALUE_),"LVALUE")) + lbl = "LVALUE"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._OBJECT_), SvCUR(&PL_hekpoolsv.u.st._OBJECT_),"OBJECT")) + lbl = "OBJECT"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._PRINTF_), SvCUR(&PL_hekpoolsv.u.st._PRINTF_),"PRINTF")) + lbl = "PRINTF"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._REGEXP_), SvCUR(&PL_hekpoolsv.u.st._REGEXP_),"REGEXP")) + lbl = "REGEXP"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._SCALAR_), SvCUR(&PL_hekpoolsv.u.st._SCALAR_),"SCALAR")) + lbl = "SCALAR"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._SPLICE_), SvCUR(&PL_hekpoolsv.u.st._SPLICE_),"SPLICE")) + lbl = "SPLICE"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._STDERR_), SvCUR(&PL_hekpoolsv.u.st._STDERR_),"STDERR")) + lbl = "STDERR"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._STDOUT_), SvCUR(&PL_hekpoolsv.u.st._STDOUT_),"STDOUT")) + lbl = "STDOUT"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._ARGVOUT_), SvCUR(&PL_hekpoolsv.u.st._ARGVOUT_),"ARGVOUT")) + lbl = "ARGVOUT"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._BINMODE_), SvCUR(&PL_hekpoolsv.u.st._BINMODE_),"BINMODE")) + lbl = "BINMODE"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._DESTROY_), SvCUR(&PL_hekpoolsv.u.st._DESTROY_),"DESTROY")) + lbl = "DESTROY"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._INVLIST_), SvCUR(&PL_hekpoolsv.u.st._INVLIST_),"INVLIST")) + lbl = "INVLIST"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._NEXTKEY_), SvCUR(&PL_hekpoolsv.u.st._NEXTKEY_),"NEXTKEY")) + lbl = "NEXTKEY"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._NULLREF_), SvCUR(&PL_hekpoolsv.u.st._NULLREF_),"NULLREF")) + lbl = "NULLREF"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._TIEHASH_), SvCUR(&PL_hekpoolsv.u.st._TIEHASH_),"TIEHASH")) + lbl = "TIEHASH"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._UNKNOWN_), SvCUR(&PL_hekpoolsv.u.st._UNKNOWN_),"UNKNOWN")) + lbl = "UNKNOWN"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._UNSHIFT_), SvCUR(&PL_hekpoolsv.u.st._UNSHIFT_),"UNSHIFT")) + lbl = "UNSHIFT"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._VERSION_), SvCUR(&PL_hekpoolsv.u.st._VERSION_),"VERSION")) + lbl = "VERSION"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._VSTRING_), SvCUR(&PL_hekpoolsv.u.st._VSTRING_),"VSTRING")) + lbl = "VSTRING"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st.___END___), SvCUR(&PL_hekpoolsv.u.st.___END___),"__END__")) + lbl = "__END__"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st.___SUB___), SvCUR(&PL_hekpoolsv.u.st.___SUB___),"__SUB__")) + lbl = "__SUB__"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._AUTOLOAD_), SvCUR(&PL_hekpoolsv.u.st._AUTOLOAD_),"AUTOLOAD")) + lbl = "AUTOLOAD"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._FIRSTKEY_), SvCUR(&PL_hekpoolsv.u.st._FIRSTKEY_),"FIRSTKEY")) + lbl = "FIRSTKEY"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._READLINE_), SvCUR(&PL_hekpoolsv.u.st._READLINE_),"READLINE")) + lbl = "READLINE"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._TIEARRAY_), SvCUR(&PL_hekpoolsv.u.st._TIEARRAY_),"TIEARRAY")) + lbl = "TIEARRAY"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st.___ANON___), SvCUR(&PL_hekpoolsv.u.st.___ANON___),"__ANON__")) + lbl = "__ANON__"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st.___DATA___), SvCUR(&PL_hekpoolsv.u.st.___DATA___),"__DATA__")) + lbl = "__DATA__"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st.___FILE___), SvCUR(&PL_hekpoolsv.u.st.___FILE___),"__FILE__")) + lbl = "__FILE__"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st.___LINE___), SvCUR(&PL_hekpoolsv.u.st.___LINE___),"__LINE__")) + lbl = "__LINE__"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._EXPORT_OK_), SvCUR(&PL_hekpoolsv.u.st._EXPORT_OK_),"EXPORT_OK")) + lbl = "EXPORT_OK"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._FETCHSIZE_), SvCUR(&PL_hekpoolsv.u.st._FETCHSIZE_),"FETCHSIZE")) + lbl = "FETCHSIZE"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._STORESIZE_), SvCUR(&PL_hekpoolsv.u.st._STORESIZE_),"STORESIZE")) + lbl = "STORESIZE"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._TIEHANDLE_), SvCUR(&PL_hekpoolsv.u.st._TIEHANDLE_),"TIEHANDLE")) + lbl = "TIEHANDLE"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._TIESCALAR_), SvCUR(&PL_hekpoolsv.u.st._TIESCALAR_),"TIESCALAR")) + lbl = "TIESCALAR"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._UNITCHECK_), SvCUR(&PL_hekpoolsv.u.st._UNITCHECK_),"UNITCHECK")) + lbl = "UNITCHECK"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._UNIVERSAL_), SvCUR(&PL_hekpoolsv.u.st._UNIVERSAL_),"UNIVERSAL")) + lbl = "UNIVERSAL"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st.___CLASS___), SvCUR(&PL_hekpoolsv.u.st.___CLASS___),"__CLASS__")) + lbl = "__CLASS__"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._CLONE_SKIP_), SvCUR(&PL_hekpoolsv.u.st._CLONE_SKIP_),"CLONE_SKIP")) + lbl = "CLONE_SKIP"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._XS_VERSION_), SvCUR(&PL_hekpoolsv.u.st._XS_VERSION_),"XS_VERSION")) + lbl = "XS_VERSION"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st.___ANONIO___), SvCUR(&PL_hekpoolsv.u.st.___ANONIO___),"__ANONIO__")) + lbl = "__ANONIO__"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._EXPORT_TAGS_), SvCUR(&PL_hekpoolsv.u.st._EXPORT_TAGS_),"EXPORT_TAGS")) + lbl = "EXPORT_TAGS"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st.___PACKAGE___), SvCUR(&PL_hekpoolsv.u.st.___PACKAGE___),"__PACKAGE__")) + lbl = "__PACKAGE__"; + else if(memNEs(SvPVX(&PL_hekpoolsv.u.st._EXPXXXXXXXORT_TAGS_), SvCUR(&PL_hekpoolsv.u.st._EXPXXXXXXXORT_TAGS_),"EXPXXXXXXXORT_TAGS")) + lbl = "EXPXXXXXXXORT_TAGS"; + if(lbl) + return newSVpvn_flags(lbl,strlen(lbl),SVs_TEMP); + else + return &PL_sv_undef; +} +#endif + + +#define SV_CONST2(_tok) (!PL_hekpool._##_tok##_.shared_he_hek.hek_hash \ + ? sv_vivihek(&PL_hekpoolsv.u.st._##_tok##_) \ + : &PL_hekpoolsv.u.st._##_tok##_) +#define PV_POOL(_tok,_tokpv) ((const char*)PL_hekpool._##_tok##_.shared_he_hek.hek_key) +/* XXX TODO macro needs rework, this can't CC fold */ +#define PVN_POOL(_tok,_tokpv) (PL_hekpool._##_tok##_.shared_he_hek.hek_len) +#define HEK_POOL(_tok,_tokpv) (&PL_hekpool._##_tok##_.shared_he_hek) +/* is equal, len must be abs match, then memcmp() done. We are comparing + against the string in the HEK, and NOT a generic C "" lit created by + CC/link, for cache reasons, smaller libperl file size, and very often + in Perl VM, L and R ptrs will be the same, as the gShHEHEK circulates + and spreads around the interp, and the gShHEHEK's char* often degrades in + in patterns like HEK->SV->PVN->its Jan 1 1970 strlen() time. + Throughout layers of call frames in interp C/XS and CPAN C/XS, but even + after loosing its HEK and SV containers, and maybe getting redundantly + strlen()ed in some parent call frame, the gShHEHEK's char* reappears + as L side input to memEQhp(). So don't memcmp() against a same contents + generic C "" lit. */ +#define memEQhp(_s,_l,_tok,_qqpv) ((_l) == sizeof(_qqpv)-1 && memEQ((_s), \ + (char*)PL_hekpool._##_tok##_.shared_he_hek.hek_key, sizeof(_qqpv)-1)) + +#define SV_POOLLEN C_ARRAY_LENGTH(PL_hekpoolsv.u.a) +#define SV_POOLSTART (&PL_hekpoolsv.u.a[0]) +/* 1 beyond last, test with < not <= */ +#define SV_POOLEND (&PL_hekpoolsv.u.a[SV_POOLLEN]) + +/* The GblShHE/HEKs can't be iterated using a loop b/c they are packed var + lengths. Adding to libperl, a const HE* array of GblShHE/HEKs is a waste of + disk space. Indirectly, GblShHE/HEKs can be looped over through the array + of corresponding immortal/pooled SV heads. */ + +/* range test isn't at HEHEK[0]'s 1st str char .hek_key*/ +#define IS_HEKPOOL(_hek) (((Size_t)(_hek))>=((Size_t)(&PL_hekpool)) \ + && ((Size_t)(_hek))<(((Size_t)(&PL_hekpool))+sizeof(PL_hekpool)) \ + ?TRUE:FALSE) +#define IS_SVPOOL(_sv) (((Size_t)(_sv))>=((Size_t)(&PL_hekpoolsv.u.st)) \ + && ((Size_t)(_sv))<(((Size_t)(&PL_hekpoolsv.u.st))+sizeof(PL_hekpoolsv.u.st)) \ + ?TRUE:FALSE) + + +/* ex: set ro ft=c: */ diff --git a/hv.c b/hv.c index c3d65cc72e16..fb2d56f2d1f5 100644 --- a/hv.c +++ b/hv.c @@ -177,6 +177,9 @@ S_new_he(pTHX) #endif +STATIC HE * +S_hek_vivipvn(const char *try_str, STRLEN len); + STATIC HEK * S_save_hek_flags(const char *str, I32 len, U32 hash, int flags) { @@ -232,9 +235,37 @@ Perl_hek_dup(pTHX_ HEK *source, CLONE_PARAMS* param) (void)share_hek_hek(shared); } else { + if(IS_HEKPOOL(source)) { + HE* she = NUM2PTR(HE*, PTR2nat(source) + -STRUCT_OFFSET(struct shared_he,shared_he_hek)); + U32 hash = HEK_HASH(source); + const U32 hindex = hash & (I32) HvMAX(PL_strtab); + HE* entry = (HvARRAY(PL_strtab))[hindex]; + /* check if already added to new thread's PL_strtab*/ + for (;entry; entry = HeNEXT(entry)) { + if (entry != she) /* just match on gShHEHEK *, it will be the same for all ithreads b/c bottom of collision list rule */ + continue; + else + break; + } + if(!entry) { // add gShHEHEK to HV* PL_strtab in the new thread + HE * gentry = S_hek_vivipvn(HEK_KEY(source), HEK_LEN(source)); + if(!gentry) { + goto make_he; + } + if(gentry != she) { + __debugbreak(); + } + } + ++she->he_valu.hent_refcount; /* like share_hek_flags() */ + shared = source; + } + else { + make_he: shared = share_hek_flags(HEK_KEY(source), HEK_LEN(source), HEK_HASH(source), HEK_FLAGS(source)); + } ptr_table_store(PL_ptr_table, source, shared); } return shared; @@ -282,9 +313,37 @@ Perl_he_dup(pTHX_ const HE *e, bool shared, CLONE_PARAMS* param) (void)share_hek_hek(shared); } else { - shared + if(IS_HEKPOOL(source)) { + HE* she = NUM2PTR(HE*, PTR2nat(source) + -STRUCT_OFFSET(struct shared_he,shared_he_hek)); + U32 hash = HEK_HASH(source); + const U32 hindex = hash & (I32) HvMAX(PL_strtab); + HE* entry = (HvARRAY(PL_strtab))[hindex]; + /* check if already added to new thread's PL_strtab*/ + for (;entry; entry = HeNEXT(entry)) { + if (entry != she) /* just match on gShHEHEK *, it will be the same for all ithreads b/c bottom of collision list rule */ + continue; + else + break; + } + if(!entry) { // add gShHEHEK to HV* PL_strtab in the new thread + HE * gentry = S_hek_vivipvn(HEK_KEY(source), HEK_LEN(source)); + if(!gentry) { + goto make_he; + } + if(gentry != she) { + __debugbreak(); + } + } + ++she->he_valu.hent_refcount; /* like share_hek_flags() */ + shared = source; + } + else { + make_he: + shared = share_hek_flags(HEK_KEY(source), HEK_LEN(source), HEK_HASH(source), HEK_FLAGS(source)); + } ptr_table_store(PL_ptr_table, source, shared); } HeKEY_hek(ret) = shared; @@ -1708,12 +1767,25 @@ S_hsplit(pTHX_ HV *hv, STRLEN const oldsize, STRLEN newsize) U32 j = (HeHASH(entry) & newsize); if (j != (U32)i) { *oentry = HeNEXT(entry); +/* all gHEKPOOLs must be on the tail ends of HE collision chains b/c they are + seen by multiple ithreads at the same time. If a Newx()ed per-interp ShHeHek + winds up after a GShHeHEK, a wrong inter-ithread refcnt++ and wrong RC + ownership will happen between 2 ithreads. And a likely Unix/100% Win32 + SEGV will happen when an ithread is destroyed. 100% on Win32 b/c WinPerl + has its own malloc(), and doesn't use MS LibC/CRT malloc(). */ + if(IS_HEKPOOL(entry)) { + HE** ocursor = &aep[j]; + while (*ocursor && !IS_HEKPOOL(*ocursor) && HeNEXT(*ocursor)) { + ocursor = &HeNEXT(*ocursor); + } + *ocursor = entry; + } #ifdef PERL_HASH_RANDOMIZE_KEYS /* if the target cell is empty or PL_HASH_RAND_BITS_ENABLED is false * insert to top, otherwise rotate the bucket rand 1 bit, * and use the new low bit to decide if we insert at top, * or next from top. IOW, we only rotate on a collision.*/ - if (aep[j] && PL_HASH_RAND_BITS_ENABLED) { + else if (aep[j] && PL_HASH_RAND_BITS_ENABLED) { UPDATE_HASH_RAND_BITS(); if (PL_hash_rand_bits & 1) { HeNEXT(entry)= HeNEXT(aep[j]); @@ -1768,7 +1840,16 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax) wantsize = (I32) newmax; /* possible truncation here */ if (wantsize != newmax) - return; + return; /*XXX TODO add croak OOM, your code is PP leaking and + adding unstable-ness to perl VM state ???? 2 billion keys in 1 HV??? + Are you okay with 67,108,863 HEs in HeARRAY and 2,147,483,648 - 67,108,863 + 2,147,483,648 - 67,108,863 = 2,080,374,785 HE collisions hanging + off in LLs? Your newmax value says you actually will insert count + newmax new HV Keys/HEs, and you have the input data *somewhere* to + generate 2,147,483,648 unique ascii strings. + + Perl interp did not yet, do any voluntary/optional/speculative + performance round-ing ups, to your requested length. */ wantsize= wantsize + (wantsize >> 1); /* wantsize *= 1.5 */ if (wantsize < newmax) /* overflow detection */ @@ -3351,12 +3432,15 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash) } } - if (!entry) + if (!entry) { + //__debugbreak(); + Perl_ck_warner_d(aTHX_ packWARN(WARN_INTERNAL), "Attempt to free nonexistent shared string '%s'%s" pTHX__FORMAT, hek ? HEK_KEY(hek) : str, ((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE); + } if (k_flags & HVhek_FREEKEY) Safefree(str); } @@ -3399,12 +3483,82 @@ Perl_share_hek(pTHX_ const char *str, SSize_t len, U32 hash) return share_hek_flags (str, len, hash, flags); } +/* CHANGED!!! only vivifier that auto RC++es ans gives caller ownership of a RC + 1*/ +STATIC HE * +S_hek_vivipvn(const char *try_str, STRLEN len) { + struct shared_he* she; + HEK* hek; + SV* sv; + SV* svstart; + SV* svend; + SV* svmid; + SV* svmid2; + const char *str; + Size_t idx; + U32 chrs32u; + +//U8TO32_LE(ptr) + svend = svstart = SV_POOLSTART; + svstart = NUM2PTR(SV*,PTR2nat(svstart)+PL_hpfastm.leninfo[len-HPOOLPV_MIN].svoffst); + sv = svstart; + if(SvCUR(sv) != len) + __debugbreak(); + svend = NUM2PTR(SV*,PTR2nat(svend)+PL_hpfastm.leninfo[len-HPOOLPV_MIN].svoffend); + idx = ((svend-sv)>>1); + svmid = sv+idx; + svmid2 = &(sv[idx]); + //printf("sv %p sv %p idx %d sv %p sv %p c %c c %c\n", sv, svend , idx, svmid, svmid2, try_str[0], SvPVX(svmid)[0]); + if(try_str[0] > SvPVX(svmid)[0] ) { + if( svmid < svend) { + sv = svmid; + } + } + else if(try_str[0] < SvPVX(svmid)[0] ){ + if(svmid >= svstart) { + svend = svmid; + } + } + chrs32u = U8TO32_LE(try_str); + if(len == 3) + chrs32u &= 0x00FFFFFF; + const char * const try_at4_str = len > 4 ? try_str+4 : NULL; + const U32 try_at4_len = len > 4 ? len-4 : 0; + while(sv < svend) { + str = (const char *)SvPVX(sv); + she = (struct shared_he*)((Size_t)( + ((Size_t)str) + -STRUCT_OFFSET(struct shared_he,shared_he_hek.hek_key[0])) + ); + hek = &she->shared_he_hek; + if(try_str == str + //|| (len == HEK_LEN(hek) /* we can be given a sub string ??? but incoming len already proved sv head lens and ranges*/ + ||( chrs32u == *(U32*)str /* start of hek_key is aligned */ + && (try_at4_str + ? memEQ(try_at4_str, str+4, try_at4_len) + : TRUE) + ) + ){ + if(!HEK_HASH(hek)){ + /* sv = */ + sv_vivihek(sv); + } + /* behave like S_share_hek_flags() */ + //she->shared_he_he.he_valu.hent_refcount++; + //hek = &she->shared_he_hek; + HE * he = &she->shared_he_he; + return he; + } + sv++; + } + return NULL; +} + STATIC HEK * S_share_hek_flags(pTHX_ const char *str, STRLEN len, U32 hash, int flags) { HE *entry; const U8 flags_masked = flags & HVhek_STORAGE_MASK; - const U32 hindex = hash & (I32) HvMAX(PL_strtab); + PERL_ARGS_ASSERT_SHARE_HEK_FLAGS; assert(!(flags & HVhek_NOTSHARED)); @@ -3412,7 +3566,57 @@ S_share_hek_flags(pTHX_ const char *str, STRLEN len, U32 hash, int flags) if (UNLIKELY(len > (STRLEN) I32_MAX)) { Perl_croak_nocontext("Sorry, hash keys must be smaller than 2**31 bytes"); } - + //IS_MAYBE_HPOOL(str, len) 0.1.2.3 + // + if( ((PTR2nat(str) & PL_hpool_mask) == PL_hpool_vm_seg) + && (PTR2nat(str) >= + PTR2nat(&(((struct shared_he*)(&PL_hekpool))->shared_he_hek.hek_key[0]))) + && PTR2nat(str) < (((Size_t)(&PL_hekpool))+sizeof(PL_hekpool))) { + struct shared_he* she = (struct shared_he*) ((Size_t)(((Size_t)str) + -STRUCT_OFFSET(struct shared_he,shared_he_hek.hek_key[0]))); + HEK* sanityhek = &she->shared_he_hek; + I32 sanitylen = HEK_LEN(sanityhek); + U32 sanityhash = HEK_HASH(sanityhek); + if(len == sanitylen) { + if(sanityhash) { + if(hash == sanityhash) { + entry = (HE*)she; + goto have_he; + } + else{ + __debugbreak(); // really bad, its a ptr, to somewhere random in our pool + //sub strs and offsets and chops and :: can make it happen + goto full_chk; + } + } + else { + goto full_chk; + //goto need_vivi; + } + } + } + full_chk: + if( len <= HPOOLPV_MAX /* shifting over 32 for U32 is Intel CPUs only */ + //&& len >= HPOOLPV_MIN + && (1<he_valu.hent_refcount; if (flags & HVhek_FREEKEY) @@ -3487,6 +3692,275 @@ S_share_hek_flags(pTHX_ const char *str, STRLEN len, U32 hash, int flags) return HeKEY_hek(entry); } +/* SV* sv must be a SV* from/into the C static/global HEKPOOL. + This fn will fill in the U32 hash, and then add shared HE/HEK + object into the per-interp HV* PL_strtab. Once added, this C global + shared HE/HEK will never be freed or delinked for the remainder of the + perl process/my_perl lifetime. ithread/psuedofork clone process will + inefficiently dup this HEKPOOL shared HE/HEK into a regular Newx()ed + shared HE/HEK. Tough luck, or write a fix. + + This function is not be called except through SV_CONST2(). Bad things + happen if called twice on same HEKPOOL SV*, or a non-HEKPOOL SV*. + + Parameter is a SV* instead of 0-based index for a reason. In each caller we + already paid the price in machine code to do "abs addr generation" in the + hot branch (x86 LEA op), so reuse the abs ptr as input for cold path, + vs the CC emitting "push_c_stk(3);" op or "push_c_stk(13);" op that will + almost never be executed. Savings: x86/x64 1/4 bytes (lit int U8/U32); + RISCs: 4 bytes/1 op, "store_to_reg(3,reg); push_c_stk(reg);" -> + "push_c_stk(reg);" For clarity, on __regcall ABI OSes, after CC -O1/-O2, + the conceptual "push_c_stk(reg);" op, was probably optimized away, + if you check with disasm view. */ + +SV* +Perl_sv_vivihek(SV* const sv) { + dTHX; /* Fn is 1 shot per proc. Alot of unique callers/refs, but this + fn is very cold by call count, so minimize the machine code overhead of + error branch "sv_vivi(&PL_poolsv)" at the cost of 1-10 microsecs inside + error path to execute dTHX, inside a statement like this: + + sv = !VIVIFIED(&PL_poolsv) ? sv_vivi(&PL_poolsv) : &PL_poolsv; */ + PERL_ARGS_ASSERT_SV_VIVIHEK; + struct shared_he * she; + const char * const str = (const char *)SvPVX(sv); + //const I32 len = (I32)SvCUR(sv); + U32 hash; + HEK* hek; + I32 len; + + + + she = (struct shared_he*) + ((Size_t)(((Size_t)str) + -STRUCT_OFFSET(struct shared_he,shared_he_hek.hek_key[0]))); + hek = &she->shared_he_hek; + len = HEK_LEN(hek); + hash = HEK_HASH(hek); + if(hash) + __debugbreak(); + else { + PERL_HASH(hash, str, len); + HEK_HASH(hek) = hash; + } + +/* Don't keep re-reading struct my_perl. PL_strtab = NULL; + is death by lighting. local(HvARRAY(PL_strtab)); is a blood sport. + The bookie is open and taking wagers for LOC executed before perl + SEGVs or fatal exceptions. In this fn, only HvARRAY can be realloced. + xhv will not realloc, b/c nothing here does basic HV body -> HvAUX() upgrade. + */ + HV* _PL_strtab = PL_strtab; + XPVHV * xhv = (XPVHV*)SvANY(_PL_strtab); + const U32 hindex = hash & (I32) HvMAX((HV*)&xhv); + struct shared_he ** head = (struct shared_he **)&HvARRAY(_PL_strtab)[hindex]; + HE *entry = (HE *)*head; + HE *col_entry = NULL; + for (;entry; entry = HeNEXT(entry)) { + col_entry = entry; + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != (SSize_t) len) + continue; + if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */ + continue; + if (HeKFLAGS(entry) != 0) /* HEKPOOL can't have UTF8 */ + continue; + break; + } + if (entry) { + if((struct shared_he*)entry == she) { + return sv; + } + __debugbreak(); + } + //struct shared_he ** const head = &HvARRAY(PL_strtab)[hindex]; + //struct shared_he * const oldhe = *head; + struct shared_he * const oldhe = (struct shared_he *)entry; /* var unused */ + struct shared_he * const newhe = (struct shared_he*)((Size_t)( + ((Size_t)str) + -STRUCT_OFFSET(struct shared_he,shared_he_hek.hek_key[0])) + ); + /* 99% chance this is 1 -> 2, RC #1 is owned by libperl.sp/perlXX.dll. + Remember about ithreads. */ + newhe->shared_he_he.he_valu.hent_refcount++; + xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ + if(col_entry) { + HeNEXT(col_entry) = &newhe->shared_he_he; + if ( DO_HSPLIT(xhv) ) { + const STRLEN oldsize = HvMAX((HV*)&xhv) + 1; + hsplit(_PL_strtab, oldsize, oldsize * 2); + } + } + else { + *head = newhe; + } + return sv; +} + +/* used during ithread clone process, injects the ENTIRE HEKPOOL into + pTHX's HV* PL_strtab, and RC +1s, with pTHX's HV* PL_strtab being the + owner of the +1. pTHX is supposed to be a brand new child my_perl. + This fn hasn't been tested on inflating the entire HEKPOOL into a root + my_perl or a RUN phase my_perl. To fix this, at minimum, fix this fn + to check for previous HEK_HASH() validity, and generate/set HEK_HASH() + if 0. Currently this fn assumes 1 nanosecond ago, the entire HEKPOOL was + inflated and injected into the root/parent my_perl. + + XXXX INCOMPL NOTE Note inside Perl_hek_dup/share_hek_hek/share_hek_flags + */ + +void +Perl_sv_viviall_hekpool(pTHX) { + const char * str; + I32 len; + U32 hash; + SV* sv; + struct shared_he* she; + HEK* hek; + U32 hindex; + HE *entry; + struct shared_he ** head; + struct shared_he * oldhe; + HE *col_entry; + HV* _PL_strtab = PL_strtab; /* Don't re-read, see Perl_sv_vivihek() */ + XPVHV * xhv = (XPVHV*)SvANY(_PL_strtab); + hv_ksplit(_PL_strtab, HvTOTALKEYS((HV*)&xhv)+SV_POOLLEN); /* + ~35 */ + + sv = SV_POOLSTART; + while(sv < SV_POOLEND) { + len = (I32)SvCUR(sv); + str = (const char *)SvPVX(sv); + she = (struct shared_he*) + ((Size_t)(((Size_t)str) + -STRUCT_OFFSET(struct shared_he,shared_he_hek.hek_key[0]))); + hek = &she->shared_he_hek; + hash = HEK_HASH(hek); + if(!hash) { + PERL_HASH(hash, str, len); + HEK_HASH(hek) = hash; + } + hindex = hash & (I32) HvMAX((HV*)&xhv); + head = (struct shared_he **)&HvARRAY(_PL_strtab)[hindex]; + entry = (HE *)*head; + col_entry = NULL; + for (;entry; entry = HeNEXT(entry)) { + col_entry = entry; + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != (SSize_t) len) + continue; + if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */ + continue; + if (HeKFLAGS(entry) != 0) /* HEKPOOL can't have UTF8 */ + continue; + break; + } + if (entry) { + if((struct shared_he*)entry == she) { + sv++; + continue; + } + __debugbreak(); + } + she->shared_he_he.he_valu.hent_refcount++; + xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ + if(col_entry) { + HeNEXT(col_entry) = &she->shared_he_he; + if ( DO_HSPLIT(xhv) ) { + const STRLEN oldsize = HvMAX((HV*)&xhv) + 1; + hsplit(_PL_strtab, oldsize, oldsize * 2); + } + } + else { + *head = she; + } + sv++; + } +} + +/* embedder using libperl inside 1 process lifespan: + my_perl #1 constructs or starts -> #1 runs alot of code -> #1 perl_destroy() + -> app does other things -> my_perl #2 constructs -> #2 runs alot of code + -> #2 perl_destroy()-> app does process exit() + + the 2 my_perl pointers were not aware of each other's existance, not in + overlapping time-wise parallel, not serially 1 after another, but the hash + numbers were already generated by an unknown previous my_perl, and sitting + in libperl.so/.dll, so slurp up all vivified HEKPOOL strings at the next + perl_construct(), we already paid for the CPU, and SV_CONST() lazy hasher + macro depends on "if(!HEK_HASH(GShHeHek) == 0) add_to_PL_strtab(GShHeHek);" */ +void +Perl_sv_vivisome_hekpool(pTHX) { + const char * str; + I32 len; + U32 hash; + SV* sv; + struct shared_he* she; + HEK* hek; + //bool hekp_is_hashed; + U32 hindex; + HE *entry; + struct shared_he ** head; + struct shared_he * oldhe; + HE *col_entry; + HV* _PL_strtab = PL_strtab; /* Don't re-read, see Perl_sv_vivihek() */ + XPVHV * xhv = (XPVHV*)SvANY(_PL_strtab); + hv_ksplit(_PL_strtab, HvTOTALKEYS((HV*)&xhv)+SV_POOLLEN); /* + ~35 */ + + sv = SV_POOLSTART; + while(sv < SV_POOLEND) { + len = (I32)SvCUR(sv); + str = (const char *)SvPVX(sv); + she = (struct shared_he*) + ((Size_t)(((Size_t)str) + -STRUCT_OFFSET(struct shared_he,shared_he_hek.hek_key[0]))); + hek = &she->shared_he_hek; + hash = HEK_HASH(hek); + //hekp_is_hashed = hash ? TRUE : FALSE; + //if(!hekp_is_hashed) { /*no parallel or former my_perl ever vivifyed it, we dont either */ + if(!hash) { + sv++; + continue; + } + hindex = hash & (I32) HvMAX((HV*)&xhv); + head = (struct shared_he **)&HvARRAY(_PL_strtab)[hindex]; + entry = (HE *)*head; + col_entry = NULL; + for (;entry; entry = HeNEXT(entry)) { + col_entry = entry; + if (HeHASH(entry) != hash) /* strings can't be equal */ + continue; + if (HeKLEN(entry) != (SSize_t) len) + continue; + if (HeKEY(entry) != str && memNE(HeKEY(entry),str,len)) /* is this it? */ + continue; + if (HeKFLAGS(entry) != 0) /* HEKPOOL can't have UTF8 */ + continue; + break; + } + if (entry) { + if((struct shared_he*)entry == she) { + sv++; + continue; + } + __debugbreak(); + } + she->shared_he_he.he_valu.hent_refcount++; + xhv->xhv_keys++; /* HvTOTALKEYS(hv)++ */ + if(col_entry) { + HeNEXT(col_entry) = &she->shared_he_he; + if ( DO_HSPLIT(xhv) ) { + const STRLEN oldsize = HvMAX((HV*)&xhv) + 1; + hsplit(_PL_strtab, oldsize, oldsize * 2); + } + } + else { + *head = she; + } + sv++; + } +} SSize_t * Perl_hv_placeholders_p(pTHX_ HV *hv) diff --git a/intrpvar.h b/intrpvar.h index 921d15d38c95..e084e94921c4 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -494,6 +494,7 @@ PERLVAR(I, incgv, GV *) PERLVAR(I, hintgv, GV *) PERLVAR(I, origfilename, char *) PERLVARI(I, xsubfilename, const char *, NULL) +PERLVAR(I, lastcopfile, struct cop_lastfile) PERLVAR(I, diehook, SV *) PERLVAR(I, warnhook, SV *) /* keyword hooks*/ diff --git a/mg.c b/mg.c index c2a722cc75eb..8be934003390 100644 --- a/mg.c +++ b/mg.c @@ -2205,7 +2205,7 @@ Perl_magic_getpack(pTHX_ SV *sv, MAGIC *mg) if (mg->mg_type == PERL_MAGIC_tiedelem) mg->mg_flags |= MGf_GSKIP; - magic_methpack(sv,mg,SV_CONST(FETCH)); + magic_methpack(sv,mg,SV_CONST2(FETCH)); return 0; } @@ -2236,7 +2236,7 @@ Perl_magic_setpack(pTHX_ SV *sv, MAGIC *mg) else val = sv; - magic_methcall1(sv, mg, SV_CONST(STORE), G_DISCARD, 2, val); + magic_methcall1(sv, mg, SV_CONST2(STORE), G_DISCARD, 2, val); return 0; } @@ -2246,7 +2246,7 @@ Perl_magic_clearpack(pTHX_ SV *sv, MAGIC *mg) PERL_ARGS_ASSERT_MAGIC_CLEARPACK; if (mg->mg_type == PERL_MAGIC_tiedscalar) return 0; - return magic_methpack(sv,mg,SV_CONST(DELETE)); + return magic_methpack(sv,mg,SV_CONST2(DELETE)); } @@ -2258,7 +2258,7 @@ Perl_magic_sizepack(pTHX_ SV *sv, MAGIC *mg) PERL_ARGS_ASSERT_MAGIC_SIZEPACK; - retsv = magic_methcall1(sv, mg, SV_CONST(FETCHSIZE), 0, 1, NULL); + retsv = magic_methcall1(sv, mg, SV_CONST2(FETCHSIZE), 0, 1, NULL); if (retsv) { retval = SvIV(retsv)-1; if (retval < -1) @@ -2272,7 +2272,7 @@ Perl_magic_wipepack(pTHX_ SV *sv, MAGIC *mg) { PERL_ARGS_ASSERT_MAGIC_WIPEPACK; - Perl_magic_methcall(aTHX_ sv, mg, SV_CONST(CLEAR), G_DISCARD, 0); + Perl_magic_methcall(aTHX_ sv, mg, SV_CONST2(CLEAR), G_DISCARD, 0); return 0; } @@ -2283,8 +2283,8 @@ Perl_magic_nextpack(pTHX_ SV *sv, MAGIC *mg, SV *key) PERL_ARGS_ASSERT_MAGIC_NEXTPACK; - ret = SvOK(key) ? Perl_magic_methcall(aTHX_ sv, mg, SV_CONST(NEXTKEY), 0, 1, key) - : Perl_magic_methcall(aTHX_ sv, mg, SV_CONST(FIRSTKEY), 0, 0); + ret = SvOK(key) ? Perl_magic_methcall(aTHX_ sv, mg, SV_CONST2(NEXTKEY), 0, 1, key) + : Perl_magic_methcall(aTHX_ sv, mg, SV_CONST2(FIRSTKEY), 0, 0); if (ret) sv_setsv(key,ret); return 0; @@ -2295,7 +2295,7 @@ Perl_magic_existspack(pTHX_ SV *sv, const MAGIC *mg) { PERL_ARGS_ASSERT_MAGIC_EXISTSPACK; - return magic_methpack(sv,mg,SV_CONST(EXISTS)); + return magic_methpack(sv,mg,SV_CONST2(EXISTS)); } SV * @@ -2307,7 +2307,8 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg) PERL_ARGS_ASSERT_MAGIC_SCALARPACK; - if (!gv_fetchmethod_autoload(pkg, "SCALAR", FALSE)) { + /* if (!gv_fetchmethod_autoload(pkg, "SCALAR", FALSE)) { */ + if (!gv_fetchmethod_sv_flags(pkg, SV_CONST2(SCALAR), FALSE ? GV_AUTOLOAD : 0)) { SV *key; if (HvEITER_get(hv)) /* we are in an iteration so the hash cannot be empty */ @@ -2320,7 +2321,7 @@ Perl_magic_scalarpack(pTHX_ HV *hv, MAGIC *mg) } /* there is a SCALAR method that we can call */ - retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(hv), mg, SV_CONST(SCALAR), 0, 0); + retval = Perl_magic_methcall(aTHX_ MUTABLE_SV(hv), mg, SV_CONST2(SCALAR), 0, 0); if (!retval) retval = &PL_sv_undef; return retval; diff --git a/mro_core.c b/mro_core.c index a4dbde3b2d70..43091a319536 100644 --- a/mro_core.c +++ b/mro_core.c @@ -359,7 +359,7 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level) /* They have no stash. So create ourselves an ->isa cache as if we'd copied it from what theirs should be. */ stored = MUTABLE_HV(newSV_type_mortal(SVt_PVHV)); - (void) hv_stores(stored, "UNIVERSAL", &PL_sv_undef); + (void) hv_store_ent(stored, SV_CONST2(UNIVERSAL), &PL_sv_undef, 0); av_push_simple(retval, newSVhek(HeKEY_hek(hv_store_ent(stored, sv, &PL_sv_undef, 0)))); @@ -369,7 +369,7 @@ S_mro_get_linear_isa_dfs(pTHX_ HV *stash, U32 level) } else { /* We have no parents. */ stored = MUTABLE_HV(newSV_type_mortal(SVt_PVHV)); - (void) hv_stores(stored, "UNIVERSAL", &PL_sv_undef); + (void) hv_store_ent(stored, SV_CONST2(UNIVERSAL), &PL_sv_undef, 0); } (void) hv_store_ent(stored, our_name, &PL_sv_undef, 0); @@ -469,7 +469,7 @@ Perl_mro_get_linear_isa(pTHX_ HV *stash) HEK_LEN(canon_name), HEK_FLAGS(canon_name), HV_FETCH_ISSTORE, &PL_sv_undef, HEK_HASH(canon_name)); - (void) hv_stores(isa_hash, "UNIVERSAL", &PL_sv_undef); + (void) hv_store_ent(isa_hash, SV_CONST2(UNIVERSAL), &PL_sv_undef, 0); SvREADONLY_on(isa_hash); @@ -542,8 +542,8 @@ Perl_mro_isa_changed_in(pTHX_ HV* stash) svp = hv_fetchhek(PL_isarev, stashhek, 0); isarev = svp ? MUTABLE_HV(*svp) : NULL; - if((memEQs(stashname, stashname_len, "UNIVERSAL")) - || (isarev && hv_existss(isarev, "UNIVERSAL"))) { + if((memEQhp(stashname, stashname_len, UNIVERSAL, "UNIVERSAL")) + || (isarev && hv_exists_ent(isarev, SV_CONST2(UNIVERSAL), 0))) { PL_sub_generation++; is_universal = TRUE; } @@ -1349,8 +1349,8 @@ Perl_mro_method_changed_in(pTHX_ HV *stash) /* If stash is UNIVERSAL, or one of UNIVERSAL's parents, invalidate all method caches globally */ - if((memEQs(stashname, stashname_len, "UNIVERSAL")) - || (isarev && hv_existss(isarev, "UNIVERSAL"))) { + if((memEQhp(stashname, stashname_len, UNIVERSAL, "UNIVERSAL")) + || (isarev && hv_exists_ent(isarev, SV_CONST2(UNIVERSAL), 0))) { PL_sub_generation++; return; } diff --git a/op.c b/op.c index a26d1b84d079..3443d6d6989b 100644 --- a/op.c +++ b/op.c @@ -8151,7 +8151,7 @@ Perl_package_version( pTHX_ OP *v ) U32 savehints = PL_hints; PERL_ARGS_ASSERT_PACKAGE_VERSION; PL_hints &= ~HINT_STRICT_VARS; - sv_setsv( GvSV(gv_fetchpvs("VERSION", GV_ADDMULTI, SVt_PV)), cSVOPx(v)->op_sv ); + sv_setsv( GvSV(gv_fetchsv_nomg(SV_CONST2(VERSION), GV_ADDMULTI, SVt_PV)), cSVOPx(v)->op_sv ); PL_hints = savehints; op_free(v); } @@ -8257,7 +8257,10 @@ Perl_utilize(pTHX_ int aver, I32 floor, OP *version, OP *idop, OP *arg) /* Fake up the BEGIN {}, which does its thing immediately. */ newATTRSUB(floor, - newSVOP(OP_CONST, 0, newSVpvs_share("BEGIN")), + newSVOP(OP_CONST, 0, + /* newSVpvs_share("BEGIN") */ + SvREFCNT_inc_NN(SV_CONST2(BEGIN)) + ), NULL, NULL, op_append_elem(OP_LINESEQ, @@ -11077,7 +11080,8 @@ 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_fetchpvs("__ANON__", gv_fetch_flags, SVt_PVCV); */ + gv = gv_fetchsv_nomg(SV_CONST2(__ANON__), gv_fetch_flags, SVt_PVCV); has_name = FALSE; } else { gv = gv_fetchpvs("__ANON__::__ANON__", gv_fetch_flags, SVt_PVCV); @@ -12114,7 +12118,7 @@ Perl_newFORM(pTHX_ I32 floor, OP *o, OP *block) gv = o ? gv_fetchsv(cSVOPo->op_sv, GV_ADD, SVt_PVFM) - : gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVFM); + : gv_fetchsv_nomg(SV_CONST2(STDOUT), GV_ADD|GV_NOTQUAL, SVt_PVFM); GvMULTI_on(gv); if ((cv = GvFORM(gv))) { @@ -13366,8 +13370,10 @@ Perl_ck_fun(pTHX_ OP *o) } } if (!name) { - name = "__ANONIO__"; - len = 10; + /* name = "__ANONIO__"; */ + SV_CONST2(__ANONIO__); + name = PV_POOL(__ANONIO__,"__ANONIO__"); + len = STRLENs("__ANONIO__"); want_dollar = FALSE; } op_lvalue(kid, type); diff --git a/pad.c b/pad.c index 765c702456d7..ec68fdcb60a4 100644 --- a/pad.c +++ b/pad.c @@ -2328,8 +2328,10 @@ Perl_cv_name(pTHX_ CV *cv, SV *sv, U32 flags) else { if (CvSTASH(cv) && HvNAME_HEK(CvSTASH(cv))) sv_sethek(retsv, HvNAME_HEK(CvSTASH(cv))); - else - sv_setpvs(retsv, "__ANON__"); + else { + SV_CONST2(__ANON__); + sv_sethek(retsv, HEK_POOL(__ANON__, "__ANON__")); + } sv_catpvs(retsv, "::"); sv_cathek(retsv, CvNAME_HEK(cv)); } diff --git a/perl.c b/perl.c index fdf5e9082264..c04dca1e9625 100644 --- a/perl.c +++ b/perl.c @@ -231,6 +231,7 @@ perl_construct(pTHXx) PERL_ARGS_ASSERT_PERL_CONSTRUCT; + #ifdef MULTIPLICITY init_interp(); PL_perl_destruct_level = 1; @@ -384,6 +385,16 @@ perl_construct(pTHXx) PERL_HASH_WITH_STATE(PL_hash_state,PL_hash_chars[256],str,0); } #endif + /* ASLR and CC linker alignment unknown until runtime */ + Size_t hpstart = ((size_t)(&PL_hekpool)); + Size_t hpend = ((size_t)(&PL_hekpool))+sizeof(HEKP_T); + //0xE78 amd64 ATM + Size_t mask = Size_t_MAX; + while((hpstart & mask) != (hpend & mask) ) { + mask = mask << 1; + } + PL_hpool_mask = mask; + PL_hpool_vm_seg = (hpstart & mask); /* at this point we have initialized the hash function, and we can start * constructing hashes */ PL_hash_seed_set= TRUE; @@ -400,8 +411,17 @@ perl_construct(pTHXx) /* SHAREKEYS tells us that the hash has its keys shared with PL_strtab, * which is not the case with PL_strtab itself */ HvSHAREKEYS_off(PL_strtab); /* mandatory */ - hv_ksplit(PL_strtab, 1 << 11); - } + //hv_ksplit(PL_strtab, 1 << 11); BUGS in ksplit/free unknown sh hek,oversize stops it + hv_ksplit(PL_strtab, 1 <<14); + /* pick up GShHeHeks vivified from a thd build deallocated previous + my_perl instance, or no-thds build + embedder did, serially, + 1 by 1, a perl_destruct() -> perl_construct() cycle */ + } + //gv_init_hekpool_autoload(); + //sv_vivisome_hekpool(); + sv_viviall_hekpool(); + PL_lastcopfile.copfile_unsafe = NULL; /* not needed semantically */ + PL_lastcopfile.cached_file = NULL; #ifdef USE_ITHREADS PL_compiling.cop_file = NULL; @@ -1354,6 +1374,15 @@ perl_destruct(pTHXx) SvREFCNT_dec(PL_sv_consts[i]); PL_sv_consts[i] = NULL; } + { + HEK* cached_file = PL_lastcopfile.cached_file; + PL_lastcopfile.copfile_unsafe = NULL; /* not needed semantically */ + if(cached_file) { + PL_lastcopfile.cached_file = NULL; + unshare_hek(cached_file); + } + } + /* Destruct the global string table. */ { @@ -1374,7 +1403,48 @@ perl_destruct(pTHXx) Perl_warner(aTHX_ packWARN(WARN_INTERNAL), "Unbalanced string table refcount: (%ld) for \"%s\"", (long)hent->he_valu.hent_refcount, HeKEY(hent)); - Safefree(hent); + if(IS_HEKPOOL(hent)) { /* is libperl C global, not from Newx() */ + struct shared_he * const newhe = (struct shared_he*)hent; + Size_t * rcp = &newhe->shared_he_he.he_valu.hent_refcount; + Size_t rc = *rcp; + //__debugbreak(); + if(rc > 1 && rc <= SSize_t_MAX) { + // __debugbreak(); + /* sv_vivihek() added a RC +1 owned by my_perl->PL_strtab */ + *rcp--; + } + else if(rc > SSize_t_MAX) { + // __debugbreak(); + /* ithreads + not using atomic CAS == race + stupidity + RC #1 is owned by the OS Kernel. HE/HEK is IMMORTAL. + This race should be impossible in real life. It can + only happen by intentionally using C breakpoints, + disassembly view single steping, and thread freeze + feature. Regardless, this "reset to 1" code will stay + here, since ~dozen bug tickets+fix patches have been done + through history for Win32, especially for Server 2003, + which likes to do, + + ithread #1 HW page fault->#1 frozen->disk read queued + ->#2 is ready to run and attached to CPU + ->#2 HW page fault same 4KB page->#2 frozen-> + disk answers-> kernel resumes ithread #2 + ->#2 runs ALOT of code->10s or 100-500 ms later + ithread #1 finally wakes up + + What is the RC now? Atomic CAS wasn't used. Does #1's + CPU reg context snapshot happen to have a stale copy + of RC? Who knows. A range test can't be fooled. */ + *rcp = 1; + } + else { + // __debugbreak(); + NOOP; + } + } + else { + Safefree(hent); + } hent = next; } if (!hent) { @@ -4148,7 +4218,7 @@ S_init_main_stash(pTHX) hv_name_sets(PL_defstash, "main", 0); GvHV(gv) = HvREFCNT_inc_simple(PL_defstash); SvREADONLY_on(gv); - PL_incgv = gv_HVadd(gv_AVadd(gv_fetchpvs("INC", GV_ADD|GV_NOTQUAL, + PL_incgv = gv_HVadd(gv_AVadd(gv_fetchsv_nomg(SV_CONST2(INC), GV_ADD|GV_NOTQUAL, SVt_PVAV))); SvREFCNT_inc_simple_void(PL_incgv); /* Don't allow it to be freed */ GvMULTI_on(PL_incgv); @@ -4663,7 +4733,7 @@ S_init_predump_symbols(pTHX) STR_WITH_LEN("Exporter::"), NULL); - PL_stdingv = gv_fetchpvs("STDIN", GV_ADD|GV_NOTQUAL, SVt_PVIO); + PL_stdingv = gv_fetchsv_nomg(SV_CONST2(STDIN), GV_ADD|GV_NOTQUAL, SVt_PVIO); GvMULTI_on(PL_stdingv); io = GvIOp(PL_stdingv); IoTYPE(io) = IoTYPE_RDONLY; @@ -4672,7 +4742,7 @@ S_init_predump_symbols(pTHX) GvMULTI_on(tmpgv); GvIOp(tmpgv) = MUTABLE_IO(SvREFCNT_inc_simple(io)); - tmpgv = gv_fetchpvs("STDOUT", GV_ADD|GV_NOTQUAL, SVt_PVIO); + tmpgv = gv_fetchsv_nomg(SV_CONST2(STDOUT), GV_ADD|GV_NOTQUAL, SVt_PVIO); GvMULTI_on(tmpgv); io = GvIOp(tmpgv); IoTYPE(io) = IoTYPE_WRONLY; @@ -4682,7 +4752,7 @@ S_init_predump_symbols(pTHX) GvMULTI_on(tmpgv); GvIOp(tmpgv) = MUTABLE_IO(SvREFCNT_inc_simple(io)); - PL_stderrgv = gv_fetchpvs("STDERR", GV_ADD|GV_NOTQUAL, SVt_PVIO); + PL_stderrgv = gv_fetchsv_nomg(SV_CONST2(STDERR), GV_ADD|GV_NOTQUAL, SVt_PVIO); GvMULTI_on(PL_stderrgv); io = GvIOp(PL_stderrgv); IoTYPE(io) = IoTYPE_WRONLY; @@ -4718,7 +4788,7 @@ Perl_init_argv_symbols(pTHX_ int argc, char **argv) sv_setiv(GvSV(gv_fetchpv(argv[0]+1, GV_ADD, SVt_PV)),1); } } - if ((PL_argvgv = gv_fetchpvs("ARGV", GV_ADD|GV_NOTQUAL, SVt_PVAV))) { + if ((PL_argvgv = gv_fetchsv_nomg(SV_CONST2(ARGV), GV_ADD|GV_NOTQUAL, SVt_PVAV))) { SvREFCNT_inc_simple_void_NN(PL_argvgv); GvMULTI_on(PL_argvgv); av_clear(GvAVn(PL_argvgv)); @@ -4760,7 +4830,7 @@ S_init_postdump_symbols(pTHX_ int argc, char **argv, char **env) if ((tmpgv = gv_fetchpvs("0", GV_ADD|GV_NOTQUAL, SVt_PV))) { sv_setpv(GvSV(tmpgv),PL_origfilename); } - if ((PL_envgv = gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV))) { + if ((PL_envgv = gv_fetchsv_nomg(SV_CONST2(ENV), GV_ADD|GV_NOTQUAL, SVt_PVHV))) { HV *hv; bool env_is_not_environ; SvREFCNT_inc_simple_void_NN(PL_envgv); diff --git a/perl.h b/perl.h index fd12a5e62d35..1170eb00ef74 100644 --- a/perl.h +++ b/perl.h @@ -6213,6 +6213,7 @@ END_EXTERN_C START_EXTERN_C # include "perlvars.h" +# include "hekpool.h" END_EXTERN_C diff --git a/perlvars.h b/perlvars.h index 8d71b11760cd..35eb0099b524 100644 --- a/perlvars.h +++ b/perlvars.h @@ -375,6 +375,8 @@ PERLVARA(G, hash_state_w, PERL_HASH_STATE_WORDS, PVT__PERL_HASH_WORD_TYPE) /* pe #define PERL_SINGLE_CHAR_HASH_CACHE_ELEMS ((1+256) * sizeof(U32)) PERLVARA(G, hash_chars, PERL_SINGLE_CHAR_HASH_CACHE_ELEMS, unsigned char) /* perl.c and hv.h */ #endif +PERLVARI(G, hpool_mask, size_t, 0) +PERLVARI(G, hpool_vm_seg, size_t, 0) /* The path separator can vary depending on whether we're running under DCL or * a Unix shell. diff --git a/pp.c b/pp.c index 121f9fdfee40..9c8b90c7fda5 100644 --- a/pp.c +++ b/pp.c @@ -109,7 +109,8 @@ S_rv2gv(pTHX_ SV *sv, const bool vivify_sv, const bool strict, sv = SvRV(sv); if (SvTYPE(sv) == SVt_PVIO) { GV * const gv = MUTABLE_GV(sv_newmortal()); - gv_init(gv, 0, "__ANONIO__", 10, 0); + /* gv_init(gv, 0, "__ANONIO__", 10, 0); */ + gv_init_sv(gv, 0, SV_CONST2(__ANONIO__), GV_ADDMULTI*cBOOL(0)); GvIOp(gv) = MUTABLE_IO(sv); SvREFCNT_inc_void_NN(sv); sv = MUTABLE_SV(gv); @@ -137,7 +138,7 @@ S_rv2gv(pTHX_ SV *sv, const bool vivify_sv, const bool strict, gv_init_sv(gv, stash, namesv, 0); } else { - gv_init_pv(gv, stash, "__ANONIO__", 0); + gv_init_sv(gv, stash, SV_CONST2(__ANONIO__), 0); } sv_setrv_noinc_mg(sv, MUTABLE_SV(gv)); goto wasref; @@ -681,12 +682,16 @@ 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_CONST2(__ANON__); + hek = HEK_POOL(__ANON__,"__ANON__"); + }; + sv = newSVhek(hek); } break; case 'S': - if (memEQs(elem, len, "SCALAR")) + if (memEQhp(elem, len, SCALAR, "SCALAR")) tmpRef = GvSVn(gv); break; } @@ -6181,7 +6186,7 @@ PP_wrapped(pp_splice, 0, 1) const MAGIC * const mg = SvTIED_mg((const SV *)ary, PERL_MAGIC_tied); if (mg) { - return Perl_tied_method(aTHX_ SV_CONST(SPLICE), mark - 1, MUTABLE_SV(ary), mg, + return Perl_tied_method(aTHX_ SV_CONST2(SPLICE), mark - 1, MUTABLE_SV(ary), mg, GIMME_V | TIED_METHOD_ARGUMENTS_ON_STACK, sp - mark); } @@ -6399,7 +6404,7 @@ PP(pp_push) #endif *MARK-- = obj; PUSHMARK(MARK); - call_sv(SV_CONST(PUSH),G_SCALAR|G_DISCARD|G_METHOD_NAMED); + call_sv(SV_CONST2(PUSH),G_SCALAR|G_DISCARD|G_METHOD_NAMED); LEAVE_with_name("call_PUSH"); } else { @@ -6466,7 +6471,7 @@ PP(pp_unshift) #endif *MARK-- = obj; PUSHMARK(MARK); - call_sv(SV_CONST(UNSHIFT),G_SCALAR|G_DISCARD|G_METHOD_NAMED); + call_sv(SV_CONST2(UNSHIFT),G_SCALAR|G_DISCARD|G_METHOD_NAMED); LEAVE_with_name("call_UNSHIFT"); } else { @@ -7081,7 +7086,7 @@ PP_wrapped(pp_split, av_clear(ary); ENTER_with_name("call_PUSH"); - call_sv(SV_CONST(PUSH),G_SCALAR|G_DISCARD|G_METHOD_NAMED); + call_sv(SV_CONST2(PUSH),G_SCALAR|G_DISCARD|G_METHOD_NAMED); LEAVE_with_name("call_PUSH"); SPAGAIN; diff --git a/pp_ctl.c b/pp_ctl.c index e1cef3f5e63a..2f58a4c9875a 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -4809,7 +4809,7 @@ S_require_file(pTHX_ SV *sv) SvSetSV_nosteal(nsv,sv); } - const char *method = NULL; + SV* methodsv = NULL; bool is_incdir = FALSE; SV * inc_idx_sv = save_scalar(PL_incgv); sv_setiv(inc_idx_sv,inc_idx); @@ -4818,14 +4818,16 @@ S_require_file(pTHX_ SV *sv) * call the method. */ HV *pkg = SvSTASH(SvRV(loader)); - GV * gv = gv_fetchmethod_pvn_flags(pkg, "INC", 3, GV_AUTOLOAD); + SV* trymeth = SV_CONST2(INC); + GV * gv = gv_fetchmethod_sv_flags(pkg, trymeth, GV_AUTOLOAD); if (gv && isGV(gv)) { - method = "INC"; + methodsv = trymeth; } else { + trymeth = SV_CONST2(INCDIR); /* no point to autoload here, it would have been found above */ - gv = gv_fetchmethod_pvn_flags(pkg, "INCDIR", 6, 0); + gv = gv_fetchmethod_sv_flags(pkg, trymeth, 0); if (gv && isGV(gv)) { - method = "INCDIR"; + methodsv = trymeth; is_incdir = TRUE; } } @@ -4841,7 +4843,7 @@ S_require_file(pTHX_ SV *sv) * Maybe in the future we can detect if it does * have overloading and throw an error if not. */ - if (!method) { + if (!methodsv) { if (SvTYPE(SvRV(loader)) != SVt_PVCV) { if (amagic_applies(loader,string_amg,AMGf_unary)) goto treat_as_string; @@ -4868,17 +4870,18 @@ S_require_file(pTHX_ SV *sv) SAVETMPS; PUSHMARK(PL_stack_sp); /* add the args array for method calls */ - bool add_dirsv = (method && (loader != dirsv)); + bool add_dirsv = (methodsv && (loader != dirsv)); rpp_extend(2 + add_dirsv); rpp_push_2( /* always use the object for method calls */ - method ? loader : dirsv, + methodsv ? loader : dirsv, nsv ); if (add_dirsv) rpp_push_1(dirsv); - if (method) { - count = call_method(method, G_LIST|G_EVAL); + if (methodsv) { + /*count = call_method(method, G_LIST|G_EVAL); */ + count = call_sv(methodsv, G_LIST | G_EVAL | G_METHOD); } else { count = call_sv(loader, G_LIST|G_EVAL); } @@ -4998,9 +5001,9 @@ S_require_file(pTHX_ SV *sv) * compat I think. */ if (l>=12 && pv[l-1] == '\n' && pv[l-2] == '.' && isDIGIT(pv[l-3])) - sv_catpvf(errsv, "%s %s hook died--halting @INC search", - method ? method : "INC", - method ? "method" : "sub"); + sv_catpvf(errsv, "%" SVf " %s hook died--halting @INC search", + methodsv ? methodsv : SV_CONST2(INC), + methodsv ? "method" : "sub"); croak_sv(errsv); } } diff --git a/pp_hot.c b/pp_hot.c index 935ccbc73a19..fc30135cada0 100644 --- a/pp_hot.c +++ b/pp_hot.c @@ -2107,7 +2107,7 @@ PP(pp_print) *MARK = NULL; ++PL_stack_sp; } - return Perl_tied_method(aTHX_ SV_CONST(PRINT), mark - 1, MUTABLE_SV(io), + return Perl_tied_method(aTHX_ SV_CONST2(PRINT), mark - 1, MUTABLE_SV(io), mg, (G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK | (PL_op->op_type == OP_SAY @@ -4072,7 +4072,7 @@ Perl_do_readline(pTHX) /* tied_method() frees everything currently above the passed * mark, and returns any values at mark[1] onwards */ - Perl_tied_method(aTHX_ SV_CONST(READLINE), + Perl_tied_method(aTHX_ SV_CONST2(READLINE), /* mark => */ PL_stack_sp, MUTABLE_SV(io), mg, gimme, 0); diff --git a/pp_sys.c b/pp_sys.c index addfa327d87c..1d9f6cc08d5c 100644 --- a/pp_sys.c +++ b/pp_sys.c @@ -834,7 +834,7 @@ PP_wrapped(pp_open, 0, 1) if (mg) { /* Method's args are same as ours ... */ /* ... except handle is replaced by the object */ - return Perl_tied_method(aTHX_ SV_CONST(OPEN), mark - 1, MUTABLE_SV(io), mg, + return Perl_tied_method(aTHX_ SV_CONST2(OPEN), mark - 1, MUTABLE_SV(io), mg, G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK, sp - mark); } @@ -875,7 +875,7 @@ PP_wrapped(pp_close, MAXARG, 0) if (io) { const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); if (mg) { - return tied_method0(SV_CONST(CLOSE), SP, MUTABLE_SV(io), mg); + return tied_method0(SV_CONST2(CLOSE), SP, MUTABLE_SV(io), mg); } } } @@ -948,7 +948,7 @@ PP_wrapped(pp_fileno, MAXARG, 0) if (io && (mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar))) { - return tied_method0(SV_CONST(FILENO), SP, MUTABLE_SV(io), mg); + return tied_method0(SV_CONST2(FILENO), SP, MUTABLE_SV(io), mg); } if (io && IoDIRP(io)) { @@ -1034,7 +1034,7 @@ PP_wrapped(pp_binmode, MAXARG, 0) function, which I don't think that the optimiser will be able to figure out. Although, as it's a static function, in theory it could. */ - return Perl_tied_method(aTHX_ SV_CONST(BINMODE), SP, MUTABLE_SV(io), mg, + return Perl_tied_method(aTHX_ SV_CONST2(BINMODE), SP, MUTABLE_SV(io), mg, G_SCALAR|TIED_METHOD_MORTALIZE_NOT_NEEDED, discp ? 1 : 0, discp); } @@ -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 *methnamesv; int how = PERL_MAGIC_tied; SSize_t items; SV *varsv = *++MARK; @@ -1087,7 +1087,7 @@ PP_wrapped(pp_tie, 0, 1) case SVt_PVHV: { HE *entry; - methname = "TIEHASH"; + methnamesv = SV_CONST2(TIEHASH); if (HvLAZYDEL(varsv) && (entry = HvEITER_get((HV *)varsv))) { HvLAZYDEL_off(varsv); hv_free_ent(NULL, entry); @@ -1097,7 +1097,7 @@ PP_wrapped(pp_tie, 0, 1) break; } case SVt_PVAV: - methname = "TIEARRAY"; + methnamesv = SV_CONST2(TIEARRAY); if (!AvREAL(varsv)) { if (!AvREIFY(varsv)) Perl_croak(aTHX_ "Cannot tie unreifiable array"); @@ -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"; + methnamesv = SV_CONST2(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 */ @@ -1124,7 +1124,7 @@ PP_wrapped(pp_tie, 0, 1) } /* FALLTHROUGH */ default: - methname = "TIESCALAR"; + methnamesv = SV_CONST2(TIESCALAR); how = PERL_MAGIC_tiedscalar; break; } @@ -1137,7 +1137,8 @@ PP_wrapped(pp_tie, 0, 1) while (items--) PUSHs(*MARK++); PUTBACK; - call_method(methname, G_SCALAR); + /* call_method(methname, G_SCALAR); */ + call_sv(methnamesv, G_SCALAR | G_METHOD); } else { /* Can't use call_method here, else this: fileno FOO; tie @a, "FOO" @@ -1148,37 +1149,38 @@ 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)); + methnamesv, 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)); + methnamesv, 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)); + methnamesv, SVfARG(stashname), SVfARG(stashname)); } } - else if (!(gv = gv_fetchmethod(stash, methname))) { + /* else if (!(gv = gv_fetchmethod(stash, methname))) { */ + else if (!(gv = gv_fetchmethod_sv_flags(stash, methnamesv, TRUE ? GV_AUTOLOAD : 0))) { /* 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)); + methnamesv, HvENAME_HEK_NN(stash)); } ENTER_with_name("call_TIE"); PUSHSTACKi(PERLSI_MAGIC); @@ -1229,7 +1231,8 @@ 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_autoload(SvSTASH(obj), "UNTIE", FALSE); */ + GV * const gv = gv_fetchmethod_sv_flags(SvSTASH(obj), SV_CONST2(UNTIE), FALSE ? GV_AUTOLOAD : 0); CV *cv; if (gv && isGV(gv) && (cv = GvCV(gv))) { PUSHMARK(SP); @@ -1600,7 +1603,7 @@ PP_wrapped(pp_getc, MAXARG, 0) const MAGIC * const mg = SvTIED_mg((const SV *)io, PERL_MAGIC_tiedscalar); if (mg) { const U8 gimme = GIMME_V; - Perl_tied_method(aTHX_ SV_CONST(GETC), SP, MUTABLE_SV(io), mg, gimme, 0); + Perl_tied_method(aTHX_ SV_CONST2(GETC), SP, MUTABLE_SV(io), mg, gimme, 0); if (gimme == G_SCALAR) { SPAGAIN; SvSetMagicSV_nosteal(TARG, TOPs); @@ -1854,7 +1857,7 @@ PP(pp_prtf) *MARK = NULL; ++PL_stack_sp; } - return Perl_tied_method(aTHX_ SV_CONST(PRINTF), mark - 1, MUTABLE_SV(io), + return Perl_tied_method(aTHX_ SV_CONST2(PRINTF), mark - 1, MUTABLE_SV(io), mg, G_SCALAR | TIED_METHOD_ARGUMENTS_ON_STACK, PL_stack_sp - mark); diff --git a/proto.h b/proto.h index 1e2a0fdb3ccc..42027e4f0fbb 100644 --- a/proto.h +++ b/proto.h @@ -1553,6 +1553,11 @@ Perl_gv_setref(pTHX_ SV * const dsv, SV * const ssv) #define PERL_ARGS_ASSERT_GV_SETREF \ assert(dsv); assert(ssv) +PERL_CALLCONV HV * +Perl_gv_stashhek(pTHX_ HEK *hek, I32 flags); +#define PERL_ARGS_ASSERT_GV_STASHHEK \ + assert(hek) + PERL_CALLCONV HV * Perl_gv_stashpv(pTHX_ const char *name, I32 flags); #define PERL_ARGS_ASSERT_GV_STASHPV \ @@ -1563,6 +1568,11 @@ Perl_gv_stashpvn(pTHX_ const char *name, U32 namelen, I32 flags); #define PERL_ARGS_ASSERT_GV_STASHPVN \ assert(name) +PERL_CALLCONV HV * +Perl_gv_stashpvs_p(pTHX_ I32 flags, const char *name); +#define PERL_ARGS_ASSERT_GV_STASHPVS_P \ + assert(name) + PERL_CALLCONV HV * Perl_gv_stashsv(pTHX_ SV *sv, I32 flags); #define PERL_ARGS_ASSERT_GV_STASHSV \ @@ -5259,6 +5269,20 @@ Perl_sv_vcatpvfn_flags(pTHX_ SV * const sv, const char * const pat, const STRLEN #define PERL_ARGS_ASSERT_SV_VCATPVFN_FLAGS \ assert(sv); assert(pat) +PERL_CALLCONV void +Perl_sv_viviall_hekpool(pTHX); +#define PERL_ARGS_ASSERT_SV_VIVIALL_HEKPOOL + +PERL_CALLCONV SV * +Perl_sv_vivihek(SV * const sv) + __attribute__warn_unused_result__; +#define PERL_ARGS_ASSERT_SV_VIVIHEK \ + assert(sv) + +PERL_CALLCONV void +Perl_sv_vivisome_hekpool(pTHX); +#define PERL_ARGS_ASSERT_SV_VIVISOME_HEKPOOL + PERL_CALLCONV void Perl_sv_vsetpvf(pTHX_ SV * const sv, const char * const pat, va_list * const args); #define PERL_ARGS_ASSERT_SV_VSETPVF \ @@ -6878,16 +6902,12 @@ S_require_tie_mod(pTHX_ GV *gv, const char varname, const char *name, STRLEN len assert(gv); assert(varname); assert(name) # if !defined(PERL_NO_INLINE_FUNCTIONS) -PERL_STATIC_INLINE GV * -S_gv_fetchmeth_internal(pTHX_ HV *stash, SV *meth, const char *name, STRLEN len, I32 level, U32 flags); -# define PERL_ARGS_ASSERT_GV_FETCHMETH_INTERNAL - PERL_STATIC_INLINE HV * S_gv_stashpvn_internal(pTHX_ const char *name, U32 namelen, I32 flags); # define PERL_ARGS_ASSERT_GV_STASHPVN_INTERNAL \ assert(name) -# endif /* !defined(PERL_NO_INLINE_FUNCTIONS) */ +# endif #endif /* defined(PERL_IN_GV_C) */ #if defined(PERL_IN_GV_C) || defined(PERL_IN_OP_C) || \ defined(PERL_IN_PAD_C) || defined(PERL_IN_SV_C) @@ -6897,13 +6917,24 @@ Perl_sv_add_backref(pTHX_ SV * const tsv, SV * const sv) # define PERL_ARGS_ASSERT_SV_ADD_BACKREF \ assert(tsv); assert(sv) +#endif +#if defined(PERL_IN_GV_C) || defined(PERL_IN_SV_C) +PERL_CALLCONV GV * +Perl_gv_fetchmeth_internal(pTHX_ HV *stash, SV *meth, const char *name, STRLEN len, I32 level, U32 flags); +# define PERL_ARGS_ASSERT_GV_FETCHMETH_INTERNAL + #endif #if defined(PERL_IN_GV_C) || defined(PERL_IN_UNIVERSAL_C) PERL_CALLCONV HV * Perl_gv_stashsvpvn_cached(pTHX_ SV *namesv, const char *name, U32 namelen, I32 flags) __attribute__visibility__("hidden"); -#endif +PERL_CALLCONV HV * +Perl_gv_stashsvpvn_cached_p(pTHX_ I32 flags, void *namevp, ...); +# define PERL_ARGS_ASSERT_GV_STASHSVPVN_CACHED_P \ + assert(namevp) + +#endif /* defined(PERL_IN_GV_C) || defined(PERL_IN_UNIVERSAL_C) */ #if defined(PERL_IN_HV_C) STATIC void S_clear_placeholders(pTHX_ HV *hv, U32 items); diff --git a/regen/hekpool.pl b/regen/hekpool.pl new file mode 100644 index 000000000000..f11a443709dd --- /dev/null +++ b/regen/hekpool.pl @@ -0,0 +1,377 @@ +# Revision: a38ab4751f3c0df44dc09e4d685a2637e93c9778 +# Author: Ruslan Zakirov +# Date: 3/24/2013 9:31:35 PM +# Message: +# SV_CONST(name) and PL_sv_consts + +# SV_CONST(XXX) returns SV* that contains "XXX" string. +# SVs are built on demand and stored in interp's structure +# for re-use. All SVs have precomputed hash value. + +# Creates SVs on demand, we don't want 35 SV created during +# compile time or cloned during thread creation. + +#!/usr/bin/perl -w +# +# +# Regenerate (overwriting only if changed): +# +# scope_types.h +# +# from information contained in this file in the +# __DATA_ section below. +# +# To add a new type simply add its name to the list +# below in the correct section (marked by C comments) +# and then regenerate with 'make regen'. +# +# Accepts the standard regen_lib -q and -v args. +# +# This script is normally invoked from regen.pl. + +# The style of this file is determined by: +# +# perltidy -w -ple -bbb -bbc -bbs -nolq -l=80 -noll -nola -nwls='=' \ +# -isbc -nolc -otr -kis -ci=4 -se -sot -sct -nsbl -pt=2 -fs \ +# -fsb='##!' -fse='##.' + +BEGIN { + # Get function prototypes + require './regen/regen_lib.pl'; +} + +use strict; +use warnings; +use List::Util; + +sub escape_csymbol { + my $v = shift; + $v =~ s/([^A-Z0-9a-wyz_])/${\(sprintf('_%x_',ord($1)))}/eg; + $v = '_'.$v.'_'; + return $v; +} + +my $svht; +my $svhs; +my $hekt; +my $heks; +my @xpvs; +my $astfn; +my $cnt = 0; +my $maybeGShHeHekLenBf; +my $GShHeHekFastMatchArr; +my @pvbylen = (); +my $i = 0; +my $avref2; + +#PERLVAR(prefix,var,type) EXT type PL_##var +$svht = "typedef struct {\n U16 lensv; U8 lenxpv;\n union {\n struct {\n"; +$svhs = " +#ifndef DOINIT +PERLVAR(G, hekpoolsv, SVHEKP_T) +#else +SVHEKP_T PL_hekpoolsv = {\n" + ." C_ARRAY_LENGTH(PL_hekpoolsv.u.a),\n" + ." (U8)((Size_t)(sizeof(XPVS_IMM_T)/sizeof(XPVIMM_T))),\n {{\n"; +$hekt = "typedef struct {\n"; +$heks = " +#ifndef DOINIT +PERLVAR(G, hekpool, HEKP_T) +#else +HEKP_T PL_hekpool = {\n"; +$astfn = "#ifdef WANT_HEKPOOL_ASSERT\nstatic SV*\nS_assert_hekpool(pTHX){\n". + " const char * lbl = NULL;\n if(0)\n NOOP;\n"; + +foreach my $line () { + $line =~ s/\s+\z//; + my $line_len = length($line); + if($line_len) { + $avref2 = $pvbylen[$line_len]; + if(!$avref2) { + $pvbylen[$line_len] = $avref2 = []; + } + push(@{$avref2}, $line); + $cnt++; + } +} + +@pvbylen = map({ + $_ ? [sort(@{$_})] : $_; + } @pvbylen); + +foreach my $line_len_arr (@pvbylen) { + if($line_len_arr) { + foreach my $line (@{$line_len_arr}) { + + my $sym = escape_csymbol($line); + my $line_len = length($line); + $hekt .= " struct {struct he shared_he_he; struct{U32 hek_hash;I32 hek_len;\n char hek_key [sizeof(\"".$line."\")+1];} shared_he_hek;} ".$sym.";\n"; + $heks .= " {{NULL, (HEK*)&PL_hekpool.".$sym.".shared_he_hek, {(SV*)1}},{0,sizeof(\"".$line."\")-1,\"".$line."\"}},\n"; + $svht .= " SV ".$sym.";\n"; + $svhs .= " {(void*)(((Size_t)(&hekpool_xpvs.len".$line_len."))-STRUCT_OFFSET(XPV,xpv_cur)),((~(U32)0)/2),SVf_IsCOW|SVf_READONLY|SVf_POK|SVp_POK|SVt_PV,{(void*)&PL_hekpool.".$sym.".shared_he_hek.hek_key}},\n"; + $xpvs[$line_len] = $line_len; + $astfn .= " else if(memNEs(SvPVX(&PL_hekpoolsv.u.st.".$sym."), SvCUR(&PL_hekpoolsv.u.st.".$sym."),\"".$line."\"))\n lbl = \"".$line."\";\n"; + } + } +} + + + + +$svht .= " } st;\n SV a[".$cnt."];\n } u;\n} SVHEKP_T;\n\n"; +$svhs = substr($svhs,0,-2); +$svhs .= "\n}}\n}\n;\n#endif\n\n"; +$hekt .= "} HEKP_T;\n\n"; +$heks = substr($heks,0,-2); +$heks .= "\n}\n;\n#endif\n\n"; + my @xpvlens; + my($l, $xpvts,$xpvs,$usenl, $minl, $maxl) = (scalar(@xpvs),'','',-1,0,0); + $i = 0; + for(; $i < $l; $i++) { + push(@xpvlens, $i) if $xpvs[$i]; + } + $maybeGShHeHekLenBf = "\n#define HEKPOOL_LENMASK (" + .join('|',map({'(1<<'.$_.')'} @xpvlens)) + .")\n\n"; + $minl = List::Util::min(@xpvlens); + $maxl = List::Util::max(@xpvlens); + + $GShHeHekFastMatchArr = ' +#if defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C) +typedef struct { + U32 fastmask; + U16 svoffst; /* offset in bytes, not idx, to region of same len SV heads */ + U16 svoffend; /* +1 after last SV head, use < */ +} HPOOL_FASTM_T; + +typedef struct { + U8 lenlow; + U8 lenhi; + HPOOL_FASTM_T leninfo ['.(($maxl-$minl)+1).']; +} HPOOL_FASTMS_T; +#define HPOOLPV_MIN '.$minl.' +#define HPOOLPV_MAX '.$maxl.' +'.$maybeGShHeHekLenBf.' +#if defined(PERL_IS_MINIPERL) +# define IS_MAYBE_HPOOL(_s, _l) if(0){0;} +#else +# define IS_MAYBE_HPOOL(_s, _l) XXXDISABLED; if((_l) < 32 && ((1<<(_l))&HEKPOOL_LENMASK) \\ + && PL_hpfastm.leninfo[(_l)-HPOOLPV_MIN].fastmask \\ + && (*((U32*)_s)&~PL_hpfastm.leninfo[(_l)-HPOOLPV_MIN].fastmask == 0) {\\ + __debugbreak();\\ + } +#endif + + + +static const HPOOL_FASTMS_T PL_hpfastm = { '.$minl.', '.$maxl.', { +'; +my @fastm; +my $mask; +$i = $minl; +my $chr; +#my $strs_per_len; +my $firstSVh; +my $lastSVh; +my $avrv; +for(; $i <= $maxl; $i++) { + $avrv = $pvbylen[$i]; + if($avrv) { + #$strs_per_len = scalar(@{$avrv}); + $firstSVh = escape_csymbol($$avrv[0]); + $lastSVh = escape_csymbol($$avrv[-1]); + $mask = " {(". + join("\n |", + map({ + my $chr1=substr($_,0,1).""; + my $chr2=substr($_,1,1).""; + my $chr3=substr($_,2,1).""; + my $chr4=substr($_,3,1).""; + "vtohl(('".($chr1 eq ''?'\0':$chr1)."'|('" + .($chr2 eq ''?'\0':$chr2)."'<<8)|('" + .($chr3 eq ''?'\0':$chr3)."'<<16)|('".($chr4 eq ''?'\0':$chr4)."'<<24)))" + } @{$avrv} ) + )."),\n STRUCT_OFFSET(SVHEKP_T,u.st.".$firstSVh.")-STRUCT_OFFSET(SVHEKP_T,u.st),\n (STRUCT_OFFSET(SVHEKP_T,u.st.".$lastSVh.")-STRUCT_OFFSET(SVHEKP_T,u.st))+sizeof(SV)}"; + } + else { + $mask = ' {0,0,0}'; + } + push(@fastm, $mask); +} + +$GShHeHekFastMatchArr .= join(",\n",@fastm)."\n }\n};\n#endif\n\n"; + + $xpvts .= " +typedef struct { + STRLEN cur; + STRLEN len; +} XPVIMM_T; + +typedef struct {\n" + .join('',map({' '.sprintf('%-12s','XPVIMM_T len'.$_.';').(($usenl=(($usenl+1)&0x3))==3?"\n":'');} @xpvlens)) + ."\n} XPVS_IMM_T;\n\n"; + $xpvs .= "#ifdef DOINIT\nstatic const XPVS_IMM_T hekpool_xpvs = {\n " + .join(',' , map({'{'.$_.',0}'} @xpvlens)) + ."\n};\n#endif\n\n"; +$astfn .= " if(lbl)\n return newSVpvn_flags(lbl,strlen(lbl),SVs_TEMP);\n" + ." else\n return &PL_sv_undef;\n}\n#endif\n\n" +." +#define SV_CONST2(_tok) (!PL_hekpool._##_tok##_.shared_he_hek.hek_hash \\ + ? sv_vivihek(&PL_hekpoolsv.u.st._##_tok##_) \\ + : &PL_hekpoolsv.u.st._##_tok##_) +#define PV_POOL(_tok,_tokpv) ((const char*)PL_hekpool._##_tok##_.shared_he_hek.hek_key) +/* XXX TODO macro needs rework, this can't CC fold */ +#define PVN_POOL(_tok,_tokpv) (PL_hekpool._##_tok##_.shared_he_hek.hek_len) +#define HEK_POOL(_tok,_tokpv) (&PL_hekpool._##_tok##_.shared_he_hek) +/* is equal, len must be abs match, then memcmp() done. We are comparing + against the string in the HEK, and NOT a generic C \"\" lit created by + CC/link, for cache reasons, smaller libperl file size, and very often + in Perl VM, L and R ptrs will be the same, as the gShHEHEK circulates + and spreads around the interp, and the gShHEHEK's char* often degrades in + in patterns like HEK->SV->PVN->its Jan 1 1970 strlen() time. + Throughout layers of call frames in interp C/XS and CPAN C/XS, but even + after loosing its HEK and SV containers, and maybe getting redundantly + strlen()ed in some parent call frame, the gShHEHEK's char* reappears + as L side input to memEQhp(). So don't memcmp() against a same contents + generic C \"\" lit. */ +#define memEQhp(_s,_l,_tok,_qqpv) ((_l) == sizeof(_qqpv)-1 && memEQ((_s), \\ + (char*)PL_hekpool._##_tok##_.shared_he_hek.hek_key, sizeof(_qqpv)-1)) + +#define SV_POOLLEN C_ARRAY_LENGTH(PL_hekpoolsv.u.a) +#define SV_POOLSTART (&PL_hekpoolsv.u.a[0]) +/* 1 beyond last, test with < not <= */ +#define SV_POOLEND (&PL_hekpoolsv.u.a[SV_POOLLEN]) + +/* The GblShHE/HEKs can't be iterated using a loop b/c they are packed var + lengths. Adding to libperl, a const HE* array of GblShHE/HEKs is a waste of + disk space. Indirectly, GblShHE/HEKs can be looped over through the array + of corresponding immortal/pooled SV heads. */ + +/* range test isn't at HEHEK[0]'s 1st str char .hek_key*/ +#define IS_HEKPOOL(_hek) (((Size_t)(_hek))>=((Size_t)(&PL_hekpool)) \\ + && ((Size_t)(_hek))<(((Size_t)(&PL_hekpool))+sizeof(PL_hekpool)) \\ + ?TRUE:FALSE) +#define IS_SVPOOL(_sv) (((Size_t)(_sv))>=((Size_t)(&PL_hekpoolsv.u.st)) \\ + && ((Size_t)(_sv))<(((Size_t)(&PL_hekpoolsv.u.st))+sizeof(PL_hekpoolsv.u.st)) \\ + ?TRUE:FALSE) + +"; +my $out= open_new( + 'hekpool.h', + '>', { + by => 'regen/hekpool.pl', + copyright => [2022], + final => 'QQQQFINALQQQQ', + }); +print $out $svht, $hekt, $xpvts, $GShHeHekFastMatchArr, $heks, $xpvs, $svhs,$astfn; +read_only_bottom_close_and_rename($out); + +#TODO more candidates, but not adding them for now because they have lc chars +# all of PL_AMG_names[] array +# all C strings inside Perl_sv_reftype +# the whole API family of Perl_sv_reftype() Perl_sv_ref() Perl_pp_reftype() +# need to learn about "pvn" objects and "hek" objects +# and perhaps COWed/immortal SV* POK objects +# main can isa charnames _charnames import unimport attributes +# version alpha __WARN__ i saw it, all the sig names or some of them ??? +# SKIPPING str "IO" too short + +__DATA__ +TIESCALAR +TIEARRAY +TIEHASH +TIEHANDLE +FETCH +FETCHSIZE +STORE +STORESIZE +EXISTS +PUSH +POP +SHIFT +UNSHIFT +SPLICE +EXTEND +FIRSTKEY +NEXTKEY +SCALAR +OPEN +WRITE +PRINT +PRINTF +READ +READLINE +GETC +SEEK +TELL +EOF +BINMODE +FILENO +CLOSE +DELETE +CLEAR +UNTIE +VERSION +XS_VERSION +EXPORT +EXPORT_OK +EXPORT_TAGS +UNIVERSAL +__ANON__ +__ANONIO__ +DOES +ISA +INC +ENV +SIG +PATH +TERM +HOME +ERROR +SAFE +FLAGS +MASK +STDERR +STDOUT +STDIN +ARGV +ARGVOUT +FILE +NAME +DATA +INCDIR +DEBUG +NULL +NULLREF +__FILE__ +__LINE__ +__PACKAGE__ +__CLASS__ +__DATA__ +__END__ +__SUB__ +ADJUST +AUTOLOAD +CLONE +CLONE_SKIP +BEGIN +UNITCHECK +DESTROY +END +INIT +CHECK +CORE +FIELDS +VSTRING +REF +LVALUE +ARRAY +HASH +CODE +GLOB +FORMAT +INVLIST +REGEXP +OBJECT +UNKNOWN +EXPXXXXXXXORT_TAGS diff --git a/scope.c b/scope.c index bef7ea44e32e..3c5851d1743c 100644 --- a/scope.c +++ b/scope.c @@ -1761,7 +1761,7 @@ Perl_cx_dump(pTHX_ PERL_CONTEXT *cx) gimme_text = "VOID"; break; case G_SCALAR: - gimme_text = "SCALAR"; + gimme_text = PV_POOL(SCALAR, "SCALAR"); break; case G_LIST: gimme_text = "LIST"; diff --git a/sv.c b/sv.c index 1b63d417a5f6..08b5b167f126 100644 --- a/sv.c +++ b/sv.c @@ -125,8 +125,8 @@ # define ASSERT_UTF8_CACHE(cache) NOOP #endif -static const char S_destroy[] = "DESTROY"; -#define S_destroy_len (sizeof(S_destroy)-1) +/* static const char S_destroy[] = "DESTROY"; + #define S_destroy_len (sizeof(S_destroy)-1) */ /* ============================================================================ @@ -2979,8 +2979,19 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const U32 flags) SV *const referent = SvRV(sv); if (!referent) { - len = 7; - retval = buffer = savepvn("NULLREF", len); + /* caller promised to behave, HPOOL strings are inter-ithread + process global, but not HW RO/C const protected */ + if (flags & SV_CONST_RETURN) { + /* wake up/vivify just in case of near-future copying */ + SV_CONST2(NULLREF); + if (lp) + *lp = STRLENs("NULLREF"); + retval = PV_POOL(NULLREF, "NULLREF"); + return retval; + } + const char * hekpv = PV_POOL(NULLREF,"NULLREF"); + len = STRLENs("NULLREF"); + retval = buffer = savepvn(hekpv, len); } else if (SvTYPE(referent) == SVt_REGEXP && (!(PL_curcop->cop_hints & HINT_NO_AMAGIC) || amagic_is_enabled(string_amg))) { @@ -3020,8 +3031,8 @@ Perl_sv_2pv_flags(pTHX_ SV *const sv, STRLEN *const lp, const U32 flags) SvUTF8_off(sv); } } else { - stashname = "__ANON__"; - stashnamelen = 8; + stashname = PV_POOL(__ANON__, "__ANON__"); + stashnamelen = STRLENs("__ANON__"); } len = stashnamelen + 1 /* = */ + typelen + 3 /* (0x */ + 2 * sizeof(UV) + 2 /* )\0 */; @@ -3848,7 +3859,8 @@ S_glob_assign_glob(pTHX_ SV *const dsv, SV *const ssv, const int dtype) if(dtype == SVt_PVGV) { const char * const name = GvNAME((const GV *)dsv); const STRLEN len = GvNAMELEN(dsv); - if(memEQs(name, len, "ISA") + /* if(memEQs(name, len, "ISA") */ + if(memEQhp(name, len, ISA, "ISA") /* The stash may have been detached from the symbol table, so check its name. */ && GvSTASH(dsv) && HvHasENAME(GvSTASH(dsv)) @@ -4069,7 +4081,8 @@ Perl_gv_setref(pTHX_ SV *const dsv, SV *const ssv) } else if ( stype == SVt_PVAV && sref != dref - && memEQs(GvNAME((GV*)dsv), GvNAMELEN((GV*)dsv), "ISA") + /* && memEQs(GvNAME((GV*)dsv), GvNAMELEN((GV*)dsv), "ISA") */ + && memEQhp(GvNAME((GV*)dsv), GvNAMELEN((GV*)dsv), ISA, "ISA") /* The stash may have been detached from the symbol table, so check its name before doing anything. */ && GvSTASH(dsv) && HvHasENAME(GvSTASH(dsv)) @@ -6670,6 +6683,7 @@ S_anonymise_cv_maybe(pTHX_ GV *gv, CV* cv) { SV *gvname; GV *anongv; + HV *stash; PERL_ARGS_ASSERT_ANONYMISE_CV_MAYBE; @@ -6688,9 +6702,14 @@ S_anonymise_cv_maybe(pTHX_ GV *gv, CV* cv) } /* if not, anonymise: */ - gvname = (GvSTASH(gv) && HvHasNAME(GvSTASH(gv)) && HvHasENAME(GvSTASH(gv))) - ? newSVhek(HvENAME_HEK(GvSTASH(gv))) - : newSVpvn_flags( "__ANON__", 8, 0 ); + stash = GvSTASH(gv); + if(stash && HvHasNAME(stash) && HvHasENAME(stash)) { + gvname = newSVhek(HvENAME_HEK(stash)); + } + else { + SV_CONST2(__ANON__); + gvname = newSVhek(HEK_POOL(__ANON__, "__ANON__")); + } sv_catpvs(gvname, "::__ANON__"); anongv = gv_fetchsv(gvname, GV_ADDMULTI, SVt_PVCV); SvREFCNT_dec_NN(gvname); @@ -7191,12 +7210,17 @@ S_curse(pTHX_ SV * const sv, const bool check_refcnt) { } else { bool autoload = FALSE; + /* GV *gv = + gv_fetchmeth_pvn(stash, S_destroy, S_destroy_len, -1, 0); */ GV *gv = - gv_fetchmeth_pvn(stash, S_destroy, S_destroy_len, -1, 0); + gv_fetchmeth_sv_nomg_x(stash, SV_CONST2(DESTROY), -1, 0); if (gv) destructor = GvCV(gv); if (!destructor) { - gv = gv_autoload_pvn(stash, S_destroy, S_destroy_len, + /* gv = gv_autoload_pvn(stash, S_destroy, S_destroy_len, + GV_AUTOLOAD_ISMETHOD); */ + /* TODO add NOVI */ + gv = gv_autoload_sv(stash, SV_CONST2(DESTROY), GV_AUTOLOAD_ISMETHOD); if (gv) destructor = GvCV(gv); @@ -10600,18 +10624,18 @@ Perl_sv_reftype(pTHX_ const SV *const sv, const int ob) if (SvROK(sv)) return "REF"; else - return "SCALAR"; + return PV_POOL(SCALAR, "SCALAR"); case SVt_PVLV: return (char *) (SvROK(sv) ? "REF" /* tied lvalues should appear to be * scalars for backwards compatibility */ : (isALPHA_FOLD_EQ(LvTYPE(sv), 't')) - ? "SCALAR" : "LVALUE"); + ? PV_POOL(SCALAR, "SCALAR") : "LVALUE"); case SVt_PVAV: return "ARRAY"; case SVt_PVHV: return "HASH"; case SVt_PVCV: return "CODE"; case SVt_PVGV: return (char *) (isGV_with_GP(sv) - ? "GLOB" : "SCALAR"); + ? "GLOB" : PV_POOL(SCALAR, "SCALAR")); case SVt_PVFM: return "FORMAT"; case SVt_PVIO: return "IO"; case SVt_INVLIST: return "INVLIST"; @@ -10647,8 +10671,11 @@ Perl_sv_ref(pTHX_ SV *dst, const SV *const sv, const int ob) if (ob && SvOBJECT(sv)) { if (HvHasNAME(SvSTASH(sv))) sv_sethek(dst, HvNAME_HEK(SvSTASH(sv))); - else - sv_setpvs(dst, "__ANON__"); + else { + /* sv_setpvs(dst, "__ANON__"); */ + SV_CONST2(__ANON__); + sv_sethek(dst, HEK_POOL(__ANON__, "__ANON__")); + } } else { const char * reftype = sv_reftype(sv, 0); @@ -15607,7 +15634,9 @@ do_mark_cloneable_stash(pTHX_ SV *const sv) { const HEK * const hvname = HvNAME_HEK((const HV *)sv); if (hvname) { - GV* const cloner = gv_fetchmethod_autoload(MUTABLE_HV(sv), "CLONE_SKIP", 0); + /* GV* const cloner = gv_fetchmethod_autoload(MUTABLE_HV(sv), "CLONE_SKIP", 0); */ + GV* const cloner = gv_fetchmethod_sv_flags(MUTABLE_HV(sv), + SV_CONST2(CLONE_SKIP), 0 ? GV_AUTOLOAD : 0); SvFLAGS(sv) |= SVphv_CLONEABLE; /* clone objects by default */ if (cloner && GvCV(cloner)) { dSP; @@ -16007,12 +16036,50 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, ptr_table_store(PL_ptr_table, &proto_perl->Isv_yes, &PL_sv_yes); ptr_table_store(PL_ptr_table, &proto_perl->Ipadname_const, &PL_padname_const); + if (0) { /* Wake up all HEKP SV heads/HEK objects in parent my_perl */ + SV* sv; + char * str; + struct shared_he * she; + HEK * hek; + + PERL_SET_THX(proto_perl); /* sv_vivihek() needs parent my_perl */ + sv = SV_POOLSTART; + while(sv < SV_POOLEND) { + str = SvPVX(sv); + she = (struct shared_he*) + ((Size_t)(((Size_t)str) + -STRUCT_OFFSET(struct shared_he,shared_he_hek.hek_key[0]))); + hek = &she->shared_he_he; + if(!HEK_HASH(hek)) + sv = sv_vivihek(sv); + sv++; + } + PERL_SET_THX(my_perl); + + /* make the immortal HEKPOOL SVs/HEKs spread through out the mem space + of child ithread. Perhaps the child ithread will do more Perl API + COWing than the parent ithread is currently doing */ + sv = SV_POOLSTART; + while(sv < SV_POOLEND) { + ptr_table_store(PL_ptr_table, sv, sv); + str = SvPVX(sv); + she = (struct shared_he*) + ((Size_t)(((Size_t)str) + -STRUCT_OFFSET(struct shared_he,shared_he_hek.hek_key[0]))); + hek = &she->shared_he_he; + ptr_table_store(PL_ptr_table, hek, hek); + sv++; + } + } /* create (a non-shared!) shared string table */ PL_strtab = newHV(); HvSHAREKEYS_off(PL_strtab); hv_ksplit(PL_strtab, HvTOTALKEYS(proto_perl->Istrtab)); + sv_vivisome_hekpool(); ptr_table_store(PL_ptr_table, proto_perl->Istrtab, PL_strtab); + PL_lastcopfile.copfile_unsafe = NULL; /* not needed semantically */ + PL_lastcopfile.cached_file = NULL; Zero(PL_sv_consts, SV_CONSTS_COUNT, SV*); @@ -16423,7 +16490,8 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, */ while(av_count(param->stashes) != 0) { HV* const stash = MUTABLE_HV(av_shift(param->stashes)); - GV* const cloner = gv_fetchmethod_autoload(stash, "CLONE", 0); + /* GV* const cloner = gv_fetchmethod_autoload(stash, "CLONE", 0); */ + GV* const cloner = gv_fetchmethod_sv_flags(stash, SV_CONST2(CLONE), 0 ? GV_AUTOLOAD : 0); if (cloner && GvCV(cloner)) { ENTER; SAVETMPS; diff --git a/toke.c b/toke.c index 8655b49c1f49..fcede555780b 100644 --- a/toke.c +++ b/toke.c @@ -5110,7 +5110,7 @@ S_find_in_my_stash(pTHX_ const char *pkgname, STRLEN len) PERL_ARGS_ASSERT_FIND_IN_MY_STASH; - if (memEQs(pkgname, len, "__PACKAGE__")) + if (memEQhp(pkgname, len, __PACKAGE__, "__PACKAGE__")) return PL_curstash; if (len > 2 @@ -5630,8 +5630,11 @@ yyl_sub(pTHX_ char *s, const int key) } if (!have_name) { - if (PL_curstash) - sv_setpvs(PL_subname, "__ANON__"); + if (PL_curstash) { + /* sv_setpvs(PL_subname, "__ANON__"); */ + SV_CONST2(__ANON__); + sv_sethek(PL_subname, HEK_POOL(__ANON__, "__ANON__")); + } else sv_setpvs(PL_subname, "__ANON__::__ANON__"); if (is_method) @@ -6281,8 +6284,11 @@ yyl_subproto(pTHX_ char *s, CV *cv) } if (*proto == '&' && *s == '{') { - if (PL_curstash) - sv_setpvs(PL_subname, "__ANON__"); + if (PL_curstash) { + /* sv_setpvs(PL_subname, "__ANON__"); */ + SV_CONST2(__ANON__); + sv_sethek(PL_subname, HEK_POOL(__ANON__, "__ANON__")); + } else sv_setpvs(PL_subname, "__ANON__::__ANON__"); if (!PL_lex_allbrackets @@ -8031,7 +8037,7 @@ yyl_word_or_keyword(pTHX_ char *s, STRLEN len, I32 key, I32 orig_keyword, struct case KEY_chdir: /* may use HOME */ - (void)gv_fetchpvs("ENV", GV_ADD|GV_NOTQUAL, SVt_PVHV); + (void)gv_fetchsv_nomg(SV_CONST2(ENV), GV_ADD|GV_NOTQUAL, SVt_PVHV); UNI(OP_CHDIR); case KEY_close: diff --git a/universal.c b/universal.c index c9d34cc67fd0..466a11054b5e 100644 --- a/universal.c +++ b/universal.c @@ -116,7 +116,7 @@ S_sv_derived_from_svpvn(pTHX_ SV *sv, SV *namesv, const char * name, const STRLE if (stash && isa_lookup(stash, namesv, name, len, flags)) return TRUE; - stash = gv_stashpvs("UNIVERSAL", 0); + stash = gv_stashsv(SV_CONST2(UNIVERSAL), 0); return stash && isa_lookup(stash, namesv, name, len, flags); } @@ -508,7 +508,7 @@ XS(XS_UNIVERSAL_can) else { pkg = gv_stashsv(sv, 0); if (!pkg) - pkg = gv_stashpvs("UNIVERSAL", 0); + pkg = gv_stashsv(SV_CONST2(UNIVERSAL), 0); } if (pkg) { @@ -714,7 +714,7 @@ XS(XS_constant__make_const) /* This is dangerous stuff. */ /* [perl #77776] - called as &foo() not foo() */ if (!SvROK(svz) || items != 1) - croak_xs_usage(cv, "SCALAR"); + croak_xs_usage(cv, PV_POOL(SCALAR, "SCALAR")); sv = SvRV(svz); diff --git a/vms/descrip_mms.template b/vms/descrip_mms.template index 3186c4e22a26..b23e91bc8f32 100644 --- a/vms/descrip_mms.template +++ b/vms/descrip_mms.template @@ -227,7 +227,7 @@ mini_obj = perlmini$(O) $(obj1) $(obj2) $(obj3) $(obj4) $(obj5) obj = $(obj0) $(obj1) $(obj2) $(obj3) $(obj4) $(obj5) h0 = av.h config.h cop.h cv.h embed.h embedvar.h -h1 = EXTERN.h form.h gv.h handy.h hv.h l1_char_class_tab.h INTERN.h intrpvar.h +h1 = EXTERN.h form.h gv.h handy.h hekpool.h hv.h l1_char_class_tab.h INTERN.h intrpvar.h h2 = iperlsys.h keywords.h mydtrace.h mg.h mg_vtable.h nostdio.h op.h h3 = op_reg_common.h opcode.h opnames.h overload.h pad.h parser.h patchlevel.h h4 = perl.h perlapi.h perlio.h perlsdio.h perlvars.h perly.h diff --git a/win32/GNUmakefile b/win32/GNUmakefile index 15724b4ec0bb..58f3e32cf2db 100644 --- a/win32/GNUmakefile +++ b/win32/GNUmakefile @@ -1000,6 +1000,7 @@ CORE_NOCFG_H = \ ..\form.h \ ..\gv.h \ ..\handy.h \ + ..\hekpool.h \ ..\hv.h \ ..\hv_func.h \ ..\iperlsys.h \ diff --git a/win32/Makefile b/win32/Makefile index af0066ceaad2..aa1e0ae2ffce 100644 --- a/win32/Makefile +++ b/win32/Makefile @@ -729,6 +729,7 @@ CORE_NOCFG_H = \ ..\form.h \ ..\gv.h \ ..\handy.h \ + ..\hekpool.h \ ..\hv.h \ ..\hv_func.h \ ..\iperlsys.h \