diff options
| -rw-r--r-- | embedvar.h | 5 | ||||
| -rw-r--r-- | intrpvar.h | 3 | ||||
| -rw-r--r-- | makedef.pl | 2 | ||||
| -rw-r--r-- | perlapi.h | 4 | ||||
| -rw-r--r-- | perlvars.h | 10 | ||||
| -rw-r--r-- | sv.c | 7 | ||||
| -rw-r--r-- | util.c | 31 |
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 ); } @@ -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 @@ -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); @@ -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; |