diff options
| -rw-r--r-- | embed.fnc | 5 | ||||
| -rw-r--r-- | embed.h | 6 | ||||
| -rw-r--r-- | embedvar.h | 10 | ||||
| -rw-r--r-- | ext/XS/APItest/APItest.xs | 19 | ||||
| -rw-r--r-- | intrpvar.h | 6 | ||||
| -rw-r--r-- | perl.h | 32 | ||||
| -rw-r--r-- | perlapi.h | 8 | ||||
| -rw-r--r-- | perlvars.h | 5 | ||||
| -rw-r--r-- | pod/perlxs.pod | 12 | ||||
| -rw-r--r-- | proto.h | 7 | ||||
| -rw-r--r-- | sv.c | 8 | ||||
| -rw-r--r-- | util.c | 40 |
12 files changed, 136 insertions, 22 deletions
@@ -1609,6 +1609,11 @@ Apnod |int |my_sprintf |NN char *buffer|NN const char *pat|... px |void |my_clearenv +#ifdef PERL_IMPLICIT_CONTEXT +po |void* |my_cxt_init |NN int *index|size_t size +#endif + + END_EXTERN_C /* * ex: set ts=8 sts=4 sw=4 noet: @@ -1691,6 +1691,8 @@ #ifdef PERL_CORE #define my_clearenv Perl_my_clearenv #endif +#ifdef PERL_IMPLICIT_CONTEXT +#endif #define ck_anoncode Perl_ck_anoncode #define ck_bitop Perl_ck_bitop #define ck_concat Perl_ck_concat @@ -3727,6 +3729,10 @@ #ifdef PERL_CORE #define my_clearenv() Perl_my_clearenv(aTHX) #endif +#ifdef PERL_IMPLICIT_CONTEXT +#ifdef PERL_CORE +#endif +#endif #define ck_anoncode(a) Perl_ck_anoncode(aTHX_ a) #define ck_bitop(a) Perl_ck_bitop(aTHX_ a) #define ck_concat(a) Perl_ck_concat(aTHX_ a) diff --git a/embedvar.h b/embedvar.h index ca344b81c9..3f4a8804ee 100644 --- a/embedvar.h +++ b/embedvar.h @@ -320,6 +320,8 @@ #define PL_multi_open (vTHX->Imulti_open) #define PL_multi_start (vTHX->Imulti_start) #define PL_multiline (vTHX->Imultiline) +#define PL_my_cxt_list (vTHX->Imy_cxt_list) +#define PL_my_cxt_size (vTHX->Imy_cxt_size) #define PL_nexttoke (vTHX->Inexttoke) #define PL_nexttype (vTHX->Inexttype) #define PL_nextval (vTHX->Inextval) @@ -600,6 +602,8 @@ #define PL_Imulti_open PL_multi_open #define PL_Imulti_start PL_multi_start #define PL_Imultiline PL_multiline +#define PL_Imy_cxt_list PL_my_cxt_list +#define PL_Imy_cxt_size PL_my_cxt_size #define PL_Inexttoke PL_nexttoke #define PL_Inexttype PL_nexttype #define PL_Inextval PL_nextval @@ -862,6 +866,10 @@ #define PL_Gmalloc_mutex (my_vars->Gmalloc_mutex) #define PL_mmap_page_size (my_vars->Gmmap_page_size) #define PL_Gmmap_page_size (my_vars->Gmmap_page_size) +#define PL_my_ctx_mutex (my_vars->Gmy_ctx_mutex) +#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_op_mutex (my_vars->Gop_mutex) #define PL_Gop_mutex (my_vars->Gop_mutex) #define PL_op_seq (my_vars->Gop_seq) @@ -915,6 +923,8 @@ #define PL_Ghexdigit PL_hexdigit #define PL_Gmalloc_mutex PL_malloc_mutex #define PL_Gmmap_page_size PL_mmap_page_size +#define PL_Gmy_ctx_mutex PL_my_ctx_mutex +#define PL_Gmy_cxt_index PL_my_cxt_index #define PL_Gop_mutex PL_op_mutex #define PL_Gop_seq PL_op_seq #define PL_Gop_sequence PL_op_sequence diff --git a/ext/XS/APItest/APItest.xs b/ext/XS/APItest/APItest.xs index 22279bc6e7..c2a647800a 100644 --- a/ext/XS/APItest/APItest.xs +++ b/ext/XS/APItest/APItest.xs @@ -16,16 +16,31 @@ typedef struct { START_MY_CXT /* indirect functions to test the [pa]MY_CXT macros */ + int my_cxt_getint_p(pMY_CXT) { return MY_CXT.i; } + void my_cxt_setint_p(pMY_CXT_ int i) { MY_CXT.i = i; } + +SV* +my_cxt_getsv_interp() +{ +#ifdef PERL_IMPLICIT_CONTEXT + dTHX; + dMY_CXT_INTERP(my_perl); +#else + dMY_CXT; +#endif + return MY_CXT.sv; +} + void my_cxt_setsv_p(SV* sv _pMY_CXT) { @@ -33,7 +48,6 @@ my_cxt_setsv_p(SV* sv _pMY_CXT) } - /* from exception.c */ int exception(int); @@ -477,9 +491,8 @@ my_cxt_setint(i) void my_cxt_getsv() PPCODE: - dMY_CXT; EXTEND(SP, 1); - ST(0) = MY_CXT.sv; + ST(0) = my_cxt_getsv_interp(); XSRETURN(1); void diff --git a/intrpvar.h b/intrpvar.h index 04ea137362..931ac461fb 100644 --- a/intrpvar.h +++ b/intrpvar.h @@ -517,6 +517,12 @@ PERLVARI(Isuidscript, int, -1) /* fd for suid script */ /* File descriptor to talk to the child which dumps scalars. */ PERLVARI(Idumper_fd, int, -1) #endif + +#ifdef PERL_IMPLICIT_CONTEXT +PERLVARI(Imy_cxt_size, int, -1) /* size of PL_my_cxt_list */ +PERLVARI(Imy_cxt_list, void **, NULL) /* per-module array of MY_CXT pointers */ +#endif + /* New variables must be added to the very end, before this comment, * for binary compatibility (the offsets of the old members must not change). * (Don't forget to add your variable also to perl_clone()!) @@ -5094,6 +5094,7 @@ typedef struct am_table_short AMTS; * Code that uses these macros is responsible for the following: * 1. #define MY_CXT_KEY to a unique string, e.g. * "DynaLoader::_guts" XS_VERSION + * XXX in the current implementation, this string is ignored. * 2. Declare a typedef named my_cxt_t that is a structure that contains * all the data that needs to be interpreter-local. * 3. Use the START_MY_CXT macro after the declaration of my_cxt_t. @@ -5110,35 +5111,30 @@ typedef struct am_table_short AMTS; /* This must appear in all extensions that define a my_cxt_t structure, * right after the definition (i.e. at file scope). The non-threads * case below uses it to declare the data as static. */ -#define START_MY_CXT - -/* Fetches the SV that keeps the per-interpreter data. */ -#define dMY_CXT_SV \ - SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \ - sizeof(MY_CXT_KEY)-1, TRUE) +#define START_MY_CXT static int my_cxt_index = -1; /* This declaration should be used within all functions that use the * interpreter-local data. */ #define dMY_CXT \ - dMY_CXT_SV; \ - my_cxt_t *my_cxtp = INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)) + my_cxt_t *my_cxtp = (my_cxt_t *)PL_my_cxt_list[my_cxt_index] +#define dMY_CXT_INTERP(my_perl) \ + my_cxt_t *my_cxtp = (my_cxt_t *)(my_perl)->Imy_cxt_list[my_cxt_index] /* Creates and zeroes the per-interpreter data. * (We allocate my_cxtp in a Perl SV so that it will be released when * the interpreter goes away.) */ #define MY_CXT_INIT \ - dMY_CXT_SV; \ - /* newSV() allocates one more than needed */ \ - my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ - Zero(my_cxtp, 1, my_cxt_t); \ - sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) + my_cxt_t *my_cxtp = \ + (my_cxt_t*)Perl_my_cxt_init(aTHX_ &my_cxt_index, sizeof(my_cxt_t)) +#define MY_CXT_INIT_INTERP(my_perl) \ + my_cxt_t *my_cxtp = \ + (my_cxt_t*)Perl_my_cxt_init(my_perl, &my_cxt_index, sizeof(my_cxt_t)) /* Clones the per-interpreter data. */ #define MY_CXT_CLONE \ - dMY_CXT_SV; \ my_cxt_t *my_cxtp = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1));\ - Copy(INT2PTR(my_cxt_t*, SvUV(my_cxt_sv)), my_cxtp, 1, my_cxt_t);\ - sv_setuv(my_cxt_sv, PTR2UV(my_cxtp)) + Copy(PL_my_cxt_list[my_cxt_index], my_cxtp, 1, my_cxt_t);\ + PL_my_cxt_list[my_cxt_index] = my_cxtp \ /* This macro must be used to access members of the my_cxt_t structure. * e.g. MYCXT.some_data */ @@ -5153,7 +5149,7 @@ typedef struct am_table_short AMTS; #define aMY_CXT_ aMY_CXT, #define _aMY_CXT ,aMY_CXT -#else /* USE_ITHREADS */ +#else /* PERL_IMPLICIT_CONTEXT */ #define START_MY_CXT static my_cxt_t my_cxt; #define dMY_CXT_SV dNOOP @@ -5169,7 +5165,7 @@ typedef struct am_table_short AMTS; #define aMY_CXT_ #define _aMY_CXT -#endif /* !defined(USE_ITHREADS) */ +#endif /* !defined(PERL_IMPLICIT_CONTEXT) */ #ifdef I_FCNTL # include <fcntl.h> @@ -438,6 +438,10 @@ END_EXTERN_C #define PL_multi_start (*Perl_Imulti_start_ptr(aTHX)) #undef PL_multiline #define PL_multiline (*Perl_Imultiline_ptr(aTHX)) +#undef PL_my_cxt_list +#define PL_my_cxt_list (*Perl_Imy_cxt_list_ptr(aTHX)) +#undef PL_my_cxt_size +#define PL_my_cxt_size (*Perl_Imy_cxt_size_ptr(aTHX)) #undef PL_nexttoke #define PL_nexttoke (*Perl_Inexttoke_ptr(aTHX)) #undef PL_nexttype @@ -926,6 +930,10 @@ END_EXTERN_C #define PL_malloc_mutex (*Perl_Gmalloc_mutex_ptr(NULL)) #undef PL_mmap_page_size #define PL_mmap_page_size (*Perl_Gmmap_page_size_ptr(NULL)) +#undef PL_my_ctx_mutex +#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_op_mutex #define PL_op_mutex (*Perl_Gop_mutex_ptr(NULL)) #undef PL_op_seq diff --git a/perlvars.h b/perlvars.h index 9f3a399161..c15b6667dd 100644 --- a/perlvars.h +++ b/perlvars.h @@ -124,4 +124,9 @@ PERLVARI(Gop_seq, UV, 0) /* dump.c */ PERLVAR(Gtimesbase, struct tms) #endif +/* allocate a unique index to every module that calls MY_CXT_INIT */ +#ifdef PERL_IMPLICIT_CONTEXT +PERLVAR(Gmy_ctx_mutex, perl_mutex) +PERLVARI(Gmy_cxt_index, int, 0) +#endif diff --git a/pod/perlxs.pod b/pod/perlxs.pod index b3ba08f56a..e6f1862e56 100644 --- a/pod/perlxs.pod +++ b/pod/perlxs.pod @@ -1926,7 +1926,6 @@ Below is an example module that makes use of the macros. CODE: MY_CXT_CLONE; - B<REFERENCE> =over 5 @@ -2013,8 +2012,19 @@ my_cxt_t structure. Calling C<MY_CXT_CLONE> (typically via the package's C<CLONE()> function), causes a byte-for-byte copy of the structure to be taken, and any future dMY_CXT will cause the copy to be accessed instead. +=item MY_CXT_INIT_INTERP(my_perl) + +=item dMY_CXT_INTERP(my_perl) + +These are versions of the macros which take an explicit interpreter as an +argument. + =back +Note that these macros will only work together within the I<same> source +file; that is, a dMY_CTX in one source file will access a different structure +than a dMY_CTX in another source file. + =head1 EXAMPLES File C<RPC.xs>: Interface to some ONC+ RPC bind library functions. @@ -4206,6 +4206,13 @@ PERL_CALLCONV int Perl_my_sprintf(char *buffer, const char *pat, ...) PERL_CALLCONV void Perl_my_clearenv(pTHX); +#ifdef PERL_IMPLICIT_CONTEXT +PERL_CALLCONV void* Perl_my_cxt_init(pTHX_ int *index, size_t size) + __attribute__nonnull__(pTHX_1); + +#endif + + END_EXTERN_C /* * ex: set ts=8 sts=4 sw=4 noet: @@ -10394,6 +10394,14 @@ perl_clone_using(PerlInterpreter *proto_perl, UV flags, } else PL_exitlist = (PerlExitListEntry*)NULL; + + PL_my_cxt_size = proto_perl->Imy_cxt_size; + 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 *); + } + else + PL_my_cxt_list = (void**)NULL; PL_modglobal = hv_dup_inc(proto_perl->Imodglobal, param); PL_custom_op_names = hv_dup_inc(proto_perl->Icustom_op_names,param); PL_custom_op_descs = hv_dup_inc(proto_perl->Icustom_op_descs,param); @@ -5199,6 +5199,46 @@ Perl_my_clearenv(pTHX) #endif /* PERL_MICRO */ } +#ifdef PERL_IMPLICIT_CONTEXT + +/* implements the MY_CXT_INIT macro. The first time a module is loaded, +the global PL_my_cxt_index is incremented, and that value is assigned to +that module's static my_cxt_index (who's address is passed as an arg). +Then, for each interpreter this function is called for, it makes sure a +void* slot is available to hang the static data off, by allocating or +extending the interpreter's PL_my_cxt_list array */ + +void * +Perl_my_cxt_init(pTHX_ int *index, size_t size) +{ + void *p; + if (*index == -1) { + /* this module hasn't been allocated an index yet */ + MUTEX_LOCK(&PL_my_ctx_mutex); + *index = PL_my_cxt_index++; + MUTEX_UNLOCK(&PL_my_ctx_mutex); + } + + /* make sure the array is big enough */ + if (PL_my_cxt_size < *index + 1) { + if (PL_my_cxt_list) { + while (PL_my_cxt_size < *index + 1) + PL_my_cxt_size *= 2; + Renew(PL_my_cxt_list, PL_my_cxt_size, void *); + } + else { + PL_my_cxt_size = 16; + Newx(PL_my_cxt_list, PL_my_cxt_size, void *); + } + } + /* newSV() allocates one more than needed */ + p = (void*)SvPVX(newSV(size-1)); + PL_my_cxt_list[*index] = p; + Zero(p, size, char); + return p; +} +#endif + /* * Local variables: * c-indentation-style: bsd |