develooper Front page | perl.perl5.porters | Postings from July 2001

[PATCH] pthread_atfork - Part 2: emulate pthread_atfork() if necessary

Thread Next
From:
Richard Soderberg
Date:
July 19, 2001 20:08
Subject:
[PATCH] pthread_atfork - Part 2: emulate pthread_atfork() if necessary
Message ID:
200107200307.UAA02295@oregonnet.com
This patch fixes fork() under ithreads on platforms without pthread_atfork;

It also changes the Perl_atfork_{lock,unlock} functions to
Perl_atfork_{prepare,parent,child} to allow for future flexibility and
provide names more common with those used by pthread_atfork.

After this patch, perl under ithreads passes all tests, including op/fork.t.

There is one possible flaw with this patch - module authors that call fork()
directly from their module won't reap the benefits of pthread_atfork().  One
solution to this would be to expose a Perl_fork() function that does as
pp_fork does now - allowing us to expose a true fork() to any module that
needs it, as well as supporting ithreads and non-pthread_atfork() platforms.

However, this will get us one giant step closer, and allow those with
ithreads and non-pthread_atfork() platforms to pass 'make test' again -
with an overall gain in functionality, as compared to ithread before the
pthread_atfork patches.

coral

--- miniperlmain.c~	Thu Jul 19 17:48:59 2001
+++ miniperlmain.c	Thu Jul 19 17:52:02 2001
@@ -49,9 +49,9 @@
     PERL_SYS_INIT3(&argc,&argv,&env);
 
 #ifdef USE_ITHREADS
-    PTHREAD_ATFORK(Perl_atfork_lock,
-                   Perl_atfork_unlock,
-                   Perl_atfork_unlock);
+    PTHREAD_ATFORK(Perl_atfork_prepare,
+                   Perl_atfork_parent,
+                   Perl_atfork_child);
 #endif
 
     if (!PL_do_undump) {
--- perl.c~	Thu Jul 19 17:49:00 2001
+++ perl.c	Thu Jul 19 17:58:14 2001
@@ -61,7 +61,7 @@
 
 /* this is called in parent before the fork() */
 void
-Perl_atfork_lock(void)
+Perl_atfork_prepare(void)
 {
     /* locks must be held in locking order (if any) */
 #ifdef MYMALLOC
@@ -70,9 +70,20 @@
     OP_REFCNT_LOCK;
 }
 
-/* this is called in both parent and child after the fork() */
+/* this is called in the parent after the fork() */
 void
-Perl_atfork_unlock(void)
+Perl_atfork_parent(void)
+{
+    /* locks must be released in same order as in S_atfork_lock() */
+#ifdef MYMALLOC
+    MUTEX_UNLOCK(&PL_malloc_mutex);
+#endif
+    OP_REFCNT_UNLOCK;
+}
+
+/* this is called in the child after the fork() */
+void
+Perl_atfork_child(void)
 {
     /* locks must be released in same order as in S_atfork_lock() */
 #ifdef MYMALLOC
--- pp_sys.c~	Thu Jul 19 17:49:00 2001
+++ pp_sys.c	Thu Jul 19 18:14:44 2001
@@ -3874,20 +3874,27 @@
     Pid_t childpid;
     GV *tmpgv;
 
-#   if defined(USE_ITHREADS) && !defined(HAS_PTHREAD_ATFORK)
-	Perl_croak(aTHX_ "No pthread_atfork() -- fork() too unsafe");
-#   endif
-
     EXTEND(SP, 1);
     PERL_FLUSHALL_FOR_CHILD;
+
+#  if !defined(HAS_PTHREAD_ATFORK)
+    Perl_atfork_prepare;
+#  endif
     childpid = fork();
-    if (childpid < 0)
-	RETSETUNDEF;
-    if (!childpid) {
+    if (childpid == 0) {
+#      if !defined(HAS_PTHREAD_ATFORK)
+	Perl_atfork_child;
+#      endif
 	/*SUPPRESS 560*/
 	if ((tmpgv = gv_fetchpv("$", TRUE, SVt_PV)))
 	    sv_setiv(GvSV(tmpgv), (IV)PerlProc_getpid());
 	hv_clear(PL_pidstatus);	/* no kids, so don't wait for 'em */
+    } else {
+#      if !defined(HAS_PTHREAD_ATFORK)
+	Perl_atfork_parent;
+#      endif
+	if (childpid < 0)
+	    RETSETUNDEF;
     }
     PUSHi(childpid);
     RETURN;
@@ -3898,9 +3905,22 @@
 
     EXTEND(SP, 1);
     PERL_FLUSHALL_FOR_CHILD;
+#  if !defined(HAS_PTHREAD_ATFORK)
+    Perl_atfork_prepare;
+#  endif
     childpid = PerlProc_fork();
-    if (childpid == -1)
-	RETSETUNDEF;
+
+    if (childpid == 0) {
+#      if !defined(HAS_PTHREAD_ATFORK)
+	Perl_atfork_child;
+#      endif
+    } else {
+#      if !defined(HAS_PTHREAD_ATFORK)
+	Perl_atfork_parent;
+#      endif
+	if (childpid < 0)
+	    RETSETUNDEF;
+    }
     PUSHi(childpid);
     RETURN;
 #  else
--- thread.h~	Thu Jul 19 17:48:59 2001
+++ thread.h	Thu Jul 19 17:51:21 2001
@@ -302,8 +302,9 @@
     } STMT_END
 #endif
 
-void Perl_atfork_lock(void);
-void Perl_atfork_unlock(void);
+void Perl_atfork_prepare(void);
+void Perl_atfork_parent(void);
+void Perl_atfork_child(void);
 
 #ifndef PTHREAD_ATFORK
 #  ifdef HAS_PTHREAD_ATFORK

Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About