Fix for ithreads/stdio build

[p5sagit/p5-mst-13.2.git] / util.c

diff --git a/util.c b/util.c
index e01e836..29935d2 100644 (file)
--- a/util.c
+++ b/util.c
@@ -26,17 +26,6 @@
 #endif
 #endif
 
-#ifdef I_VFORK
-#  include <vfork.h>
-#endif
-
-/* Put this after #includes because fork and vfork prototypes may
-   conflict.
-*/
-#ifndef HAS_VFORK
-#   define vfork fork
-#endif
-
 #ifdef I_SYS_WAIT
 #  include <sys/wait.h>
 #endif
@@ -1065,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
@@ -1245,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;
@@ -1338,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]=='!'
@@ -1417,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;
@@ -1453,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();
@@ -1490,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]=='!'
@@ -1858,7 +1847,7 @@ Perl_my_popen_list(pTHX_ char *mode, int n, SV **args)
     /* Try for another pipe pair for error return */
     if (PerlProc_pipe(pp) >= 0)
        did_pipes = 1;
-    while ((pid = vfork()) < 0) {
+    while ((pid = PerlProc_fork()) < 0) {
        if (errno != EAGAIN) {
            PerlLIO_close(p[This]);
            if (did_pipes) {
@@ -1910,7 +1899,7 @@ Perl_my_popen_list(pTHX_ char *mode, int n, SV **args)
 #undef THAT
     }
     /* Parent */
-    do_execfree();     /* free any memory malloced by child on vfork */
+    do_execfree();     /* free any memory malloced by child on fork */
     /* Close child's end of pipe */
     PerlLIO_close(p[that]);
     if (did_pipes)
@@ -1991,7 +1980,7 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
        return Nullfp;
     if (doexec && PerlProc_pipe(pp) >= 0)
        did_pipes = 1;
-    while ((pid = (doexec?vfork():fork())) < 0) {
+    while ((pid = PerlProc_fork()) < 0) {
        if (errno != EAGAIN) {
            PerlLIO_close(p[This]);
            if (did_pipes) {
@@ -2052,7 +2041,7 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
 #undef THIS
 #undef THAT
     }
-    do_execfree();     /* free any memory malloced by child on vfork */
+    do_execfree();     /* free any memory malloced by child on fork */
     PerlLIO_close(p[that]);
     if (did_pipes)
        PerlLIO_close(pp[1]);
@@ -2127,6 +2116,54 @@ Perl_my_popen(pTHX_ char *cmd, char *mode)
 
 #endif /* !DOSISH */
 
+/* this is called in parent before the fork() */
+void
+Perl_atfork_lock(void)
+{
+#if defined(USE_5005THREADS) || defined(USE_ITHREADS)
+    /* locks must be held in locking order (if any) */
+#  ifdef MYMALLOC
+    MUTEX_LOCK(&PL_malloc_mutex);
+#  endif
+    OP_REFCNT_LOCK;
+#endif
+}
+
+/* this is called in both parent and child after the fork() */
+void
+Perl_atfork_unlock(void)
+{
+#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);
+#  endif
+    OP_REFCNT_UNLOCK;
+#endif
+}
+
+Pid_t
+Perl_my_fork(void)
+{
+#if defined(HAS_FORK)
+    Pid_t pid;
+#if (defined(USE_5005THREADS) || defined(USE_ITHREADS)) && !defined(HAS_PTHREAD_ATFORK)
+    atfork_lock();
+    pid = fork();
+    atfork_unlock();
+#else
+    /* atfork_lock() and atfork_unlock() are installed as pthread_atfork()
+     * handlers elsewhere in the code */
+    pid = fork();
+#endif
+    return pid;
+#else
+    /* this "canna happen" since nothing should be calling here if !HAS_FORK */
+    Perl_croak_nocontext("fork() not available");
+    return 0;
+#endif /* HAS_FORK */
+}
+
 #ifdef DUMP_FDS
 void
 Perl_dump_fds(pTHX_ char *s)
@@ -2753,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))
@@ -2774,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
@@ -2786,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 */
@@ -3000,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);
 
@@ -3013,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);
@@ -3057,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 *
@@ -3178,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;
@@ -3680,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];