Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

POC C static shared string HEKPOOL API #23042

Open
wants to merge 2 commits into
base: blead
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
2 changes: 1 addition & 1 deletion Cross/Makefile-cross-SH
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 2 additions & 0 deletions MANIFEST
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion Makefile.SH
Original file line number Diff line number Diff line change
Expand Up @@ -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 \
Expand Down
12 changes: 6 additions & 6 deletions av.c
Original file line number Diff line number Diff line change
Expand Up @@ -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;
}
Expand Down Expand Up @@ -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;
}
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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;
}
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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;
}
Expand Down
3 changes: 2 additions & 1 deletion class.c
Original file line number Diff line number Diff line change
Expand Up @@ -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;
}
Expand Down
2 changes: 1 addition & 1 deletion configpm
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
16 changes: 16 additions & 0 deletions cop.h
Original file line number Diff line number Diff line change
Expand Up @@ -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))
Expand Down
6 changes: 3 additions & 3 deletions doio.c
Original file line number Diff line number Diff line change
Expand Up @@ -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) {
Expand Down Expand Up @@ -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));
}
Expand Down Expand Up @@ -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;
}
Expand Down
27 changes: 20 additions & 7 deletions embed.fnc
Original file line number Diff line number Diff line change
Expand Up @@ -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 \
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 \
Expand Down Expand Up @@ -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 \
Expand Down
10 changes: 9 additions & 1 deletion embed.h
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand All @@ -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)
Expand Down Expand Up @@ -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
Expand Down
1 change: 1 addition & 0 deletions embedvar.h

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

2 changes: 2 additions & 0 deletions globvar.sym
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
Loading