From: Malcolm Beattie <mbeattie@sable.ox.ac.uk>
Date: Wed, 23 Apr 1997 19:06:45 +0000 (+0000)
Subject: Added programmer-level condition variables via "condpair" magic.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f93b4edd807be1c6102dad09f884828c27c4a58b;p=p5sagit%2Fp5-mst-13.2.git

Added programmer-level condition variables via "condpair" magic.
Added support for detached threads and tweaked a few things.

p4raw-id: //depot/thrperl@8
---

diff --git a/embed.h b/embed.h
index bfd73bd..61dddbf 100644
--- a/embed.h
+++ b/embed.h
@@ -172,7 +172,7 @@
 #define regeol		Perl_regeol
 #define regfold		Perl_regfold
 #define reginput	Perl_reginput
-#define regkind	Perl_regkind
+#define regkind		Perl_regkind
 #define reglastparen	Perl_reglastparen
 #define regmyendp	Perl_regmyendp
 #define regmyp_size	Perl_regmyp_size
@@ -251,6 +251,7 @@
 #define vtbl_isa	Perl_vtbl_isa
 #define vtbl_isaelem	Perl_vtbl_isaelem
 #define vtbl_mglob	Perl_vtbl_mglob
+#define vtbl_mutex	Perl_vtbl_mutex
 #define vtbl_pack	Perl_vtbl_pack
 #define vtbl_packelem	Perl_vtbl_packelem
 #define vtbl_pos	Perl_vtbl_pos
@@ -342,6 +343,7 @@
 #define ck_subr		Perl_ck_subr
 #define ck_svconst	Perl_ck_svconst
 #define ck_trunc	Perl_ck_trunc
+#define condpair_magic	Perl_condpair_magic
 #define convert		Perl_convert
 #define cpytill		Perl_cpytill
 #define croak		Perl_croak
@@ -446,6 +448,7 @@
 #define hv_undef	Perl_hv_undef
 #define ibcmp		Perl_ibcmp
 #define ingroup		Perl_ingroup
+#define init_stacks	Perl_init_stacks
 #define instr		Perl_instr
 #define intuit_more	Perl_intuit_more
 #define invert		Perl_invert
@@ -470,6 +473,7 @@
 #define magic_gettaint	Perl_magic_gettaint
 #define magic_getuvar	Perl_magic_getuvar
 #define magic_len	Perl_magic_len
+#define magic_mutexfree	Perl_magic_mutexfree
 #define magic_nextpack	Perl_magic_nextpack
 #define magic_set	Perl_magic_set
 #define magic_setamagic	Perl_magic_setamagic
diff --git a/global.sym b/global.sym
index ea39192..0792dbb 100644
--- a/global.sym
+++ b/global.sym
@@ -238,6 +238,7 @@ vtbl_glob
 vtbl_isa
 vtbl_isaelem
 vtbl_mglob
+vtbl_mutex
 vtbl_pack
 vtbl_packelem
 vtbl_pos
@@ -332,6 +333,7 @@ ck_split
 ck_subr
 ck_svconst
 ck_trunc
+condpair_magic
 convert
 cpytill
 croak
@@ -461,6 +463,7 @@ magic_getpos
 magic_gettaint
 magic_getuvar
 magic_len
+magic_mutexfree
 magic_nextpack
 magic_set
 magic_setamagic
diff --git a/mg.c b/mg.c
index a395cc2..30ef4a6 100644
--- a/mg.c
+++ b/mg.c
@@ -1340,6 +1340,21 @@ MAGIC* mg;
     return 0;
 }
 
+#ifdef USE_THREADS
+int
+magic_mutexfree(sv, mg)
+SV *sv;
+MAGIC *mg;
+{
+    dTHR;
+    if (MgOWNER(mg))
+	croak("panic: magic_mutexfree");
+    MUTEX_DESTROY(MgMUTEXP(mg));
+    COND_DESTROY(MgCONDP(mg));
+    return 0;
+}
+#endif /* USE_THREADS */
+
 I32
 whichsig(sig)
 char *sig;
diff --git a/perl.c b/perl.c
index f3c14c9..27d2f61 100644
--- a/perl.c
+++ b/perl.c
@@ -90,6 +90,7 @@ register PerlInterpreter *sv_interp;
 	croak("panic: pthread_setspecific");
     nthreads = 1;
     cvcache = newHV();
+    thrflags = 0;
 #endif /* USE_THREADS */
 
     /* Init the real globals? */
diff --git a/perl.h b/perl.h
index 97971f9..3095a91 100644
--- a/perl.h
+++ b/perl.h
@@ -1517,6 +1517,9 @@ EXT MGVTBL vtbl_bm =	{0,	magic_setbm,
 EXT MGVTBL vtbl_uvar =	{magic_getuvar,
 				magic_setuvar,
 					0,	0,	0};
+#ifdef USE_THREADS
+EXT MGVTBL vtbl_mutex =	{0,	0,	0,	0,	magic_mutexfree};
+#endif /* USE_THREADS */
 
 #ifdef OVERLOAD
 EXT MGVTBL vtbl_amagic =       {0,     magic_setamagic,
@@ -1546,6 +1549,10 @@ EXT MGVTBL vtbl_pos;
 EXT MGVTBL vtbl_bm;
 EXT MGVTBL vtbl_uvar;
 
+#ifdef USE_THREADS
+EXT MGVTBL vtbl_mutex;
+#endif /* USE_THREADS */
+
 #ifdef OVERLOAD
 EXT MGVTBL vtbl_amagic;
 EXT MGVTBL vtbl_amagicelem;
diff --git a/pp_ctl.c b/pp_ctl.c
index fb64466..ee463ea 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -1220,9 +1220,54 @@ const void *b;
 	return 1;
 }
 
+#ifdef USE_THREADS
+static void
+unlock_condpair(svv)
+void *svv;
+{
+    dTHR;
+    MAGIC *mg = mg_find((SV*)svv, 'm');
+    
+    if (!mg)
+	croak("panic: unlock_condpair unlocking non-mutex");
+    MUTEX_LOCK(MgMUTEXP(mg));
+    if (MgOWNER(mg) != thr)
+	croak("panic: unlock_condpair unlocking mutex that we don't own");
+    MgOWNER(mg) = 0;
+    COND_SIGNAL(MgOWNERCONDP(mg));
+    MUTEX_UNLOCK(MgMUTEXP(mg));
+}
+#endif /* USE_THREADS */
+
 PP(pp_reset)
 {
     dSP;
+#ifdef USE_THREADS
+    dTOPss;
+    MAGIC *mg;
+    
+    if (MAXARG < 1)
+	croak("reset requires mutex argument with USE_THREADS");
+    if (SvROK(sv)) {
+	/*
+	 * Kludge to allow lock of real objects without requiring
+	 * to pass in every type of argument by explicit reference.
+	 */
+	sv = SvRV(sv);
+    }
+    mg = condpair_magic(sv);
+    MUTEX_LOCK(MgMUTEXP(mg));
+    if (MgOWNER(mg) == thr)
+	MUTEX_UNLOCK(MgMUTEXP(mg));
+    else {
+	while (MgOWNER(mg))
+	    COND_WAIT(MgOWNERCONDP(mg), MgMUTEXP(mg));
+	MgOWNER(mg) = thr;
+	MUTEX_UNLOCK(MgMUTEXP(mg));
+	save_destructor(unlock_condpair, sv);
+    }
+    RETURN;
+#else
     char *tmps;
 
     if (MAXARG < 1)
@@ -1232,6 +1277,7 @@ PP(pp_reset)
     sv_reset(tmps, curcop->cop_stash);
     PUSHs(&sv_yes);
     RETURN;
+#endif /* USE_THREADS */
 }
 
 PP(pp_lineseq)
diff --git a/pp_hot.c b/pp_hot.c
index b143ff7..2aee061 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1780,7 +1780,7 @@ PP(pp_entersub)
 #endif /* DEBUGGING */
 	MUTEX_UNLOCK(CvMUTEXP(cv)); /* fast sub wants neither sync nor clone */
     }
-    else if (SvFLAGS(cv) & SVpcv_SYNC) {
+    else if (SvFLAGS(cv) & SVp_SYNC) {
 	/*
 	 * It's a synchronised CV. Wait until it's free unless
 	 * we own it already (in which case we're recursing).
diff --git a/proto.h b/proto.h
index 4a86a34..5d62d0f 100644
--- a/proto.h
+++ b/proto.h
@@ -40,6 +40,9 @@ I32	chsize _((int fd, Off_t length));
 #endif
 OP *	ck_gvconst _((OP * o));
 OP *	ck_retarget _((OP *o));
+#ifdef USE_THREADS
+MAGIC *	condpair_magic _((SV *sv));
+#endif
 OP*	convert _((I32 optype, I32 flags, OP* o));
 char*	cpytill _((char* to, char* from, char* fromend, int delim, I32* retlen));
 void	croak _((char* pat,...)) __attribute__((format(printf,1,2),noreturn));
@@ -174,6 +177,9 @@ int	magic_getpos	_((SV* sv, MAGIC* mg));
 int	magic_gettaint	_((SV* sv, MAGIC* mg));
 int	magic_getuvar	_((SV* sv, MAGIC* mg));
 U32	magic_len	_((SV* sv, MAGIC* mg));
+#ifdef USE_THREADS
+int	magic_mutexfree	_((SV* sv, MAGIC* mg));
+#endif /* USE_THREADS */
 int	magic_nextpack	_((SV* sv, MAGIC* mg, SV* key));
 int	magic_set	_((SV* sv, MAGIC* mg));
 #ifdef OVERLOAD
diff --git a/run.c b/run.c
index dd178b9..3be9825 100644
--- a/run.c
+++ b/run.c
@@ -55,7 +55,7 @@ runops() {
 	    DEBUG_t(debop(op));
 	    DEBUG_P(debprof(op));
 #ifdef USE_THREADS
-	    DEBUG_L(pthread_yield());	/* shake up scheduling a bit */
+	    DEBUG_L(YIELD());	/* shake up scheduling a bit */
 #endif /* USE_THREADS */
 	}
     } while ( op = (*op->op_ppaddr)(ARGS) );
diff --git a/sv.c b/sv.c
index 2a25a30..52e9b26 100644
--- a/sv.c
+++ b/sv.c
@@ -2086,6 +2086,11 @@ I32 namlen;
     case 'l':
 	mg->mg_virtual = &vtbl_dbline;
 	break;
+#ifdef USE_THREADS
+    case 'm':
+	mg->mg_virtual = &vtbl_mutex;
+	break;
+#endif /* USE_THREADS */
     case 'P':
 	mg->mg_virtual = &vtbl_pack;
 	break;
diff --git a/sv.h b/sv.h
index e87bb50..90d025f 100644
--- a/sv.h
+++ b/sv.h
@@ -130,7 +130,7 @@ struct io {
 #define SVpbm_TAIL	0x20000000
 
 #ifdef USE_THREADS
-#define SVpcv_SYNC	0x10000000	/* Synchronised: 1 thread at a time */
+#define SVp_SYNC	0x10000000	/* Synchronised CV or an SV lock */
 #endif /* USE_THREADS */
 
 #ifdef OVERLOAD
diff --git a/thread.h b/thread.h
index 4d6e4f0..466dea5 100644
--- a/thread.h
+++ b/thread.h
@@ -121,10 +121,38 @@ struct thread {
 
     pthread_mutex_t *	Tthreadstart_mutexp;
     HV *	Tcvcache;
+    U32		Tthrflags;
 };
 
 typedef struct thread *Thread;
 
+/* Values and macros for thrflags */
+#define THR_STATE_MASK	3
+#define THR_NORMAL	0
+#define THR_DETACHED	1
+#define THR_JOINED	2
+#define THR_DEAD	3
+
+#define ThrSTATE(t)	(t->Tthrflags & THR_STATE_MASK)
+#define ThrSETSTATE(t, s) STMT_START {		\
+	(t)->Tthrflags &= ~THR_STATE_MASK;	\
+	(t)->Tthrflags |= (s);			\
+	DEBUG_L(fprintf(stderr, "thread 0x%lx set to state %d\n", \
+			(unsigned long)(t), (s))); \
+    } STMT_END
+
+typedef struct condpair {
+    pthread_mutex_t	mutex;
+    pthread_cond_t	owner_cond;
+    pthread_cond_t	cond;
+    Thread		owner;
+} condpair_t;
+
+#define MgMUTEXP(mg) (&((condpair_t *)(mg->mg_ptr))->mutex)
+#define MgOWNERCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->owner_cond)
+#define MgCONDP(mg) (&((condpair_t *)(mg->mg_ptr))->cond)
+#define MgOWNER(mg) ((condpair_t *)(mg->mg_ptr))->owner
+
 #undef	stack_base
 #undef	stack_sp
 #undef	stack_max
@@ -202,5 +230,6 @@ typedef struct thread *Thread;
 #define	runlevel	(thr->Trunlevel)
 
 #define	threadstart_mutexp	(thr->Tthreadstart_mutexp)
-#define	cvcache	(thr->Tcvcache)
+#define	cvcache		(thr->Tcvcache)
+#define	thrflags	(thr->Tthrflags)
 #endif /* USE_THREADS */
diff --git a/util.c b/util.c
index ef5c846..65fa31b 100644
--- a/util.c
+++ b/util.c
@@ -1829,4 +1829,41 @@ getTHR _((void))
     return (struct thread *) t;
 }
 #endif /* OLD_PTHREADS_API */
+
+MAGIC *
+condpair_magic(sv)
+SV *sv;
+{
+    MAGIC *mg;
+    
+    SvUPGRADE(sv, SVt_PVMG);
+    mg = mg_find(sv, 'm');
+    if (!mg) {
+	condpair_t *cp;
+
+	New(53, cp, 1, condpair_t);
+	MUTEX_INIT(&cp->mutex);
+	COND_INIT(&cp->owner_cond);
+	COND_INIT(&cp->cond);
+	cp->owner = 0;
+	MUTEX_LOCK(&sv_mutex);
+	mg = mg_find(sv, 'm');
+	if (mg) {
+	    /* someone else beat us to initialising it */
+	    MUTEX_UNLOCK(&sv_mutex);
+	    MUTEX_DESTROY(&cp->mutex);
+	    COND_DESTROY(&cp->owner_cond);
+	    COND_DESTROY(&cp->cond);
+	    Safefree(cp);
+	}
+	else {
+	    sv_magic(sv, Nullsv, 'm', 0, 0);
+	    mg = SvMAGIC(sv);
+	    mg->mg_ptr = (char *)cp;
+	    mg->mg_len = sizeof(cp);
+	    MUTEX_UNLOCK(&sv_mutex);
+	}
+    }
+    return mg;
+}
 #endif /* USE_THREADS */