X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=util.c;h=29935d2dad60b1c5cbd7c88d4d0927d800f736cd;hb=79af22e4562a90bdaa3aa9d22a11a3fa41f9c6bc;hp=a88c25dcbd7e570b2866eb17c61011d365d1a4f4;hpb=b961a5663ff8cf4b987118f593328773ddc9819c;p=p5sagit%2Fp5-mst-13.2.git diff --git a/util.c b/util.c index a88c25d..29935d2 100644 --- a/util.c +++ b/util.c @@ -1054,7 +1054,7 @@ Perl_vmess(pTHX_ const char *pat, va_list *args) line_mode ? "line" : "chunk", (IV)IoLINES(GvIOp(PL_last_in_gv))); } -#ifdef USE_THREADS +#ifdef USE_5005THREADS if (thr->tid) Perl_sv_catpvf(aTHX_ sv, " thread %ld", thr->tid); #endif @@ -1234,7 +1234,7 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args) #endif PerlIO *serr = Perl_error_log; - PerlIO_write(serr, message, msglen); + PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen); (void)PerlIO_flush(serr); #ifdef USE_SFIO errno = e; @@ -1327,7 +1327,7 @@ Perl_vwarn(pTHX_ const char* pat, va_list *args) { PerlIO *serr = Perl_error_log; - PerlIO_write(serr, message, msglen); + PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen); #ifdef LEAKTEST DEBUG_L(*message == '!' ? (xstat(message[1]=='!' @@ -1406,9 +1406,9 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) message = SvPV(msv, msglen); if (ckDEAD(err)) { -#ifdef USE_THREADS +#ifdef USE_5005THREADS DEBUG_S(PerlIO_printf(Perl_debug_log, "croak: 0x%"UVxf" %s", PTR2UV(thr), message)); -#endif /* USE_THREADS */ +#endif /* USE_5005THREADS */ if (PL_diehook) { /* sv_2cv might call Perl_croak() */ SV *olddiehook = PL_diehook; @@ -1442,7 +1442,7 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) } { PerlIO *serr = Perl_error_log; - PerlIO_write(serr, message, msglen); + PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen); (void)PerlIO_flush(serr); } my_failure_exit(); @@ -1479,7 +1479,7 @@ Perl_vwarner(pTHX_ U32 err, const char* pat, va_list* args) } { PerlIO *serr = Perl_error_log; - PerlIO_write(serr, message, msglen); + PERL_WRITE_MSG_TO_CONSOLE(serr, message, msglen); #ifdef LEAKTEST DEBUG_L(*message == '!' ? (xstat(message[1]=='!' @@ -2120,7 +2120,7 @@ Perl_my_popen(pTHX_ char *cmd, char *mode) void Perl_atfork_lock(void) { -#if defined(USE_THREADS) || defined(USE_ITHREADS) +#if defined(USE_5005THREADS) || defined(USE_ITHREADS) /* locks must be held in locking order (if any) */ # ifdef MYMALLOC MUTEX_LOCK(&PL_malloc_mutex); @@ -2133,7 +2133,7 @@ Perl_atfork_lock(void) void Perl_atfork_unlock(void) { -#if defined(USE_THREADS) || defined(USE_ITHREADS) +#if defined(USE_5005THREADS) || defined(USE_ITHREADS) /* locks must be released in same order as in atfork_lock() */ # ifdef MYMALLOC MUTEX_UNLOCK(&PL_malloc_mutex); @@ -2147,7 +2147,7 @@ Perl_my_fork(void) { #if defined(HAS_FORK) Pid_t pid; -#if (defined(USE_THREADS) || defined(USE_ITHREADS)) && !defined(HAS_PTHREAD_ATFORK) +#if (defined(USE_5005THREADS) || defined(USE_ITHREADS)) && !defined(HAS_PTHREAD_ATFORK) atfork_lock(); pid = fork(); atfork_unlock(); @@ -2790,7 +2790,7 @@ Perl_find_script(pTHX_ char *scriptname, bool dosearch, char **search_ext, I32 f void * Perl_get_context(void) { -#if defined(USE_THREADS) || defined(USE_ITHREADS) +#if defined(USE_5005THREADS) || defined(USE_ITHREADS) # ifdef OLD_PTHREADS_API pthread_addr_t t; if (pthread_getspecific(PL_thr_key, &t)) @@ -2811,7 +2811,7 @@ Perl_get_context(void) void Perl_set_context(void *t) { -#if defined(USE_THREADS) || defined(USE_ITHREADS) +#if defined(USE_5005THREADS) || defined(USE_ITHREADS) # ifdef I_MACH_CTHREADS cthread_set_data(cthread_self(), t); # else @@ -2823,7 +2823,7 @@ Perl_set_context(void *t) #endif /* !PERL_GET_CONTEXT_DEFINED */ -#ifdef USE_THREADS +#ifdef USE_5005THREADS #ifdef FAKE_THREADS /* Very simplistic scheduler for now */ @@ -3037,6 +3037,8 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t) PL_reg_start_tmpl = 0; PL_reg_poscache = Nullch; + PL_peepp = MEMBER_TO_FPTR(Perl_peep); + /* parent thread's data needs to be locked while we make copy */ MUTEX_LOCK(&t->mutex); @@ -3050,8 +3052,7 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t) PL_tainted = t->Ttainted; PL_curpm = t->Tcurpm; /* XXX No PMOP ref count */ - PL_nrs = newSVsv(t->Tnrs); - PL_rs = t->Tnrs ? SvREFCNT_inc(PL_nrs) : Nullsv; + PL_rs = newSVsv(t->Trs); PL_last_in_gv = Nullgv; PL_ofs_sv = t->Tofs_sv ? SvREFCNT_inc(PL_ofs_sv) : Nullsv; PL_defoutgv = (GV*)SvREFCNT_inc(t->Tdefoutgv); @@ -3094,7 +3095,7 @@ Perl_new_struct_thread(pTHX_ struct perl_thread *t) #endif /* HAVE_THREAD_INTERN */ return thr; } -#endif /* USE_THREADS */ +#endif /* USE_5005THREADS */ #ifdef PERL_GLOBAL_STRUCT struct perl_vars * @@ -3215,7 +3216,7 @@ Perl_get_vtbl(pTHX_ int vtbl_id) case want_vtbl_uvar: result = &PL_vtbl_uvar; break; -#ifdef USE_THREADS +#ifdef USE_5005THREADS case want_vtbl_mutex: result = &PL_vtbl_mutex; break; @@ -3717,6 +3718,10 @@ Perl_getcwd_sv(pTHX_ register SV *sv) { #ifndef PERL_MICRO +#ifndef INCOMPLETE_TAINTS + SvTAINTED_on(sv); +#endif + #ifdef HAS_GETCWD { char buf[MAXPATHLEN];