From: Jarkko Hietaniemi Date: Thu, 25 Oct 2001 18:07:58 +0000 (+0000) Subject: Integrate changes #12652 and #12653 from maintperl; X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=89ca4ac7af707d34da190bf469b8073ada175d9b;p=p5sagit%2Fp5-mst-13.2.git Integrate changes #12652 and #12653 from maintperl; more tweaks to change#12626 * move the boilerplate code over to perl.h and make DynaLoader use it * make re, Opcode, File::Glob and B threadsafe * re.xs needed s/deinstall/uninstall/ (guess nobody uses C anywhere) include XS_VERSION in MY_CXT_KEY (tweak for change#12652) File::Glob required a bit more work in bleadperl because of ExtUtils::Constant (see the Makefile.PL change) p4raw-link: @12652 on //depot/maint-5.6/perl: 3bc8871b91a24662eada2114d9a016153718b1c4 p4raw-link: @12626 on //depot/maint-5.6/perl: 512dcce54ea4db665708f91609bdd0a6126d1acd p4raw-id: //depot/perl@12654 p4raw-integrated: from //depot/maint-5.6/perl@12650 'edit in' ext/B/B.xs ext/DynaLoader/dlutils.c (@12652..) 'merge in' perl.h (@12597..) ext/File/Glob/Glob.xs ext/Opcode/Opcode.xs ext/re/re.xs (@12652..) --- diff --git a/ext/B/B.xs b/ext/B/B.xs index 0a95d98..b2c163a 100644 --- a/ext/B/B.xs +++ b/ext/B/B.xs @@ -70,9 +70,17 @@ static char *opclassnames[] = { "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) @@ -192,6 +200,7 @@ make_sv_object(pTHX_ SV *arg, SV *sv) { char *type = 0; IV iv; + dMY_CXT; for (iv = 0; iv < sizeof(specialsv_list)/sizeof(SV*); iv++) { if (sv == specialsv_list[iv]) { @@ -312,7 +321,8 @@ walkoptree(pTHX_ SV *opsv, char *method) { dSP; OP *o; - + dMY_CXT; + if (!SvROK(opsv)) croak("opsv is not a reference"); opsv = sv_mortalcopy(opsv); @@ -373,6 +383,7 @@ BOOT: { 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; @@ -440,6 +451,7 @@ walkoptree(opsv, method) int walkoptree_debug(...) CODE: + dMY_CXT; RETVAL = walkoptree_debug; if (items > 0 && SvTRUE(ST(1))) walkoptree_debug = 1; diff --git a/ext/DynaLoader/dlutils.c b/ext/DynaLoader/dlutils.c index 604c7f4..f15cf73 100644 --- a/ext/DynaLoader/dlutils.c +++ b/ext/DynaLoader/dlutils.c @@ -8,7 +8,10 @@ * 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 @@ -26,63 +29,20 @@ typedef struct { #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 { \ @@ -123,7 +83,7 @@ static void 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; diff --git a/ext/File/Glob/Glob.xs b/ext/File/Glob/Glob.xs index 85ddf02..f2210bc 100644 --- a/ext/File/Glob/Glob.xs +++ b/ext/File/Glob/Glob.xs @@ -4,8 +4,15 @@ #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" @@ -20,6 +27,11 @@ errfunc(const char *foo, int bar) { MODULE = File::Glob PACKAGE = File::Glob +BOOT: +{ + MY_CXT_INIT; +} + void doglob(pattern,...) char *pattern @@ -32,6 +44,8 @@ PREINIT: SV *tmp; PPCODE: { + dMY_CXT; + /* allow for optional flags argument */ if (items > 1) { flags = (int) SvIV(ST(1)); diff --git a/ext/File/Glob/Makefile.PL b/ext/File/Glob/Makefile.PL index b73a0c4..0ff49eb 100644 --- a/ext/File/Glob/Makefile.PL +++ b/ext/File/Glob/Makefile.PL @@ -27,6 +27,6 @@ WriteConstants( 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, ); diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs index 22f022b..c00a5e5 100644 --- a/ext/Opcode/Opcode.xs +++ b/ext/Opcode/Opcode.xs @@ -7,10 +7,21 @@ #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); @@ -34,6 +45,7 @@ op_names_init(pTHX) STRLEN len; char **op_names; char *bitmap; + dMY_CXT; op_named_bits = newHV(); op_names = get_op_names(); @@ -66,6 +78,8 @@ static void put_op_bitspec(pTHX_ char *optag, STRLEN len, SV *mask) { SV **svp; + dMY_CXT; + verify_opset(aTHX_ mask,1); if (!len) len = strlen(optag); @@ -87,6 +101,8 @@ static SV * 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); @@ -110,6 +126,8 @@ static SV * new_opset(pTHX_ SV *old_opset) { SV *opset; + dMY_CXT; + if (old_opset) { verify_opset(aTHX_ old_opset,1); opset = newSVsv(old_opset); @@ -129,6 +147,8 @@ static int 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"; @@ -142,6 +162,8 @@ verify_opset(pTHX_ SV *opset, int fatal) 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; @@ -180,6 +202,7 @@ opmask_add(pTHX_ SV *opset) /* THE ONLY FUNCTION TO EDIT PL_op_mask ITSELF */ char *bitmask; STRLEN len; int myopcode = 0; + dMY_CXT; verify_opset(aTHX_ opset,1); /* croaks on bad opset */ @@ -204,6 +227,8 @@ static void 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 @@ -225,11 +250,14 @@ MODULE = Opcode PACKAGE = Opcode 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) @@ -308,7 +336,9 @@ invert_opset(opset) 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) @@ -330,6 +360,8 @@ PPCODE: 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]; @@ -348,6 +380,8 @@ CODE: 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++) { @@ -382,6 +416,7 @@ CODE: 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"); @@ -416,6 +451,8 @@ PPCODE: 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*)))); @@ -453,6 +490,7 @@ define_optag(optagsv, mask) CODE: STRLEN len; char *optag = SvPV(optagsv, len); + put_op_bitspec(aTHX_ optag, len, mask); /* croaks */ ST(0) = &PL_sv_yes; @@ -465,6 +503,7 @@ CODE: void full_opset() CODE: + dMY_CXT; ST(0) = sv_2mortal(new_opset(aTHX_ opset_all)); void diff --git a/ext/re/re.xs b/ext/re/re.xs index faab0b3..55f0f75 100644 --- a/ext/re/re.xs +++ b/ext/re/re.xs @@ -17,42 +17,58 @@ extern char* my_re_intuit_start (pTHX_ regexp *prog, SV *sv, char *strpos, 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); diff --git a/perl.h b/perl.h index 2959df4..659d8b6 100644 --- a/perl.h +++ b/perl.h @@ -3776,6 +3776,83 @@ typedef struct am_table_short AMTS; # 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 #endif