X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=util.c;h=c5b32e342c5ade9968ef145cb7dea9a34c3c0672;hb=3de3f243803f0137ba3b3c90aff49200f1481a3d;hp=a88c25dcbd7e570b2866eb17c61011d365d1a4f4;hpb=b961a5663ff8cf4b987118f593328773ddc9819c;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/util.c b/util.c
index a88c25d..c5b32e3 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
@@ -1227,6 +1227,9 @@ Perl_vcroak(pTHX_ const char* pat, va_list *args)
 	PL_restartop = die_where(message, msglen);
 	JMPENV_JUMP(3);
     }
+    else if (!message)
+	message = SvPVx(ERRSV, msglen);
+
     {
 #ifdef USE_SFIO
 	/* SFIO can really mess with your errno */
@@ -1234,7 +1237,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 +1330,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 +1409,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 +1445,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 +1482,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 +2123,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 +2136,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 +2150,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();
@@ -2285,7 +2288,8 @@ Perl_rsignal(pTHX_ int signo, Sighandler_t handler)
     return PerlProc_signal(signo, handler);
 }
 
-static int sig_trapped;
+static int sig_trapped;	/* XXX signals are process-wide anyway, so we
+			   ignore the implications of this for threading */
 
 static
 Signal_t
@@ -2790,7 +2794,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 +2815,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 +2827,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 +3041,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 +3056,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 +3099,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 +3220,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 +3722,10 @@ Perl_getcwd_sv(pTHX_ register SV *sv)
 {
 #ifndef PERL_MICRO
 
+#ifndef INCOMPLETE_TAINTS
+    SvTAINTED_on(sv);
+#endif
+
 #ifdef HAS_GETCWD
     {
 	char buf[MAXPATHLEN];