summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--embed.fnc2
-rw-r--r--embed.h2
-rw-r--r--pad.c125
-rw-r--r--pad.h1
-rw-r--r--proto.h5
5 files changed, 78 insertions, 57 deletions
diff --git a/embed.fnc b/embed.fnc
index 1a15d5a25f..1fca12ffcb 100644
--- a/embed.fnc
+++ b/embed.fnc
@@ -1964,6 +1964,8 @@ pR |HV* |pad_compname_type|const PADOFFSET po
sd |PADOFFSET|pad_findlex |NN const char *name|NN const CV* cv|U32 seq|int warn \
|NULLOK SV** out_capture|NN SV** out_name_sv \
|NN int *out_flags
+s |PADOFFSET|pad_add_name_sv|NN SV *namesv|const U32 flags \
+ |NULLOK HV *typestash|NULLOK HV *ourstash
# if defined(DEBUGGING)
sd |void |cv_dump |NN const CV *cv|NN const char *title
# endif
diff --git a/embed.h b/embed.h
index 3e9e702270..f71e797203 100644
--- a/embed.h
+++ b/embed.h
@@ -1734,6 +1734,7 @@
#if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define pad_findlex S_pad_findlex
+#define pad_add_name_sv S_pad_add_name_sv
#endif
# if defined(DEBUGGING)
#ifdef PERL_CORE
@@ -4111,6 +4112,7 @@
#if defined(PERL_IN_PAD_C) || defined(PERL_DECL_PROT)
#ifdef PERL_CORE
#define pad_findlex(a,b,c,d,e,f,g) S_pad_findlex(aTHX_ a,b,c,d,e,f,g)
+#define pad_add_name_sv(a,b,c,d) S_pad_add_name_sv(aTHX_ a,b,c,d)
#endif
# if defined(DEBUGGING)
#ifdef PERL_CORE
diff --git a/pad.c b/pad.c
index d80679ad86..4280c9f519 100644
--- a/pad.c
+++ b/pad.c
@@ -339,6 +339,35 @@ Perl_pad_undef(pTHX_ CV* cv)
+static PADOFFSET
+S_pad_add_name_sv(pTHX_ SV *namesv, const U32 flags, HV *typestash,
+ HV *ourstash)
+{
+ dVAR;
+ const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
+
+ PERL_ARGS_ASSERT_PAD_ADD_NAME_SV;
+
+ ASSERT_CURPAD_ACTIVE("pad_add_name");
+
+ if (typestash) {
+ assert(SvTYPE(namesv) == SVt_PVMG);
+ SvPAD_TYPED_on(namesv);
+ SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))));
+ }
+ if (ourstash) {
+ SvPAD_OUR_on(namesv);
+ SvOURSTASH_set(namesv, ourstash);
+ SvREFCNT_inc_simple_void_NN(ourstash);
+ }
+ else if (flags & pad_add_STATE) {
+ SvPAD_STATE_on(namesv);
+ }
+
+ av_store(PL_comppad_name, offset, namesv);
+ return offset;
+}
+
/*
=for apidoc pad_add_name
@@ -359,14 +388,12 @@ Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const U32 flags,
HV *typestash, HV *ourstash)
{
dVAR;
- const PADOFFSET offset = pad_alloc(OP_PADSV, SVs_PADMY);
+ PADOFFSET offset;
SV *namesv;
PERL_ARGS_ASSERT_PAD_ADD_NAME;
- ASSERT_CURPAD_ACTIVE("pad_add_name");
-
- if (flags & ~(pad_add_STATE|pad_add_FAKE))
+ if (flags & ~(pad_add_STATE))
Perl_croak(aTHX_ "panic: pad_add_name illegal flag bits 0x%" UVxf,
(UV)flags);
@@ -379,46 +406,26 @@ Perl_pad_add_name(pTHX_ const char *name, const STRLEN len, const U32 flags,
sv_setpv(namesv, name);
- if (typestash) {
- assert(SvTYPE(namesv) == SVt_PVMG);
- SvPAD_TYPED_on(namesv);
- SvSTASH_set(namesv, MUTABLE_HV(SvREFCNT_inc_simple_NN(MUTABLE_SV(typestash))));
- }
- if (ourstash) {
- SvPAD_OUR_on(namesv);
- SvOURSTASH_set(namesv, ourstash);
- SvREFCNT_inc_simple_void_NN(ourstash);
- }
- else if (flags & pad_add_STATE) {
- SvPAD_STATE_on(namesv);
- }
-
- av_store(PL_comppad_name, offset, namesv);
- if (flags & pad_add_FAKE) {
- SvFAKE_on(namesv);
- DEBUG_Xv(PerlIO_printf(Perl_debug_log,
- "Pad addname: %ld \"%s\" FAKE\n", (long)offset, name));
- }
- else {
- /* not yet introduced */
- COP_SEQ_RANGE_LOW_set(namesv, PAD_MAX); /* min */
- COP_SEQ_RANGE_HIGH_set(namesv, 0); /* max */
-
- if (!PL_min_intro_pending)
- PL_min_intro_pending = offset;
- PL_max_intro_pending = offset;
- /* if it's not a simple scalar, replace with an AV or HV */
- /* XXX DAPM since slot has been allocated, replace
- * av_store with PL_curpad[offset] ? */
- if (*name == '@')
- av_store(PL_comppad, offset, MUTABLE_SV(newAV()));
- else if (*name == '%')
- av_store(PL_comppad, offset, MUTABLE_SV(newHV()));
- SvPADMY_on(PL_curpad[offset]);
- DEBUG_Xv(PerlIO_printf(Perl_debug_log,
- "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
- (long)offset, name, PTR2UV(PL_curpad[offset])));
- }
+ offset = pad_add_name_sv(namesv, flags, typestash, ourstash);
+
+ /* not yet introduced */
+ COP_SEQ_RANGE_LOW_set(namesv, PAD_MAX); /* min */
+ COP_SEQ_RANGE_HIGH_set(namesv, 0); /* max */
+
+ if (!PL_min_intro_pending)
+ PL_min_intro_pending = offset;
+ PL_max_intro_pending = offset;
+ /* if it's not a simple scalar, replace with an AV or HV */
+ /* XXX DAPM since slot has been allocated, replace
+ * av_store with PL_curpad[offset] ? */
+ if (*name == '@')
+ av_store(PL_comppad, offset, MUTABLE_SV(newAV()));
+ else if (*name == '%')
+ av_store(PL_comppad, offset, MUTABLE_SV(newHV()));
+ SvPADMY_on(PL_curpad[offset]);
+ DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+ "Pad addname: %ld \"%s\" new lex=0x%"UVxf"\n",
+ (long)offset, name, PTR2UV(PL_curpad[offset])));
return offset;
}
@@ -904,24 +911,30 @@ S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, int warn,
return 0; /* this dummy (and invalid) value isnt used by the caller */
{
- SV *new_namesv;
+ /* This relies on sv_setsv_flags() upgrading the destination to the same
+ type as the source, independant of the flags set, and on it being
+ "good" and only copying flag bits and pointers that it understands.
+ */
+ SV *new_namesv = newSVsv(*out_name_sv);
AV * const ocomppad_name = PL_comppad_name;
PAD * const ocomppad = PL_comppad;
PL_comppad_name = MUTABLE_AV(AvARRAY(padlist)[0]);
PL_comppad = MUTABLE_AV(AvARRAY(padlist)[1]);
PL_curpad = AvARRAY(PL_comppad);
- new_offset = pad_add_name(
- SvPVX_const(*out_name_sv),
- SvCUR(*out_name_sv),
- /* state variable ? */
- pad_add_FAKE | (SvPAD_STATE(*out_name_sv) ? pad_add_STATE : 0),
- SvPAD_TYPED(*out_name_sv)
- ? SvSTASH(*out_name_sv) : NULL,
- SvOURSTASH(*out_name_sv)
- );
-
- new_namesv = AvARRAY(PL_comppad_name)[new_offset];
+ new_offset
+ = pad_add_name_sv(new_namesv,
+ (SvPAD_STATE(*out_name_sv) ? pad_add_STATE : 0),
+ SvPAD_TYPED(*out_name_sv)
+ ? SvSTASH(*out_name_sv) : NULL,
+ SvOURSTASH(*out_name_sv)
+ );
+
+ SvFAKE_on(new_namesv);
+ DEBUG_Xv(PerlIO_printf(Perl_debug_log,
+ "Pad addname: %ld \"%.*s\" FAKE\n",
+ (long)new_offset,
+ (int) SvCUR(new_namesv), SvPVX(new_namesv)));
PARENT_FAKELEX_FLAGS_set(new_namesv, *out_flags);
PARENT_PAD_INDEX_set(new_namesv, 0);
diff --git a/pad.h b/pad.h
index 074d52ed21..e6cee110c7 100644
--- a/pad.h
+++ b/pad.h
@@ -119,7 +119,6 @@ typedef enum {
# define pad_add_OUR 0x01 /* our declaration. */
# define pad_add_STATE 0x02 /* state declaration. */
-# define pad_add_FAKE 0x04
#endif
diff --git a/proto.h b/proto.h
index 5d326b54ce..243495bbde 100644
--- a/proto.h
+++ b/proto.h
@@ -6162,6 +6162,11 @@ STATIC PADOFFSET S_pad_findlex(pTHX_ const char *name, const CV* cv, U32 seq, in
#define PERL_ARGS_ASSERT_PAD_FINDLEX \
assert(name); assert(cv); assert(out_name_sv); assert(out_flags)
+STATIC PADOFFSET S_pad_add_name_sv(pTHX_ SV *namesv, const U32 flags, HV *typestash, HV *ourstash)
+ __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_PAD_ADD_NAME_SV \
+ assert(namesv)
+
# if defined(DEBUGGING)
STATIC void S_cv_dump(pTHX_ const CV *cv, const char *title)
__attribute__nonnull__(pTHX_1)
View Lorry Controller Status