summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--embedvar.h5
-rw-r--r--intrpvar.h3
-rw-r--r--makedef.pl2
-rw-r--r--perlapi.h4
-rw-r--r--perlvars.h10
-rw-r--r--sv.c7
-rw-r--r--util.c31
7 files changed, 47 insertions, 15 deletions
diff --git a/embedvar.h b/embedvar.h
index 37e4ab1600..420664d68c 100644
--- a/embedvar.h
+++ b/embedvar.h
@@ -203,7 +203,6 @@
#define PL_modcount (vTHX->Imodcount)
#define PL_modglobal (vTHX->Imodglobal)
#define PL_multideref_pc (vTHX->Imultideref_pc)
-#define PL_my_cxt_keys (vTHX->Imy_cxt_keys)
#define PL_my_cxt_list (vTHX->Imy_cxt_list)
#define PL_my_cxt_size (vTHX->Imy_cxt_size)
#define PL_na (vTHX->Ina)
@@ -426,6 +425,10 @@
#define PL_Gmy_ctx_mutex (my_vars->Gmy_ctx_mutex)
#define PL_my_cxt_index (my_vars->Gmy_cxt_index)
#define PL_Gmy_cxt_index (my_vars->Gmy_cxt_index)
+#define PL_my_cxt_keys (my_vars->Gmy_cxt_keys)
+#define PL_Gmy_cxt_keys (my_vars->Gmy_cxt_keys)
+#define PL_my_cxt_keys_size (my_vars->Gmy_cxt_keys_size)
+#define PL_Gmy_cxt_keys_size (my_vars->Gmy_cxt_keys_size)
#define PL_op_mutex (my_vars->Gop_mutex)
#define PL_Gop_mutex (my_vars->Gop_mutex)
#define PL_op_seq (my_vars->Gop_seq)
diff --git a/intrpvar.h b/intrpvar.h
index f604ef9426..1f69ab277a 100644
--- a/intrpvar.h
+++ b/intrpvar.h
@@ -772,9 +772,6 @@ PERLVARI(I, globhook, globhook_t, NULL)
#ifdef PERL_IMPLICIT_CONTEXT
PERLVARI(I, my_cxt_list, void **, NULL) /* per-module array of MY_CXT pointers */
PERLVARI(I, my_cxt_size, int, 0) /* size of PL_my_cxt_list */
-# ifdef PERL_GLOBAL_STRUCT_PRIVATE
-PERLVARI(I, my_cxt_keys, const char **, NULL) /* per-module array of pointers to MY_CXT_KEY constants */
-# endif
#endif
#if defined(PERL_IMPLICIT_CONTEXT) || defined(PERL_DEBUG_READONLY_COW)
diff --git a/makedef.pl b/makedef.pl
index 2e4e6dcda0..dbb7f7da9d 100644
--- a/makedef.pl
+++ b/makedef.pl
@@ -455,6 +455,7 @@ unless ($define{'PERL_IMPLICIT_CONTEXT'}) {
PL_my_cxt_list
PL_my_cxt_size
PL_my_cxt_keys
+ PL_my_cxt_keys_size
Perl_croak_nocontext
Perl_die_nocontext
Perl_deb_nocontext
@@ -536,6 +537,7 @@ unless ($define{'PERL_GLOBAL_STRUCT'}) {
unless ($define{'PERL_GLOBAL_STRUCT_PRIVATE'}) {
++$skip{$_} foreach qw(
PL_my_cxt_keys
+ PL_my_cxt_keys_size
Perl_my_cxt_index
);
}
diff --git a/perlapi.h b/perlapi.h
index 6eac8f72c1..66f5ac5f73 100644
--- a/perlapi.h
+++ b/perlapi.h
@@ -177,6 +177,10 @@ END_EXTERN_C
#define PL_my_ctx_mutex (*Perl_Gmy_ctx_mutex_ptr(NULL))
#undef PL_my_cxt_index
#define PL_my_cxt_index (*Perl_Gmy_cxt_index_ptr(NULL))
+#undef PL_my_cxt_keys
+#define PL_my_cxt_keys (*Perl_Gmy_cxt_keys_ptr(NULL))
+#undef PL_my_cxt_keys_size
+#define PL_my_cxt_keys_size (*Perl_Gmy_cxt_keys_size_ptr(NULL))
#undef PL_op_mutex
#define PL_op_mutex (*Perl_Gop_mutex_ptr(NULL))
#undef PL_op_seq
diff --git a/perlvars.h b/perlvars.h
index ae34a1e583..be56d5407a 100644
--- a/perlvars.h
+++ b/perlvars.h
@@ -337,3 +337,13 @@ PERLVARI(G, strategy_socket, int, 0) /* doio.c */
PERLVARI(G, strategy_accept, int, 0) /* doio.c */
PERLVARI(G, strategy_pipe, int, 0) /* doio.c */
PERLVARI(G, strategy_socketpair, int, 0) /* doio.c */
+
+#ifdef PERL_IMPLICIT_CONTEXT
+# ifdef PERL_GLOBAL_STRUCT_PRIVATE
+/* per-module array of pointers to MY_CXT_KEY constants.
+ * It simulates each module having a static my_cxt_index var on builds
+ * which don't allow static vars */
+PERLVARI(G, my_cxt_keys, const char **, NULL)
+PERLVARI(G, my_cxt_keys_size, int, 0) /* size of PL_my_cxt_keys */
+# endif
+#endif
diff --git a/sv.c b/sv.c
index d7315b2a3f..3575e89e3c 100644
--- a/sv.c
+++ b/sv.c
@@ -15575,16 +15575,9 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags,
if (PL_my_cxt_size) {
Newx(PL_my_cxt_list, PL_my_cxt_size, void *);
Copy(proto_perl->Imy_cxt_list, PL_my_cxt_list, PL_my_cxt_size, void *);
-#ifdef PERL_GLOBAL_STRUCT_PRIVATE
- Newx(PL_my_cxt_keys, PL_my_cxt_size, const char *);
- Copy(proto_perl->Imy_cxt_keys, PL_my_cxt_keys, PL_my_cxt_size, char *);
-#endif
}
else {
PL_my_cxt_list = (void**)NULL;
-#ifdef PERL_GLOBAL_STRUCT_PRIVATE
- PL_my_cxt_keys = (const char**)NULL;
-#endif
}
PL_modglobal = hv_dup_inc(proto_perl->Imodglobal, param);
PL_custom_op_names = hv_dup_inc(proto_perl->Icustom_op_names,param);
diff --git a/util.c b/util.c
index ae86a8c4a4..6e1587ea58 100644
--- a/util.c
+++ b/util.c
@@ -5290,6 +5290,33 @@ Perl_my_cxt_init(pTHX_ const char *my_cxt_key, size_t size)
if (index == -1)
/* this module hasn't been allocated an index yet */
index = PL_my_cxt_index++;
+
+ /* Store the index in a global MY_CXT_KEY string to index mapping
+ * table. This emulates the perl-module static my_cxt_index var on
+ * builds which don't allow static vars */
+ if (PL_my_cxt_keys_size <= index) {
+ int old_size = PL_my_cxt_keys_size;
+ int i;
+ if (PL_my_cxt_keys_size) {
+ IV new_size = PL_my_cxt_keys_size;
+ while (new_size <= index)
+ new_size *= 2;
+ PL_my_cxt_keys = (const char **)PerlMemShared_realloc(
+ PL_my_cxt_keys,
+ new_size * sizeof(const char *));
+ PL_my_cxt_keys_size = new_size;
+ }
+ else {
+ PL_my_cxt_keys_size = 16;
+ PL_my_cxt_keys = (const char **)PerlMemShared_malloc(
+ PL_my_cxt_keys_size * sizeof(const char *));
+ }
+ for (i = old_size; i < PL_my_cxt_keys_size; i++) {
+ PL_my_cxt_keys[i] = 0;
+ }
+ }
+ PL_my_cxt_keys[index] = my_cxt_key;
+
MUTEX_UNLOCK(&PL_my_ctx_mutex);
}
@@ -5302,20 +5329,16 @@ Perl_my_cxt_init(pTHX_ const char *my_cxt_key, size_t size)
while (new_size <= index)
new_size *= 2;
Renew(PL_my_cxt_list, new_size, void *);
- Renew(PL_my_cxt_keys, new_size, const char *);
PL_my_cxt_size = new_size;
}
else {
PL_my_cxt_size = 16;
Newx(PL_my_cxt_list, PL_my_cxt_size, void *);
- Newx(PL_my_cxt_keys, PL_my_cxt_size, const char *);
}
for (i = old_size; i < PL_my_cxt_size; i++) {
- PL_my_cxt_keys[i] = 0;
PL_my_cxt_list[i] = 0;
}
}
- PL_my_cxt_keys[index] = my_cxt_key;
/* newSV() allocates one more than needed */
p = (void*)SvPVX(newSV(size-1));
PL_my_cxt_list[index] = p;