diff options
| -rw-r--r-- | embed.h | 6 | ||||
| -rw-r--r-- | global.sym | 3 | ||||
| -rw-r--r-- | mg.c | 15 | ||||
| -rw-r--r-- | perl.c | 1 | ||||
| -rw-r--r-- | perl.h | 7 | ||||
| -rw-r--r-- | pp_ctl.c | 46 | ||||
| -rw-r--r-- | pp_hot.c | 2 | ||||
| -rw-r--r-- | proto.h | 6 | ||||
| -rw-r--r-- | run.c | 2 | ||||
| -rw-r--r-- | sv.c | 5 | ||||
| -rw-r--r-- | sv.h | 2 | ||||
| -rw-r--r-- | thread.h | 31 | ||||
| -rw-r--r-- | util.c | 37 |
13 files changed, 158 insertions, 5 deletions
@@ -172,7 +172,7 @@ #define regeol Perl_regeol #define regfold Perl_regfold #define reginput Perl_reginput -#define regkind Perl_regkind +#define regkind Perl_regkind #define reglastparen Perl_reglastparen #define regmyendp Perl_regmyendp #define regmyp_size Perl_regmyp_size @@ -251,6 +251,7 @@ #define vtbl_isa Perl_vtbl_isa #define vtbl_isaelem Perl_vtbl_isaelem #define vtbl_mglob Perl_vtbl_mglob +#define vtbl_mutex Perl_vtbl_mutex #define vtbl_pack Perl_vtbl_pack #define vtbl_packelem Perl_vtbl_packelem #define vtbl_pos Perl_vtbl_pos @@ -342,6 +343,7 @@ #define ck_subr Perl_ck_subr #define ck_svconst Perl_ck_svconst #define ck_trunc Perl_ck_trunc +#define condpair_magic Perl_condpair_magic #define convert Perl_convert #define cpytill Perl_cpytill #define croak Perl_croak @@ -446,6 +448,7 @@ #define hv_undef Perl_hv_undef #define ibcmp Perl_ibcmp #define ingroup Perl_ingroup +#define init_stacks Perl_init_stacks #define instr Perl_instr #define intuit_more Perl_intuit_more #define invert Perl_invert @@ -470,6 +473,7 @@ #define magic_gettaint Perl_magic_gettaint #define magic_getuvar Perl_magic_getuvar #define magic_len Perl_magic_len +#define magic_mutexfree Perl_magic_mutexfree #define magic_nextpack Perl_magic_nextpack #define magic_set Perl_magic_set #define magic_setamagic Perl_magic_setamagic diff --git a/global.sym b/global.sym index ea39192c79..0792dbbd01 100644 --- a/global.sym +++ b/global.sym @@ -238,6 +238,7 @@ vtbl_glob vtbl_isa vtbl_isaelem vtbl_mglob +vtbl_mutex vtbl_pack vtbl_packelem vtbl_pos @@ -332,6 +333,7 @@ ck_split ck_subr ck_svconst ck_trunc +condpair_magic convert cpytill croak @@ -461,6 +463,7 @@ magic_getpos magic_gettaint magic_getuvar magic_len +magic_mutexfree magic_nextpack magic_set magic_setamagic @@ -1340,6 +1340,21 @@ MAGIC* mg; return 0; } +#ifdef USE_THREADS +int +magic_mutexfree(sv, mg) +SV *sv; +MAGIC *mg; +{ + dTHR; + if (MgOWNER(mg)) + croak("panic: magic_mutexfree"); + MUTEX_DESTROY(MgMUTEXP(mg)); + COND_DESTROY(MgCONDP(mg)); + return 0; +} +#endif /* USE_THREADS */ + I32 whichsig(sig) char *sig; @@ -90,6 +90,7 @@ register PerlInterpreter *sv_interp; croak("panic: pthread_setspecific"); nthreads = 1; cvcache = newHV(); + thrflags = 0; #endif /* USE_THREADS */ /* Init the real globals? */ @@ -1517,6 +1517,9 @@ EXT MGVTBL vtbl_bm = {0, magic_setbm, EXT MGVTBL vtbl_uvar = {magic_getuvar, magic_setuvar, 0, 0, 0}; +#ifdef USE_THREADS +EXT MGVTBL vtbl_mutex = {0, 0, 0, 0, magic_mutexfree}; +#endif /* USE_THREADS */ #ifdef OVERLOAD EXT MGVTBL vtbl_amagic = {0, magic_setamagic, @@ -1546,6 +1549,10 @@ EXT MGVTBL vtbl_pos; EXT MGVTBL vtbl_bm; EXT MGVTBL vtbl_uvar; +#ifdef USE_THREADS +EXT MGVTBL vtbl_mutex; +#endif /* USE_THREADS */ + #ifdef OVERLOAD EXT MGVTBL vtbl_amagic; EXT MGVTBL vtbl_amagicelem; @@ -1220,9 +1220,54 @@ const void *b; return 1; } +#ifdef USE_THREADS +static void +unlock_condpair(svv) +void *svv; +{ + dTHR; + MAGIC *mg = mg_find((SV*)svv, 'm'); + + if (!mg) + croak("panic: unlock_condpair unlocking non-mutex"); + MUTEX_LOCK(MgMUTEXP(mg)); + if (MgOWNER(mg) != thr) + croak("panic: unlock_condpair unlocking mutex that we don't own"); + MgOWNER(mg) = 0; + COND_SIGNAL(MgOWNERCONDP(mg)); + MUTEX_UNLOCK(MgMUTEXP(mg)); +} +#endif /* USE_THREADS */ + PP(pp_reset) { dSP; +#ifdef USE_THREADS + dTOPss; + MAGIC *mg; + + if (MAXARG < 1) + croak("reset requires mutex argument with USE_THREADS"); + if (SvROK(sv)) { + /* + * Kludge to allow lock of real objects without requiring + * to pass in every type of argument by explicit reference. + */ + sv = SvRV(sv); + } + mg = condpair_magic(sv); + MUTEX_LOCK(MgMUTEXP(mg)); + if (MgOWNER(mg) == thr) + MUTEX_UNLOCK(MgMUTEXP(mg)); + else { + while (MgOWNER(mg)) + COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg)); + MgOWNER(mg) = thr; + MUTEX_UNLOCK(MgMUTEXP(mg)); + save_destructor(unlock_condpair, sv); + } + RETURN; +#else char *tmps; if (MAXARG < 1) @@ -1232,6 +1277,7 @@ PP(pp_reset) sv_reset(tmps, curcop->cop_stash); PUSHs(&sv_yes); RETURN; +#endif /* USE_THREADS */ } PP(pp_lineseq) @@ -1780,7 +1780,7 @@ PP(pp_entersub) #endif /* DEBUGGING */ MUTEX_UNLOCK(CvMUTEXP(cv)); /* fast sub wants neither sync nor clone */ } - else if (SvFLAGS(cv) & SVpcv_SYNC) { + else if (SvFLAGS(cv) & SVp_SYNC) { /* * It's a synchronised CV. Wait until it's free unless * we own it already (in which case we're recursing). @@ -40,6 +40,9 @@ I32 chsize _((int fd, Off_t length)); #endif OP * ck_gvconst _((OP * o)); OP * ck_retarget _((OP *o)); +#ifdef USE_THREADS +MAGIC * condpair_magic _((SV *sv)); +#endif OP* convert _((I32 optype, I32 flags, OP* o)); char* cpytill _((char* to, char* from, char* fromend, int delim, I32* retlen)); void croak _((char* pat,...)) __attribute__((format(printf,1,2),noreturn)); @@ -174,6 +177,9 @@ int magic_getpos _((SV* sv, MAGIC* mg)); int magic_gettaint _((SV* sv, MAGIC* mg)); int magic_getuvar _((SV* sv, MAGIC* mg)); U32 magic_len _((SV* sv, MAGIC* mg)); +#ifdef USE_THREADS +int magic_mutexfree _((SV* sv, MAGIC* mg)); +#endif /* USE_THREADS */ int magic_nextpack _((SV* sv, MAGIC* mg, SV* key)); int magic_set _((SV* sv, MAGIC* mg)); #ifdef OVERLOAD @@ -55,7 +55,7 @@ runops() { DEBUG_t(debop(op)); DEBUG_P(debprof(op)); #ifdef USE_THREADS - DEBUG_L(pthread_yield()); /* shake up scheduling a bit */ + DEBUG_L(YIELD()); /* shake up scheduling a bit */ #endif /* USE_THREADS */ } } while ( op = (*op->op_ppaddr)(ARGS) ); @@ -2086,6 +2086,11 @@ I32 namlen; case 'l': mg->mg_virtual = &vtbl_dbline; break; +#ifdef USE_THREADS + case 'm': + mg->mg_virtual = &vtbl_mutex; + break; +#endif /* USE_THREADS */ case 'P': mg->mg_virtual = &vtbl_pack; break; @@ -130,7 +130,7 @@ struct io { #define SVpbm_TAIL 0x20000000 #ifdef USE_THREADS -#define SVpcv_SYNC 0x10000000 /* Synchronised: 1 thread at a time */ +#define SVp_SYNC 0x10000000 /* Synchronised CV or an SV lock */ #endif /* USE_THREADS */ #ifdef OVERLOAD @@ -121,10 +121,38 @@ struct thread { pthread_mutex_t * Tthreadstart_mutexp; HV * Tcvcache; + U32 Tthrflags; }; typedef struct thread *Thread; +/* Values and macros for thrflags */ +#define THR_STATE_MASK 3 +#define THR_NORMAL 0 +#define THR_DETACHED 1 +#define THR_JOINED 2 +#define THR_DEAD 3 + +#define ThrSTATE(t) (t->Tthrflags & THR_STATE_MASK) +#define ThrSETSTATE(t, s) STMT_START { \ + (t)->Tthrflags &= ~THR_STATE_MASK; \ + (t)->Tthrflags |= (s); \ + DEBUG_L(fprintf(stderr, "thread 0x%lx set to state %d\n", \ + (unsigned long)(t), (s))); \ + } STMT_END + +typedef struct condpair { + pthread_mutex_t mutex; + pthread_cond_t owner_cond; + pthread_cond_t cond; + Thread owner; +} condpair_t; + +#define MgMUTEXP(mg) (&((condpair_t *)(mg->mg_ptr))->mutex) +#define MgOWNERCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->owner_cond) +#define MgCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->cond) +#define MgOWNER(mg) ((condpair_t *)(mg->mg_ptr))->owner + #undef stack_base #undef stack_sp #undef stack_max @@ -202,5 +230,6 @@ typedef struct thread *Thread; #define runlevel (thr->Trunlevel) #define threadstart_mutexp (thr->Tthreadstart_mutexp) -#define cvcache (thr->Tcvcache) +#define cvcache (thr->Tcvcache) +#define thrflags (thr->Tthrflags) #endif /* USE_THREADS */ @@ -1829,4 +1829,41 @@ getTHR _((void)) return (struct thread *) t; } #endif /* OLD_PTHREADS_API */ + +MAGIC * +condpair_magic(sv) +SV *sv; +{ + MAGIC *mg; + + SvUPGRADE(sv, SVt_PVMG); + mg = mg_find(sv, 'm'); + if (!mg) { + condpair_t *cp; + + New(53, cp, 1, condpair_t); + MUTEX_INIT(&cp->mutex); + COND_INIT(&cp->owner_cond); + COND_INIT(&cp->cond); + cp->owner = 0; + MUTEX_LOCK(&sv_mutex); + mg = mg_find(sv, 'm'); + if (mg) { + /* someone else beat us to initialising it */ + MUTEX_UNLOCK(&sv_mutex); + MUTEX_DESTROY(&cp->mutex); + COND_DESTROY(&cp->owner_cond); + COND_DESTROY(&cp->cond); + Safefree(cp); + } + else { + sv_magic(sv, Nullsv, 'm', 0, 0); + mg = SvMAGIC(sv); + mg->mg_ptr = (char *)cp; + mg->mg_len = sizeof(cp); + MUTEX_UNLOCK(&sv_mutex); + } + } + return mg; +} #endif /* USE_THREADS */ |