diff options
| -rw-r--r-- | embed.h | 2 | ||||
| -rw-r--r-- | ext/Thread/Thread.xs | 14 | ||||
| -rw-r--r-- | global.sym | 2 | ||||
| -rw-r--r-- | gv.c | 2 | ||||
| -rw-r--r-- | op.c | 2 | ||||
| -rw-r--r-- | perl.c | 62 | ||||
| -rw-r--r-- | pp_ctl.c | 2 | ||||
| -rw-r--r-- | pp_hot.c | 4 | ||||
| -rw-r--r-- | proto.h | 2 | ||||
| -rw-r--r-- | sv.h | 6 | ||||
| -rw-r--r-- | thread.h | 8 | ||||
| -rw-r--r-- | toke.c | 2 | ||||
| -rw-r--r-- | util.c | 154 |
13 files changed, 156 insertions, 106 deletions
@@ -289,8 +289,6 @@ #define invert Perl_invert #define io_close Perl_io_close #define jmaybe Perl_jmaybe -#define key_create Perl_key_create -#define key_destroy Perl_key_destroy #define keyword Perl_keyword #define know_next Perl_know_next #define last_lop Perl_last_lop diff --git a/ext/Thread/Thread.xs b/ext/Thread/Thread.xs index 1ef3ebc6fc..9c0325e07d 100644 --- a/ext/Thread/Thread.xs +++ b/ext/Thread/Thread.xs @@ -115,6 +115,8 @@ void *arg; goto finishoff; } + CATCH_SET(TRUE); + /* Now duplicate most of perl_call_sv but with a few twists */ op = (OP*)&myop; Zero(op, 1, LOGOP); @@ -142,7 +144,7 @@ void *arg; /* removed for debug */ SvREFCNT_dec(curstack); #endif - SvREFCNT_dec(cvcache); + SvREFCNT_dec(thr->cvcache); SvREFCNT_dec(thr->magicals); SvREFCNT_dec(thr->specific); Safefree(markstack); @@ -151,6 +153,7 @@ void *arg; Safefree(retstack); Safefree(cxstack); Safefree(tmps_stack); + Safefree(ofs); MUTEX_LOCK(&thr->mutex); DEBUG_L(PerlIO_printf(PerlIO_stderr(), @@ -207,7 +210,6 @@ char *class; savethread = thr; thr = new_struct_thread(thr); - init_stacks(ARGS); SPAGAIN; DEBUG_L(PerlIO_printf(PerlIO_stderr(), "%p: newthread, tid is %u, preparing stack\n", @@ -236,7 +238,7 @@ char *class; #endif if (err) { /* Thread creation failed--clean up */ - SvREFCNT_dec(cvcache); + SvREFCNT_dec(thr->cvcache); remove_thread(thr); MUTEX_DESTROY(&thr->mutex); for (i = 0; i <= AvFILL(initargs); i++) @@ -251,7 +253,7 @@ char *class; croak("panic: sigprocmask"); #endif sv = newSViv(thr->tid); - sv_magic(sv, oursv, '~', 0, 0); + sv_magic(sv, thr->oursv, '~', 0, 0); SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE; return sv_bless(newRV_noinc(sv), gv_stashpv(class, TRUE)); } @@ -352,7 +354,7 @@ self(class) SV *sv; PPCODE: sv = newSViv(thr->tid); - sv_magic(sv, oursv, '~', 0, 0); + sv_magic(sv, thr->oursv, '~', 0, 0); SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE; PUSHs(sv_2mortal(sv_bless(newRV_noinc(sv), gv_stashpv(class, TRUE)))); @@ -479,7 +481,7 @@ list(class) do { SV *sv = (SV*)SvRV(*svp); sv_setiv(sv, t->tid); - SvMAGIC(sv)->mg_obj = SvREFCNT_inc(t->Toursv); + SvMAGIC(sv)->mg_obj = SvREFCNT_inc(t->oursv); SvMAGIC(sv)->mg_flags |= MGf_REFCOUNTED; SvMAGIC(sv)->mg_private = Thread_MAGIC_SIGNATURE; t = t->next; diff --git a/global.sym b/global.sym index 2ea71b231f..aab677c115 100644 --- a/global.sym +++ b/global.sym @@ -74,8 +74,6 @@ in_my in_my_stash inc_amg io_close -key_create -key_destroy know_next last_lop last_lop_op @@ -1112,7 +1112,7 @@ HV* stash; filled = 1; } #endif - amt.table[i]= cv ? (CV*)SvREFCNT_inc(cv) : 0; + amt.table[i]=(CV*)SvREFCNT_inc(cv); } if (filled) { AMT_AMAGIC_on(&amt); @@ -247,7 +247,7 @@ pad_findlex(char *name, PADOFFSET newoff, U32 seq, CV* startcv, I32 cx_ix) warn("Variable \"%s\" will not stay shared", name); } } - av_store(comppad, newoff, oldsv ? SvREFCNT_inc(oldsv) : 0); + av_store(comppad, newoff, SvREFCNT_inc(oldsv)); return newoff; } } @@ -69,6 +69,9 @@ static void init_ids _((void)); static void init_debugger _((void)); static void init_lexer _((void)); static void init_main_stash _((void)); +#ifdef USE_THREADS +static struct thread * init_main_thread _((void)); +#endif /* USE_THREADS */ static void init_perllib _((void)); static void init_postdump_symbols _((int, char **, char **)); static void init_predump_symbols _((void)); @@ -139,7 +142,7 @@ register PerlInterpreter *sv_interp; MUTEX_INIT(&threads_mutex); COND_INIT(&nthreads_cond); - thr = new_struct_thread(0); + thr = init_main_thread(); #endif /* USE_THREADS */ linestr = NEWSV(65,80); @@ -2825,6 +2828,63 @@ int addsubdirs; SvREFCNT_dec(subdir); } +#ifdef USE_THREADS +static struct thread * +init_main_thread() +{ + struct thread *thr; + XPV *xpv; + + Newz(53, thr, 1, struct thread); + curcop = &compiling; + thr->cvcache = newHV(); + thr->magicals = newAV(); + thr->specific = newAV(); + thr->flags = THRf_R_JOINABLE; + MUTEX_INIT(&thr->mutex); + /* Handcraft thrsv similarly to mess_sv */ + New(53, thrsv, 1, SV); + Newz(53, xpv, 1, XPV); + SvFLAGS(thrsv) = SVt_PV; + SvANY(thrsv) = (void*)xpv; + SvREFCNT(thrsv) = 1 << 30; /* practically infinite */ + SvPVX(thrsv) = (char*)thr; + SvCUR_set(thrsv, sizeof(thr)); + SvLEN_set(thrsv, sizeof(thr)); + *SvEND(thrsv) = '\0'; /* in the trailing_nul field */ + thr->oursv = thrsv; + curcop = &compiling; + chopset = " \n-"; + + MUTEX_LOCK(&threads_mutex); + nthreads++; + thr->tid = 0; + thr->next = thr; + thr->prev = thr; + MUTEX_UNLOCK(&threads_mutex); + +#ifdef HAVE_THREAD_INTERN + init_thread_intern(thr); +#else + thr->self = pthread_self(); +#endif /* HAVE_THREAD_INTERN */ + SET_THR(thr); + + /* + * These must come after the SET_THR because sv_setpvn does + * SvTAINT and the taint fields require dTHR. + */ + toptarget = NEWSV(0,0); + sv_upgrade(toptarget, SVt_PVFM); + sv_setpvn(toptarget, "", 0); + bodytarget = NEWSV(0,0); + sv_upgrade(bodytarget, SVt_PVFM); + sv_setpvn(bodytarget, "", 0); + formtarget = bodytarget; + return thr; +} +#endif /* USE_THREADS */ + void call_list(oldscope, list) I32 oldscope; @@ -2186,7 +2186,7 @@ int gimme; CvPADLIST(compcv) = comppadlist; if (saveop->op_type != OP_REQUIRE) - CvOUTSIDE(compcv) = caller ? (CV*)SvREFCNT_inc(caller) : 0; + CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc(caller); SAVEFREESV(compcv); @@ -1901,7 +1901,7 @@ PP(pp_entersub) * (3) instead of (2) so we'd have to clone. Would the fact * that we released the mutex more quickly make up for this? */ - svp = hv_fetch(cvcache, (char *)cv, sizeof(cv), FALSE); + svp = hv_fetch(thr->cvcache, (char *)cv, sizeof(cv), FALSE); if (svp) { /* We already have a clone to use */ MUTEX_UNLOCK(CvMUTEXP(cv)); @@ -1941,7 +1941,7 @@ PP(pp_entersub) */ clonecv = cv_clone(cv); SvREFCNT_dec(cv); /* finished with this */ - hv_store(cvcache, (char*)cv, sizeof(cv), (SV*)clonecv,0); + hv_store(thr->cvcache, (char*)cv, sizeof(cv), (SV*)clonecv,0); CvOWNER(clonecv) = thr; cv = clonecv; SvREFCNT_inc(cv); @@ -190,8 +190,6 @@ bool io_close _((IO* io)); OP* invert _((OP* cmd)); OP* jmaybe _((OP* arg)); I32 keyword _((char* d, I32 len)); -PADOFFSET key_create _((void)); -void key_destroy _((PADOFFSET key)); void leave_scope _((I32 base)); void lex_end _((void)); void lex_start _((SV* line)); @@ -73,12 +73,12 @@ struct io { #define SvREFCNT(sv) (sv)->sv_refcnt #ifdef __GNUC__ -# define SvREFCNT_inc(sv) ({SV *nsv = (SV*)(sv); ++SvREFCNT(nsv); nsv;}) +# define SvREFCNT_inc(sv) ({SV* nsv=(SV*)(sv); if(nsv) ++SvREFCNT(nsv); nsv;}) #else # if defined(CRIPPLED_CC) || defined(USE_THREADS) -# define SvREFCNT_inc(sv) sv_newref((SV*)sv) +# define SvREFCNT_inc(sv) sv_newref((SV*)sv) # else -# define SvREFCNT_inc(sv) ((Sv = (SV*)(sv)), ++SvREFCNT(Sv), (SV*)Sv) +# define SvREFCNT_inc(sv) ((Sv=(SV*)(sv)), (Sv && ++SvREFCNT(Sv)), (SV*)Sv) # endif #endif @@ -213,8 +213,8 @@ struct thread { /* XXX Sort stuff, firstgv, secongv and so on? */ - SV * Toursv; - HV * Tcvcache; + SV * oursv; + HV * cvcache; perl_thread self; /* Underlying thread object */ U32 flags; AV * magicals; /* Per-thread magicals */ @@ -226,7 +226,7 @@ struct thread { #ifdef ADD_THREAD_INTERN struct thread_intern i; /* Platform-dependent internals */ #endif - char trailing_nul; /* For the sake of thrsv, t->Toursv */ + char trailing_nul; /* For the sake of thrsv and oursv */ }; typedef struct thread *Thread; @@ -314,7 +314,6 @@ typedef struct condpair { #undef dirty #undef localizing -#define oursv (thr->Toursv) #define stack_base (thr->Tstack_base) #define stack_sp (thr->Tstack_sp) #define stack_max (thr->Tstack_max) @@ -381,7 +380,6 @@ typedef struct condpair { #define top_env (thr->Ttop_env) #define runlevel (thr->Trunlevel) -#define cvcache (thr->Tcvcache) #else /* USE_THREADS is not defined */ #define MUTEX_LOCK(m) @@ -5346,7 +5346,7 @@ U32 flags; av_store(comppadlist, 1, (SV*)comppad); CvPADLIST(compcv) = comppadlist; - CvOUTSIDE(compcv) = outsidecv ? (CV*)SvREFCNT_inc(outsidecv) : 0; + CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc(outsidecv); #ifdef USE_THREADS CvOWNER(compcv) = 0; New(666, CvMUTEXP(compcv), 1, perl_mutex); @@ -1176,8 +1176,9 @@ die(pat, va_alist) GV *gv; CV *cv; - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "die: curstack = %p, mainstack= %p\n", - curstack, mainstack));/*debug*/ + DEBUG_L(PerlIO_printf(PerlIO_stderr(), + "%p: die: curstack = %p, mainstack = %p\n", + thr, curstack, mainstack)); /* We have to switch back to mainstack or die_where may try to pop * the eval block from the wrong stack if die is being called from a * signal handler. - dkindred@cs.cmu.edu */ @@ -1194,8 +1195,9 @@ die(pat, va_alist) message = mess(pat, &args); va_end(args); - DEBUG_L(PerlIO_printf(PerlIO_stderr(), "die: message = %s\ndiehook = %p\n", - message, diehook));/*debug*/ + DEBUG_L(PerlIO_printf(PerlIO_stderr(), + "%p: die: message = %s\ndiehook = %p\n", + thr, message, diehook)); if (diehook) { /* sv_2cv might call croak() */ SV *olddiehook = diehook; @@ -1224,8 +1226,8 @@ die(pat, va_alist) restartop = die_where(message); DEBUG_L(PerlIO_printf(PerlIO_stderr(), - "die: restartop = %p, was_in_eval = %d, oldrunlevel = %d\n", - restartop, was_in_eval, oldrunlevel));/*debug*/ + "%p: die: restartop = %p, was_in_eval = %d, oldrunlevel = %d\n", + thr, restartop, was_in_eval, oldrunlevel)); if ((!restartop && was_in_eval) || oldrunlevel > 1) JMPENV_JUMP(3); return restartop; @@ -2484,80 +2486,88 @@ SV *sv; } /* - * Make a new perl thread structure using t as a prototype. If t is NULL - * then this is the initial main thread and we have to bootstrap carefully. - * Some of the fields for the new thread are copied from the prototype - * thread, t, so t should not be running in perl at the time this function - * is called. The usual case, where t is the thread calling new_struct_thread, - * clearly satisfies this constraint. + * Make a new perl thread structure using t as a prototype. Some of the + * fields for the new thread are copied from the prototype thread, t, + * so t should not be running in perl at the time this function is + * called. The use by ext/Thread/Thread.xs in core perl (where t is the + * thread calling new_struct_thread) clearly satisfies this constraint. */ struct thread * new_struct_thread(t) struct thread *t; { struct thread *thr; - XPV *xpv; SV *sv; + SV **svp; + I32 i; + + sv = newSVpv("", 0); + SvGROW(sv, sizeof(struct thread) + 1); + SvCUR_set(sv, sizeof(struct thread)); + thr = (Thread) SvPVX(sv); + /* Zero(thr, 1, struct thread); */ + + /* debug */ + memset(thr, 0xab, sizeof(struct thread)); + markstack = 0; + scopestack = 0; + savestack = 0; + retstack = 0; + dirty = 0; + localizing = 0; + /* end debug */ + + thr->oursv = sv; + init_stacks(thr); - Newz(53, thr, 1, struct thread); - cvcache = newHV(); curcop = &compiling; + thr->cvcache = newHV(); thr->magicals = newAV(); thr->specific = newAV(); thr->flags = THRf_R_JOINABLE; MUTEX_INIT(&thr->mutex); - if (t) { - oursv = newSVpv("", 0); - SvGROW(oursv, sizeof(struct thread) + 1); - SvCUR_set(oursv, sizeof(struct thread)); - thr = (struct thread *) SvPVX(sv); - } else { - /* Handcraft thrsv similarly to mess_sv */ - New(53, thrsv, 1, SV); - Newz(53, xpv, 1, XPV); - SvFLAGS(thrsv) = SVt_PV; - SvANY(thrsv) = (void*)xpv; - SvREFCNT(thrsv) = 1 << 30; /* practically infinite */ - SvPVX(thrsv) = (char*)thr; - SvCUR_set(thrsv, sizeof(thr)); - SvLEN_set(thrsv, sizeof(thr)); - *SvEND(thrsv) = '\0'; /* in the trailing_nul field */ - oursv = thrsv; - } - if (t) { - curcop = t->Tcurcop; /* XXX As good a guess as any? */ - defstash = t->Tdefstash; /* XXX maybe these should */ - curstash = t->Tcurstash; /* always be set to main? */ - /* top_env? */ - /* runlevel */ - tainted = t->Ttainted; - curpm = t->Tcurpm; /* XXX No PMOP ref count */ - nrs = newSVsv(t->Tnrs); - rs = newSVsv(t->Trs); - last_in_gv = (GV*)SvREFCNT_inc(t->Tlast_in_gv); - ofslen = t->Tofslen; - ofs = savepvn(t->Tofs, ofslen); - defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv); - chopset = t->Tchopset; - formtarget = newSVsv(t->Tformtarget); - bodytarget = newSVsv(t->Tbodytarget); - toptarget = newSVsv(t->Ttoptarget); - } else { - curcop = &compiling; - chopset = " \n-"; - } + + curcop = t->Tcurcop; /* XXX As good a guess as any? */ + defstash = t->Tdefstash; /* XXX maybe these should */ + curstash = t->Tcurstash; /* always be set to main? */ + /* top_env needs to be non-zero. The particular value doesn't matter */ + top_env = t->Ttop_env; + runlevel = 1; /* XXX should be safe ? */ + in_eval = FALSE; + restartop = 0; + + tainted = t->Ttainted; + curpm = t->Tcurpm; /* XXX No PMOP ref count */ + nrs = newSVsv(t->Tnrs); + rs = newSVsv(t->Trs); + last_in_gv = (GV*)SvREFCNT_inc(t->Tlast_in_gv); + ofslen = t->Tofslen; + ofs = savepvn(t->Tofs, ofslen); + defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv); + chopset = t->Tchopset; + formtarget = newSVsv(t->Tformtarget); + bodytarget = newSVsv(t->Tbodytarget); + toptarget = newSVsv(t->Ttoptarget); + + /* Initialise all per-thread magicals that the template thread used */ + svp = AvARRAY(t->magicals); + for (i = 0; i <= AvFILL(t->magicals); i++, svp++) { + if (*svp && *svp != &sv_undef) { + SV *sv = newSVsv(*svp); + av_store(thr->magicals, i, sv); + sv_magic(sv, 0, 0, &per_thread_magicals[i], 1); + DEBUG_L(PerlIO_printf(PerlIO_stderr(), + "new_struct_thread: copied magical %d\n",i)); + } + } + MUTEX_LOCK(&threads_mutex); nthreads++; - thr->tid = threadnum++; - if (t) { - thr->next = t->next; - thr->prev = t; - t->next = thr; - thr->next->prev = thr; - } else { - thr->next = thr; - thr->prev = thr; - } + thr->tid = ++threadnum; + thr->next = t->next; + thr->prev = t; + t->next = thr; + thr->next->prev = thr; MUTEX_UNLOCK(&threads_mutex); #ifdef HAVE_THREAD_INTERN @@ -2565,20 +2575,6 @@ struct thread *t; #else thr->self = pthread_self(); #endif /* HAVE_THREAD_INTERN */ - SET_THR(thr); - if (!t) { - /* - * These must come after the SET_THR because sv_setpvn does - * SvTAINT and the taint fields require dTHR. - */ - toptarget = NEWSV(0,0); - sv_upgrade(toptarget, SVt_PVFM); - sv_setpvn(toptarget, "", 0); - bodytarget = NEWSV(0,0); - sv_upgrade(bodytarget, SVt_PVFM); - sv_setpvn(bodytarget, "", 0); - formtarget = bodytarget; - } return thr; } #endif /* USE_THREADS */ |