"B::COP"
};
-static int walkoptree_debug = 0; /* Flag for walkoptree debug hook */
+#define MY_CXT_KEY "B::_guts"##XS_VERSION
-static SV *specialsv_list[6];
+typedef struct {
+ int x_walkoptree_debug; /* Flag for walkoptree debug hook */
+ SV * x_specialsv_list[6];
+} my_cxt_t;
+
+START_MY_CXT
+
+#define walkoptree_debug (MY_CXT.x_walkoptree_debug)
+#define specialsv_list (MY_CXT.x_specialsv_list)
static opclass
cc_opclass(pTHX_ OP *o)
{
char *type = 0;
IV iv;
+ dMY_CXT;
for (iv = 0; iv < sizeof(specialsv_list)/sizeof(SV*); iv++) {
if (sv == specialsv_list[iv]) {
{
dSP;
OP *o;
-
+ dMY_CXT;
+
if (!SvROK(opsv))
croak("opsv is not a reference");
opsv = sv_mortalcopy(opsv);
{
HV *stash = gv_stashpvn("B", 1, TRUE);
AV *export_ok = perl_get_av("B::EXPORT_OK",TRUE);
+ MY_CXT_INIT;
specialsv_list[0] = Nullsv;
specialsv_list[1] = &PL_sv_undef;
specialsv_list[2] = &PL_sv_yes;
int
walkoptree_debug(...)
CODE:
+ dMY_CXT;
RETVAL = walkoptree_debug;
if (items > 0 && SvTRUE(ST(1)))
walkoptree_debug = 1;
* files when the interpreter exits
*/
-#define MY_CXT_KEY "DynaLoader_guts"
+#ifndef XS_VERSION
+# define XS_VERSION "0"
+#endif
+#define MY_CXT_KEY "DynaLoader::_guts"##XS_VERSION
typedef struct {
char * x_dl_last_error; /* pointer to allocated memory for
#endif
} my_cxt_t;
-/* XXX most of this is boilerplate code that should abstracted further into
- * macros and exposed via XSUB.h */
-
-#if defined(USE_ITHREADS)
-
-#define dMY_CXT_SV \
- SV *my_cxt_sv = *hv_fetch(PL_modglobal, MY_CXT_KEY, \
- sizeof(MY_CXT_KEY)-1, TRUE)
-
-/* we allocate my_cxt in a Perl SV so that it will be released when
- * the interpreter goes away */
-#define dMY_CXT_INIT \
- dMY_CXT_SV; \
- /* newSV() allocates one more than needed */ \
- my_cxt_t *my_cxt = (my_cxt_t*)SvPVX(newSV(sizeof(my_cxt_t)-1)); \
- Zero(my_cxt, 1, my_cxt_t); \
- sv_setuv(my_cxt_sv, (UV)my_cxt);
-
-#define dMY_CXT \
- dMY_CXT_SV; \
- my_cxt_t *my_cxt = (my_cxt_t*)SvUV(my_cxt_sv)
+START_MY_CXT
-#define dl_last_error (my_cxt->x_dl_last_error)
-#define dl_nonlazy (my_cxt->x_dl_nonlazy)
+#define dl_last_error (MY_CXT.x_dl_last_error)
+#define dl_nonlazy (MY_CXT.x_dl_nonlazy)
#ifdef DL_LOADONCEONLY
-#define dl_loaded_files (my_cxt->x_dl_loaded_files)
+#define dl_loaded_files (MY_CXT.x_dl_loaded_files)
#endif
#ifdef DL_CXT_EXTRA
-#define dl_cxtx (my_cxt->x_dl_cxtx)
+#define dl_cxtx (MY_CXT.x_dl_cxtx)
#endif
#ifdef DEBUGGING
-#define dl_debug (my_cxt->x_dl_debug)
+#define dl_debug (MY_CXT.x_dl_debug)
#endif
-#else /* USE_ITHREADS */
-
-static my_cxt_t my_cxt;
-
-#define dMY_CXT_SV dNOOP
-#define dMY_CXT_INIT dNOOP
-#define dMY_CXT dNOOP
-
-#define dl_last_error (my_cxt.x_dl_last_error)
-#define dl_nonlazy (my_cxt.x_dl_nonlazy)
-#ifdef DL_LOADONCEONLY
-#define dl_loaded_files (my_cxt.x_dl_loaded_files)
-#endif
-#ifdef DL_CXT_EXTRA
-#define dl_cxtx (my_cxt.x_dl_cxtx)
-#endif
-#ifdef DEBUGGING
-#define dl_debug (my_cxt.x_dl_debug)
-#endif
-
-#endif /* !defined(USE_ITHREADS) */
-
-
#ifdef DEBUGGING
#define DLDEBUG(level,code) \
STMT_START { \
dl_generic_private_init(pTHX) /* called by dl_*.xs dl_private_init() */
{
char *perl_dl_nonlazy;
- dMY_CXT_INIT;
+ MY_CXT_INIT;
dl_last_error = NULL;
dl_nonlazy = 0;
#include "bsd_glob.h"
-/* XXX: need some thread awareness */
-static int GLOB_ERROR = 0;
+#define MY_CXT_KEY "File::Glob::_guts"##XS_VERSION
+
+typedef struct {
+ int x_GLOB_ERROR;
+} my_cxt_t;
+
+START_MY_CXT
+
+#define GLOB_ERROR (MY_CXT.x_GLOB_ERROR)
#include "constants.c"
MODULE = File::Glob PACKAGE = File::Glob
+BOOT:
+{
+ MY_CXT_INIT;
+}
+
void
doglob(pattern,...)
char *pattern
SV *tmp;
PPCODE:
{
+ dMY_CXT;
+
/* allow for optional flags argument */
if (items > 1) {
flags = (int) SvIV(ST(1));
NAMES => [qw(GLOB_ABEND GLOB_ALPHASORT GLOB_ALTDIRFUNC GLOB_BRACE GLOB_ERR
GLOB_LIMIT GLOB_MARK GLOB_NOCASE GLOB_NOCHECK GLOB_NOMAGIC
GLOB_NOSORT GLOB_NOSPACE GLOB_QUOTE GLOB_TILDE),
- {name=>"GLOB_ERROR", macro=>1}],
+ {name=>"GLOB_ERROR", macro=>["#ifdef GLOB_ERROR\n\tdMY_CXT;\n\n","#endif\n"]}],
BREAKOUT_AT => 8,
);
#define OP_MASK_BUF_SIZE (MAXO + 100)
/* XXX op_named_bits and opset_all are never freed */
-static HV *op_named_bits; /* cache shared for whole process */
-static SV *opset_all; /* mask with all bits set */
-static IV opset_len; /* length of opmasks in bytes */
-static int opcode_debug = 0;
+#define MY_CXT_KEY "Opcode::_guts"##XS_VERSION
+
+typedef struct {
+ HV * x_op_named_bits; /* cache shared for whole process */
+ SV * x_opset_all; /* mask with all bits set */
+ IV x_opset_len; /* length of opmasks in bytes */
+ int x_opcode_debug;
+} my_cxt_t;
+
+START_MY_CXT
+
+#define op_named_bits (MY_CXT.x_op_named_bits)
+#define opset_all (MY_CXT.x_opset_all)
+#define opset_len (MY_CXT.x_opset_len)
+#define opcode_debug (MY_CXT.x_opcode_debug)
static SV *new_opset (pTHX_ SV *old_opset);
static int verify_opset (pTHX_ SV *opset, int fatal);
STRLEN len;
char **op_names;
char *bitmap;
+ dMY_CXT;
op_named_bits = newHV();
op_names = get_op_names();
put_op_bitspec(pTHX_ char *optag, STRLEN len, SV *mask)
{
SV **svp;
+ dMY_CXT;
+
verify_opset(aTHX_ mask,1);
if (!len)
len = strlen(optag);
get_op_bitspec(pTHX_ char *opname, STRLEN len, int fatal)
{
SV **svp;
+ dMY_CXT;
+
if (!len)
len = strlen(opname);
svp = hv_fetch(op_named_bits, opname, len, 0);
new_opset(pTHX_ SV *old_opset)
{
SV *opset;
+ dMY_CXT;
+
if (old_opset) {
verify_opset(aTHX_ old_opset,1);
opset = newSVsv(old_opset);
verify_opset(pTHX_ SV *opset, int fatal)
{
char *err = Nullch;
+ dMY_CXT;
+
if (!SvOK(opset)) err = "undefined";
else if (!SvPOK(opset)) err = "wrong type";
else if (SvCUR(opset) != opset_len) err = "wrong size";
static void
set_opset_bits(pTHX_ char *bitmap, SV *bitspec, int on, char *opname)
{
+ dMY_CXT;
+
if (SvIOK(bitspec)) {
int myopcode = SvIV(bitspec);
int offset = myopcode >> 3;
char *bitmask;
STRLEN len;
int myopcode = 0;
+ dMY_CXT;
verify_opset(aTHX_ opset,1); /* croaks on bad opset */
opmask_addlocal(pTHX_ SV *opset, char *op_mask_buf) /* Localise PL_op_mask then opmask_add() */
{
char *orig_op_mask = PL_op_mask;
+ dMY_CXT;
+
SAVEVPTR(PL_op_mask);
/* XXX casting to an ordinary function ptr from a member function ptr
* is disallowed by Borland
PROTOTYPES: ENABLE
BOOT:
+{
+ MY_CXT_INIT;
assert(PL_maxo < OP_MASK_BUF_SIZE);
opset_len = (PL_maxo + 7) / 8;
if (opcode_debug >= 1)
warn("opset_len %ld\n", (long)opset_len);
op_names_init(aTHX);
+}
void
_safe_pkg_prep(Package)
CODE:
{
char *bitmap;
+ dMY_CXT;
STRLEN len = opset_len;
+
opset = sv_2mortal(new_opset(aTHX_ opset)); /* verify and clone opset */
bitmap = SvPVX(opset);
while(len-- > 0)
int i, j, myopcode;
char *bitmap = SvPV(opset, len);
char **names = (desc) ? get_op_descs() : get_op_names();
+ dMY_CXT;
+
verify_opset(aTHX_ opset,1);
for (myopcode=0, i=0; i < opset_len; i++) {
U16 bits = bitmap[i];
SV *bitspec, *opset;
char *bitmap;
STRLEN len, on;
+ dMY_CXT;
+
opset = sv_2mortal(new_opset(aTHX_ Nullsv));
bitmap = SvPVX(opset);
for (i = 0; i < items; i++) {
SV *bitspec, *mask;
char *bitmap, *opname;
STRLEN len;
+ dMY_CXT;
if (!SvROK(safe) || !SvOBJECT(SvRV(safe)) || SvTYPE(SvRV(safe))!=SVt_PVHV)
croak("Not a Safe object");
STRLEN len;
SV **args;
char **op_desc = get_op_descs();
+ dMY_CXT;
+
/* copy args to a scratch area since we may push output values onto */
/* the stack faster than we read values off it if masks are used. */
args = (SV**)SvPVX(sv_2mortal(newSVpvn((char*)&ST(0), items*sizeof(SV*))));
CODE:
STRLEN len;
char *optag = SvPV(optagsv, len);
+
put_op_bitspec(aTHX_ optag, len, mask); /* croaks */
ST(0) = &PL_sv_yes;
void
full_opset()
CODE:
+ dMY_CXT;
ST(0) = sv_2mortal(new_opset(aTHX_ opset_all));
void
struct re_scream_pos_data_s *data);
extern SV* my_re_intuit_string (pTHX_ regexp *prog);
-static int oldfl;
+#define MY_CXT_KEY "re::_guts"##XS_VERSION
+
+typedef struct {
+ int x_oldflag; /* debug flag */
+} my_cxt_t;
+
+START_MY_CXT
+
+#define oldflag (MY_CXT.x_oldflag)
static void
-deinstall(pTHX)
+uninstall(pTHX)
{
+ dMY_CXT;
PL_regexecp = Perl_regexec_flags;
PL_regcompp = Perl_pregcomp;
PL_regint_start = Perl_re_intuit_start;
PL_regint_string = Perl_re_intuit_string;
PL_regfree = Perl_pregfree;
- if (!oldfl)
+ if (!oldflag)
PL_debug &= ~DEBUG_r_FLAG;
}
static void
install(pTHX)
{
+ dMY_CXT;
PL_colorset = 0; /* Allow reinspection of ENV. */
PL_regexecp = &my_regexec;
PL_regcompp = &my_regcomp;
PL_regint_start = &my_re_intuit_start;
PL_regint_string = &my_re_intuit_string;
PL_regfree = &my_regfree;
- oldfl = PL_debug & DEBUG_r_FLAG;
+ oldflag = PL_debug & DEBUG_r_FLAG;
PL_debug |= DEBUG_r_FLAG;
}
MODULE = re PACKAGE = re
+BOOT:
+{
+ MY_CXT_INIT;
+}
+
+
void
install()
CODE:
install(aTHX);
void
-deinstall()
+uninstall()
CODE:
- deinstall(aTHX);
+ uninstall(aTHX);
# endif
#endif
+/*
+ * Boilerplate macros for initializing and accessing interpreter-local
+ * data from C. All statics in extensions should be reworked to use
+ * this, if you want to make the extension thread-safe. See ext/re/re.xs
+ * for an example of the use of these macros.
+ *
+ * Code that uses these macros is responsible for the following:
+ * 1. #define MY_CXT_KEY to a unique string, e.g. "DynaLoader_guts"
+ * 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.
+ * 4. Use the MY_CXT_INIT macro such that it is called exactly once
+ * (typically put in the BOOT: section).
+ * 5. Use the members of the my_cxt_t structure everywhere as
+ * MY_CXT.member.
+ * 6. Use the dMY_CXT macro (a declaration) in all the functions that
+ * access MY_CXT.
+ */
+
+#if defined(USE_ITHREADS)
+
+/* 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)
+
+/* 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 = (my_cxt_t*)SvUV(my_cxt_sv)
+
+/* 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, (UV)my_cxtp)
+
+/* This macro must be used to access members of the my_cxt_t structure.
+ * e.g. MYCXT.some_data */
+#define MY_CXT (*my_cxtp)
+
+/* Judicious use of these macros can reduce the number of times dMY_CXT
+ * is used. Use is similar to pTHX, aTHX etc. */
+#define pMY_CXT my_cxt_t *my_cxtp
+#define pMY_CXT_ pMY_CXT,
+#define _pMY_CXT ,pMY_CXT
+#define aMY_CXT my_cxtp
+#define aMY_CXT_ aMY_CXT,
+#define _aMY_CXT ,aMY_CXT
+
+#else /* USE_ITHREADS */
+
+#define START_MY_CXT static my_cxt_t my_cxt;
+#define dMY_CXT_SV dNOOP
+#define dMY_CXT dNOOP
+#define MY_CXT_INIT NOOP
+#define MY_CXT my_cxt
+
+#define pMY_CXT void
+#define pMY_CXT_
+#define _pMY_CXT
+#define aMY_CXT
+#define aMY_CXT_
+#define _aMY_CXT
+
+#endif /* !defined(USE_ITHREADS) */
+
#ifdef I_FCNTL
# include <fcntl.h>
#endif
projects / p5sagit/p5-mst-13.2.git / commitdiff