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:
#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
#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)
#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)
#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
#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)
#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
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)
{
}
-
/* from exception.c */
int exception(int);
void
my_cxt_getsv()
PPCODE:
- dMY_CXT;
EXTEND(SP, 1);
- ST(0) = MY_CXT.sv;
+ ST(0) = my_cxt_getsv_interp();
XSRETURN(1);
void
/* 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()!)
* 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.
/* 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 */
#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
#define aMY_CXT_
#define _aMY_CXT
-#endif /* !defined(USE_ITHREADS) */
+#endif /* !defined(PERL_IMPLICIT_CONTEXT) */
#ifdef I_FCNTL
# include <fcntl.h>
#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
#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
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
CODE:
MY_CXT_CLONE;
-
B<REFERENCE>
=over 5
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.
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:
}
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);
#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
projects / p5sagit/p5-mst-13.2.git / commitdiff