(Retracted by #11289.)
Jarkko Hietaniemi [Thu, 12 Jul 2001 04:16:41 +0000 (04:16 +0000)]
p4raw-id: //depot/perl@11289

embed.h
embed.pl
perl.c
proto.h
thread.h

diff --git a/embed.h b/embed.h
index cb9eb6c..ded9dc1 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -73,6 +73,8 @@
 #define append_list            Perl_append_list
 #define apply                  Perl_apply
 #define apply_attrs_string     Perl_apply_attrs_string
+#define atfork_lock            Perl_atfork_lock
+#define atfork_unlock          Perl_atfork_unlock
 #define avhv_delete_ent                Perl_avhv_delete_ent
 #define avhv_exists_ent                Perl_avhv_exists_ent
 #define avhv_fetch_ent         Perl_avhv_fetch_ent
 #define append_list(a,b,c)     Perl_append_list(aTHX_ a,b,c)
 #define apply(a,b,c)           Perl_apply(aTHX_ a,b,c)
 #define apply_attrs_string(a,b,c,d)    Perl_apply_attrs_string(aTHX_ a,b,c,d)
+#define atfork_lock(a)         Perl_atfork_lock(aTHX_ a)
+#define atfork_unlock(a)       Perl_atfork_unlock(aTHX_ a)
 #define avhv_delete_ent(a,b,c,d)       Perl_avhv_delete_ent(aTHX_ a,b,c,d)
 #define avhv_exists_ent(a,b,c) Perl_avhv_exists_ent(aTHX_ a,b,c)
 #define avhv_fetch_ent(a,b,c,d)        Perl_avhv_fetch_ent(aTHX_ a,b,c,d)
 #define apply                  Perl_apply
 #define Perl_apply_attrs_string        CPerlObj::Perl_apply_attrs_string
 #define apply_attrs_string     Perl_apply_attrs_string
+#define Perl_atfork_lock       CPerlObj::Perl_atfork_lock
+#define atfork_lock            Perl_atfork_lock
+#define Perl_atfork_unlock     CPerlObj::Perl_atfork_unlock
+#define atfork_unlock          Perl_atfork_unlock
 #define Perl_avhv_delete_ent   CPerlObj::Perl_avhv_delete_ent
 #define avhv_delete_ent                Perl_avhv_delete_ent
 #define Perl_avhv_exists_ent   CPerlObj::Perl_avhv_exists_ent
index 82ebfd2..0b61bf0 100755 (executable)
--- a/embed.pl
+++ b/embed.pl
@@ -1399,6 +1399,8 @@ p |OP*    |append_elem    |I32 optype|OP* head|OP* tail
 p      |OP*    |append_list    |I32 optype|LISTOP* first|LISTOP* last
 p      |I32    |apply          |I32 type|SV** mark|SV** sp
 Ap     |void   |apply_attrs_string|char *stashpv|CV *cv|char *attrstr|STRLEN len
+p      |void   |atfork_lock
+p      |void   |atfork_unlock
 Ap     |SV*    |avhv_delete_ent|AV *ar|SV* keysv|I32 flags|U32 hash
 Ap     |bool   |avhv_exists_ent|AV *ar|SV* keysv|U32 hash
 Ap     |SV**   |avhv_fetch_ent |AV *ar|SV* keysv|I32 lval|U32 hash
diff --git a/perl.c b/perl.c
index 25cdcd6..91caf60 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -61,7 +61,7 @@ static I32 read_e_script(pTHXo_ int idx, SV *buf_sv, int maxlen);
 
 /* this is called in parent before the fork() */
 void
-Perl_atfork_lock(void)
+Perl_atfork_lock(pTHX)
 {
     /* locks must be held in locking order (if any) */
 #ifdef MYMALLOC
@@ -72,7 +72,7 @@ Perl_atfork_lock(void)
 
 /* this is called in both parent and child after the fork() */
 void
-Perl_atfork_unlock(void)
+Perl_atfork_unlock(pTHX)
 {
     /* locks must be released in same order as in S_atfork_lock() */
 #ifdef MYMALLOC
diff --git a/proto.h b/proto.h
index 5110345..f362071 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -63,6 +63,8 @@ PERL_CALLCONV OP*     Perl_append_elem(pTHX_ I32 optype, OP* head, OP* tail);
 PERL_CALLCONV OP*      Perl_append_list(pTHX_ I32 optype, LISTOP* first, LISTOP* last);
 PERL_CALLCONV I32      Perl_apply(pTHX_ I32 type, SV** mark, SV** sp);
 PERL_CALLCONV void     Perl_apply_attrs_string(pTHX_ char *stashpv, CV *cv, char *attrstr, STRLEN len);
+PERL_CALLCONV void     Perl_atfork_lock(pTHX_ void);
+PERL_CALLCONV void     Perl_atfork_unlock(pTHX_ void);
 PERL_CALLCONV SV*      Perl_avhv_delete_ent(pTHX_ AV *ar, SV* keysv, I32 flags, U32 hash);
 PERL_CALLCONV bool     Perl_avhv_exists_ent(pTHX_ AV *ar, SV* keysv, U32 hash);
 PERL_CALLCONV SV**     Perl_avhv_fetch_ent(pTHX_ AV *ar, SV* keysv, I32 lval, U32 hash);
index a1e8fdc..f36e7a2 100644 (file)
--- a/thread.h
+++ b/thread.h
 #endif
 
 #ifndef PTHREAD_ATFORK
+typedef void(*Perl_pthread_atfork_t)(void);
 #  define PTHREAD_ATFORK(prepare,parent,child)                 \
-    pthread_atfork(prepare,parent,child)
+    pthread_atfork((Perl_pthread_atfork_t)prepare,\
+                  (Perl_pthread_atfork_t)parent,\
+                   (Perl_pthread_atfork_t)child)
 #endif
 
 #ifndef THREAD_RET_TYPE