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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 */