From: Malcolm Beattie Date: Thu, 5 Jun 1997 14:20:51 +0000 (+0000) Subject: More fixups for thrperl integration. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=e858de61083066071eb1526df39bdaa094032c61;p=p5sagit%2Fp5-mst-13.2.git More fixups for thrperl integration. p4raw-id: //depot/perl@27 --- diff --git a/ext/DB_File/DB_File.pm b/ext/DB_File/DB_File.pm index 2d5e744..e097046 100644 --- a/ext/DB_File/DB_File.pm +++ b/ext/DB_File/DB_File.pm @@ -1,8 +1,8 @@ # DB_File.pm -- Perl 5 interface to Berkeley DB # # written by Paul Marquess (pmarquess@bfsec.bt.co.uk) -# last modified 30th Apr 1997 -# version 1.14 +# last modified 31st May 1997 +# version 1.15 # # Copyright (c) 1995, 1996, 1997 Paul Marquess. All rights reserved. # This program is free software; you can redistribute it and/or @@ -146,7 +146,7 @@ use vars qw($VERSION @ISA @EXPORT $AUTOLOAD $DB_BTREE $DB_HASH $DB_RECNO) ; use Carp; -$VERSION = "1.14" ; +$VERSION = "1.15" ; #typedef enum { DB_BTREE, DB_HASH, DB_RECNO } DBTYPE; $DB_BTREE = new DB_File::BTREEINFO ; @@ -1666,6 +1666,10 @@ Minor changes to DB_FIle.xs and DB_File.pm Made it illegal to tie an associative array to a RECNO database and an ordinary array to a HASH or BTREE database. +=item 1.15 + +Minor changes to DB_File.xs to support multithreaded perl. + =back =head1 BUGS diff --git a/ext/DB_File/DB_File.xs b/ext/DB_File/DB_File.xs index 8d01d91..cc70b5d 100644 --- a/ext/DB_File/DB_File.xs +++ b/ext/DB_File/DB_File.xs @@ -3,8 +3,8 @@ DB_File.xs -- Perl 5 interface to Berkeley DB written by Paul Marquess (pmarquess@bfsec.bt.co.uk) - last modified 30th Apr 1997 - version 1.14 + last modified 31st May 1997 + version 1.15 All comments/suggestions/problems are welcome @@ -42,6 +42,7 @@ 1.13 - Tidied up a few casts. 1.14 - Made it illegal to tie an associative array to a RECNO database and an ordinary array to a HASH or BTREE database. + 1.15 - Minor additions to DB_File.xs to support multithreaded perl. */ @@ -134,6 +135,7 @@ btree_compare(key1, key2) const DBT * key1 ; const DBT * key2 ; { + dTHR ; dSP ; void * data1, * data2 ; int retval ; @@ -181,6 +183,7 @@ btree_prefix(key1, key2) const DBT * key1 ; const DBT * key2 ; { + dTHR ; dSP ; void * data1, * data2 ; int retval ; @@ -228,6 +231,7 @@ hash_cb(data, size) const void * data ; size_t size ; { + dTHR ; dSP ; int retval ; int count ; diff --git a/ext/Opcode/Makefile.PL b/ext/Opcode/Makefile.PL index 7fdcdf6..48a6ed8 100644 --- a/ext/Opcode/Makefile.PL +++ b/ext/Opcode/Makefile.PL @@ -3,5 +3,5 @@ WriteMakefile( NAME => 'Opcode', MAN3PODS => ' ', VERSION_FROM => 'Opcode.pm', - XS_VERSION => '1.02' + XS_VERSION => '1.03' ); diff --git a/ext/Opcode/Opcode.pm b/ext/Opcode/Opcode.pm index a35ad1b..2fe23f0 100644 --- a/ext/Opcode/Opcode.pm +++ b/ext/Opcode/Opcode.pm @@ -5,7 +5,7 @@ require 5.002; use vars qw($VERSION $XS_VERSION @ISA @EXPORT_OK); $VERSION = "1.04"; -$XS_VERSION = "1.02"; +$XS_VERSION = "1.03"; use strict; use Carp; diff --git a/ext/Opcode/Opcode.xs b/ext/Opcode/Opcode.xs index 9d4b726..8307ade 100644 --- a/ext/Opcode/Opcode.xs +++ b/ext/Opcode/Opcode.xs @@ -33,9 +33,10 @@ op_names_init() op_named_bits = newHV(); for(i=0; i < maxo; ++i) { - hv_store(op_named_bits, op_name[i],strlen(op_name[i]), - Sv=newSViv(i), 0); - SvREADONLY_on(Sv); + SV *sv; + sv = newSViv(i); + SvREADONLY_on(sv); + hv_store(op_named_bits, op_name[i], strlen(op_name[i]), sv, 0); } put_op_bitspec(":none",0, sv_2mortal(new_opset(Nullsv))); diff --git a/gv.c b/gv.c index c9f919c..50e9040 100644 --- a/gv.c +++ b/gv.c @@ -58,6 +58,7 @@ GV * gv_fetchfile(name) char *name; { + dTHR; char smallbuf[256]; char *tmpbuf; STRLEN tmplen; @@ -182,6 +183,7 @@ I32 level; basestash = gv_stashpvn(packname, packlen, TRUE); gvp = (GV**)hv_fetch(basestash, "ISA", 3, FALSE); if (gvp && (gv = *gvp) != (GV*)&sv_undef && (av = GvAV(gv))) { + dTHR; /* just for SvREFCNT_dec */ gvp = (GV**)hv_fetch(stash, "ISA", 3, TRUE); if (!gvp || !(gv = *gvp)) croak("Cannot create %s::ISA", HvNAME(stash)); @@ -231,6 +233,7 @@ I32 level; (cv = GvCV(gv)) && (CvROOT(cv) || CvXSUB(cv))) { + dTHR; /* just for SvREFCNT_inc */ if (cv = GvCV(topgv)) SvREFCNT_dec(cv); GvCV(topgv) = (CV*)SvREFCNT_inc(GvCV(gv)); diff --git a/hv.c b/hv.c index 77c3798..454ee23 100644 --- a/hv.c +++ b/hv.c @@ -557,6 +557,7 @@ U32 hash; if (SvRMAGICAL(hv)) { if (mg_find((SV*)hv,'P')) { + dTHR; /* just for SvTRUE */ sv = sv_newmortal(); keysv = sv_2mortal(newSVsv(keysv)); mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY); @@ -924,6 +925,7 @@ HV *hv; } magic_nextpack((SV*) hv,mg,key); if (SvOK(key)) { + dTHR; /* just for SvREFCNT_inc */ /* force key to stay around until next time */ HeSVKEY_set(entry, SvREFCNT_inc(key)); return entry; /* beware, hent_val is not set */ diff --git a/mg.c b/mg.c index cf2d71f..960e0c1 100644 --- a/mg.c +++ b/mg.c @@ -665,6 +665,7 @@ MAGIC* mg; if(psig_ptr[i]) sv_setsv(sv,psig_ptr[i]); else { + dTHR; /* just for SvREFCNT_inc */ Sighandler_t sigstate = rsignal_state(i); /* cache state so we don't fetch it again */ @@ -1141,6 +1142,7 @@ MAGIC* mg; targ = AvARRAY(av)[LvTARGOFF(sv)]; } if (targ && targ != &sv_undef) { + dTHR; /* just for SvREFCNT_dec */ /* somebody else defined it for us */ SvREFCNT_dec(LvTARG(sv)); LvTARG(sv) = SvREFCNT_inc(targ); @@ -1183,6 +1185,7 @@ void vivify_defelem(sv) SV* sv; { + dTHR; /* just for SvREFCNT_inc and SvREFCNT_dec*/ MAGIC* mg; SV* value; diff --git a/op.c b/op.c index 45b7400..3021154 100644 --- a/op.c +++ b/op.c @@ -2991,11 +2991,15 @@ CV *cv; { dTHR; #ifdef USE_THREADS - MUTEX_DESTROY(CvMUTEXP(cv)); - Safefree(CvMUTEXP(cv)); + if (CvMUTEXP(cv)) { + MUTEX_DESTROY(CvMUTEXP(cv)); + Safefree(CvMUTEXP(cv)); + CvMUTEXP(cv) = 0; + } if (CvCONDP(cv)) { COND_DESTROY(CvCONDP(cv)); Safefree(CvCONDP(cv)); + CvCONDP(cv) = 0; } #endif /* USE_THREADS */ @@ -3284,8 +3288,8 @@ CV* cv; if (type == OP_CONST) sv = cSVOPo->op_sv; else if (type == OP_PADSV) { - AV* pad = (AV*)(AvARRAY(CvPADLIST(cv))[1]); - sv = pad ? AvARRAY(pad)[o->op_targ] : Nullsv; + AV* padav = (AV*)(AvARRAY(CvPADLIST(cv))[1]); + sv = padav ? AvARRAY(padav)[o->op_targ] : Nullsv; if (!sv || (!SvREADONLY(sv) && SvREFCNT(sv) > 1)) return Nullsv; } @@ -4701,7 +4705,7 @@ OP *o; o2 = newUNOP(OP_REFGEN, 0, kid); o2->op_sibling = kid->op_sibling; kid->op_sibling = 0; - prev->op_sibling = o; + prev->op_sibling = o2; } break; default: goto oops; @@ -4824,7 +4828,7 @@ register OP* o; OP* pop = o->op_next->op_next; IV i; if (pop->op_type == OP_CONST && - (o = pop->op_next) && + (op = pop->op_next) && pop->op_next->op_type == OP_AELEM && !(pop->op_next->op_private & (OPpLVAL_INTRO|OPpLVAL_DEFER|OPpDEREF)) && diff --git a/perl.c b/perl.c index 4f96f28..242535a 100644 --- a/perl.c +++ b/perl.c @@ -830,24 +830,23 @@ print \" \\@INC:\\n @INC\\n\";"); main_cv = compcv = (CV*)NEWSV(1104,0); sv_upgrade((SV *)compcv, SVt_PVCV); CvUNIQUE_on(compcv); -#ifdef USE_THREADS - CvOWNER(compcv) = 0; - New(666, CvMUTEXP(compcv), 1, pthread_mutex_t); - MUTEX_INIT(CvMUTEXP(compcv)); - New(666, CvCONDP(compcv), 1, pthread_cond_t); - COND_INIT(CvCONDP(compcv)); -#endif /* USE_THREADS */ comppad = newAV(); av_push(comppad, Nullsv); curpad = AvARRAY(comppad); comppad_name = newAV(); comppad_name_fill = 0; + min_intro_pending = 0; + padix = 0; #ifdef USE_THREADS av_store(comppad_name, 0, newSVpv("@_", 2)); + curpad[0] = (SV*)newAV(); + CvOWNER(compcv) = 0; + New(666, CvMUTEXP(compcv), 1, pthread_mutex_t); + MUTEX_INIT(CvMUTEXP(compcv)); + New(666, CvCONDP(compcv), 1, pthread_cond_t); + COND_INIT(CvCONDP(compcv)); #endif /* USE_THREADS */ - min_intro_pending = 0; - padix = 0; comppadlist = newAV(); AvREAL_off(comppadlist); @@ -1333,6 +1332,7 @@ perl_eval_pv(p, croak_on_error) char* p; I32 croak_on_error; { + dTHR; dSP; SV* sv = newSVpv(p, 0); @@ -2323,6 +2323,7 @@ dARGS static void nuke_stacks() { + dTHR; Safefree(cxstack); Safefree(tmps_stack); DEBUG( { @@ -2748,6 +2749,7 @@ my_failure_exit() static void my_exit_jump() { + dTHR; register CONTEXT *cx; I32 gimme; SV **newsp; diff --git a/perly.c b/perly.c index 6bc37ff..fd161fd 100644 --- a/perly.c +++ b/perly.c @@ -1763,8 +1763,9 @@ case 55: break; case 56: #line 291 "perly.y" -{ char *name = SvPVx(((SVOP*)yyvsp[0].opval)->op_sv, na); - if (strEQ(name, "BEGIN") || strEQ(name, "END")) +{ char *name = SvPV(((SVOP*)yyvsp[0].opval)->op_sv, na); + if (strEQ(name, "BEGIN") || strEQ(name, "END") + || strEQ(name, "RESTART")) CvUNIQUE_on(compcv); yyval.opval = yyvsp[0].opval; } break; diff --git a/perly.y b/perly.y index be6fe98..be3d0c7 100644 --- a/perly.y +++ b/perly.y @@ -288,8 +288,9 @@ startformsub: /* NULL */ /* start a format subroutine scope */ { $$ = start_subparse(TRUE, 0); } ; -subname : WORD { char *name = SvPVx(((SVOP*)$1)->op_sv, na); - if (strEQ(name, "BEGIN") || strEQ(name, "END")) +subname : WORD { char *name = SvPV(((SVOP*)$1)->op_sv, na); + if (strEQ(name, "BEGIN") || strEQ(name, "END") + || strEQ(name, "RESTART")) CvUNIQUE_on(compcv); $$ = $1; } ; diff --git a/pp.c b/pp.c index af615c3..391133b 100644 --- a/pp.c +++ b/pp.c @@ -385,6 +385,7 @@ SV* sv; else if (SvPADTMP(sv)) sv = newSVsv(sv); else { + dTHR; /* just for SvREFCNT_inc */ SvTEMP_off(sv); (void)SvREFCNT_inc(sv); } @@ -1448,6 +1449,7 @@ seed() #define SEED_C3 269 #define SEED_C5 26107 + dTHR; U32 u; #ifdef VMS # include diff --git a/pp_ctl.c b/pp_ctl.c index 82c59bf..2f3b2b7 100644 --- a/pp_ctl.c +++ b/pp_ctl.c @@ -2111,6 +2111,7 @@ static OP * docatch(o) OP *o; { + dTHR; int ret; I32 oldrunlevel = runlevel; OP *oldop = op; diff --git a/run.c b/run.c index e416160..2f8d8fa 100644 --- a/run.c +++ b/run.c @@ -56,9 +56,6 @@ runops() { DEBUG_s(debstack()); DEBUG_t(debop(op)); DEBUG_P(debprof(op)); -#ifdef USE_THREADS - DEBUG_L(YIELD()); /* shake up scheduling a bit */ -#endif /* USE_THREADS */ } } while ( op = (*op->op_ppaddr)(ARGS) ); diff --git a/scope.c b/scope.c index cf58e24..50c843d 100644 --- a/scope.c +++ b/scope.c @@ -177,6 +177,7 @@ save_gp(gv, empty) GV *gv; I32 empty; { + dTHR; SSCHECK(3); SSPUSHPTR(SvREFCNT_inc(gv)); SSPUSHPTR(GvGP(gv)); @@ -276,6 +277,7 @@ void save_I16(intp) I16 *intp; { + dTHR; SSCHECK(3); SSPUSHINT(*intp); SSPUSHPTR(intp); diff --git a/sv.c b/sv.c index 1331f89..a23ac14 100644 --- a/sv.c +++ b/sv.c @@ -1270,6 +1270,7 @@ register SV *sv; if (SvPOKp(sv) && SvLEN(sv)) return asIV(sv); if (!SvROK(sv)) { + dTHR; /* just for localizing */ if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); return 0; @@ -1346,6 +1347,7 @@ register SV *sv; if (SvPOKp(sv) && SvLEN(sv)) return asUV(sv); if (!SvROK(sv)) { + dTHR; /* just for localizing */ if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); return 0; @@ -1391,6 +1393,7 @@ register SV *sv; SvUVX(sv) = asUV(sv); } else { + dTHR; /* just for localizing */ if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); return 0; @@ -1419,6 +1422,7 @@ register SV *sv; if (SvIOKp(sv)) return (double)SvIVX(sv); if (!SvROK(sv)) { + dTHR; /* just for localizing */ if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); return 0; @@ -1626,6 +1630,7 @@ STRLEN *lp; goto tokensave; } if (!SvROK(sv)) { + dTHR; /* just for localizing */ if (dowarn && !localizing && !(SvFLAGS(sv) & SVs_PADTMP)) warn(warn_uninit); *lp = 0; @@ -2410,8 +2415,10 @@ I32 namlen; if (name) if (namlen >= 0) mg->mg_ptr = savepvn(name, namlen); - else if (namlen == HEf_SVKEY) + else if (namlen == HEf_SVKEY) { + dTHR; /* just for SvREFCNT_inc */ mg->mg_ptr = (char*)SvREFCNT_inc((SV*)name); + } switch (how) { case 0: @@ -2681,6 +2688,7 @@ register SV *sv; assert(SvREFCNT(sv) == 0); if (SvOBJECT(sv)) { + dTHR; if (defstash) { /* Still have a symbol table? */ dTHR; dSP; @@ -4213,6 +4221,7 @@ sv_vcatpvfn(sv, pat, patlen, args, svargs, svmax, used_locale) I32 svmax; bool *used_locale; { + dTHR; char *p; char *q; char *patend; diff --git a/sv.h b/sv.h index f52c09d..d58aeb1 100644 --- a/sv.h +++ b/sv.h @@ -243,6 +243,11 @@ struct xpvfm { long xcv_depth; /* >= 2 indicates recursive call */ AV * xcv_padlist; CV * xcv_outside; +#ifdef USE_THREADS + pthread_mutex_t * xcv_mutexp; + pthread_cond_t * xcv_condp; /* signalled when owner leaves CV */ + struct thread * xcv_owner; /* current owner thread */ +#endif /* USE_THREADS */ U8 xcv_flags; I32 xfm_lines; diff --git a/thread.h b/thread.h index 466dea5..ac4a44f 100644 --- a/thread.h +++ b/thread.h @@ -114,7 +114,7 @@ struct thread { AV * Tstack; AV * Tmainstack; - Sigjmp_buf Ttop_env; + JMPENV * Ttop_env; I32 Trunlevel; /* XXX Sort stuff, firstgv, secongv and so on? */ diff --git a/toke.c b/toke.c index 7fddc3c..a007fa4 100644 --- a/toke.c +++ b/toke.c @@ -536,6 +536,7 @@ int kind; nextval[nexttoke].opval = o; force_next(WORD); if (kind) { + dTHR; /* just for in_eval */ o->op_private = OPpCONST_ENTERED; /* XXX see note in pp_entereval() for why we forgo typo warnings if the symbol must be introduced in an eval. diff --git a/util.c b/util.c index 5759e5a..14940ac 100644 --- a/util.c +++ b/util.c @@ -1131,6 +1131,7 @@ mess(pat, args) sv = mess_sv; sv_vsetpvfn(sv, pat, strlen(pat), args, Null(SV**), 0, Null(bool*)); if (!SvCUR(sv) || *(SvEND(sv) - 1) != '\n') { + dTHR; if (dirty) sv_catpv(sv, dgd); else {