This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Start support for fake threads.
authorMalcolm Beattie <mbeattie@sable.ox.ac.uk>
Thu, 24 Jul 1997 14:57:53 +0000 (14:57 +0000)
committerMalcolm Beattie <mbeattie@sable.ox.ac.uk>
Thu, 24 Jul 1997 14:57:53 +0000 (14:57 +0000)
pp_lock now returns its argument.

p4raw-id: //depot/perl@41

16 files changed:
MANIFEST
Makefile.SH
cv.h
op.c
opcode.h
opcode.pl
perl.c
perl.h
pp.c
pp_ctl.c
pp_hot.c
proto.h
sv.h
thread.h
toke.c
util.c

index 15837d4..349e719 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -762,6 +762,7 @@ t/pragma/subs.t             See if subroutine pseudo-importation works
 t/pragma/warn-1global  Tests of global warnings for warning.t
 t/pragma/warning.t     See if warning controls work
 taint.c                        Tainting code
+thread.h               Threading header
 toke.c                 The tokener
 universal.c            The default UNIVERSAL package methods
 unixish.h              Defines that are assumed on Unix
index ec99d02..dc5111a 100644 (file)
@@ -176,7 +176,7 @@ addedbyconf = UU $(shextract) $(plextract) pstruct
 h1 = EXTERN.h INTERN.h XSUB.h av.h config.h cop.h cv.h dosish.h
 h2 = embed.h form.h gv.h handy.h hv.h keywords.h mg.h op.h
 h3 = opcode.h patchlevel.h perl.h perly.h pp.h proto.h regcomp.h
-h4 = regexp.h scope.h sv.h unixish.h util.h perlio.h
+h4 = regexp.h scope.h sv.h unixish.h util.h perlio.h thread.h
 h = $(h1) $(h2) $(h3) $(h4)
 
 c1 = $(mallocsrc) av.c scope.c op.c doop.c doio.c dump.c hv.c mg.c
diff --git a/cv.h b/cv.h
index 97dfeb6..1e6b8de 100644 (file)
--- a/cv.h
+++ b/cv.h
@@ -29,9 +29,9 @@ struct xpvcv {
     AV *       xcv_padlist;
     CV *       xcv_outside;
 #ifdef USE_THREADS
-    pthread_mutex_t *  xcv_mutexp;
-    pthread_cond_t *   xcv_condp;      /* signalled when owner leaves CV */
-    struct thread *    xcv_owner;      /* current owner thread */
+    perl_mutex *xcv_mutexp;
+    perl_cond *        xcv_condp;      /* signalled when owner leaves CV */
+    struct thread *xcv_owner;  /* current owner thread */
 #endif /* USE_THREADS */
     U8         xcv_flags;
 };
diff --git a/op.c b/op.c
index 20e1384..bd2f09a 100644 (file)
--- a/op.c
+++ b/op.c
@@ -3129,9 +3129,9 @@ CV* outside;
        CvANON_on(cv);
 
 #ifdef USE_THREADS
-    New(666, CvMUTEXP(cv), 1, pthread_mutex_t);
+    New(666, CvMUTEXP(cv), 1, perl_mutex);
     MUTEX_INIT(CvMUTEXP(cv));
-    New(666, CvCONDP(cv), 1, pthread_cond_t);
+    New(666, CvCONDP(cv), 1, perl_cond);
     COND_INIT(CvCONDP(cv));
     CvOWNER(cv)                = 0;
 #endif /* USE_THREADS */
@@ -3371,9 +3371,9 @@ OP *block;
     CvSTASH(cv) = curstash;
 #ifdef USE_THREADS
     CvOWNER(cv) = 0;
-    New(666, CvMUTEXP(cv), 1, pthread_mutex_t);
+    New(666, CvMUTEXP(cv), 1, perl_mutex);
     MUTEX_INIT(CvMUTEXP(cv));
-    New(666, CvCONDP(cv), 1, pthread_cond_t);
+    New(666, CvCONDP(cv), 1, perl_cond);
     COND_INIT(CvCONDP(cv));
 #endif /* USE_THREADS */
 
@@ -3578,9 +3578,9 @@ char *filename;
     }
     CvGV(cv) = (GV*)SvREFCNT_inc(gv);
 #ifdef USE_THREADS
-    New(666, CvMUTEXP(cv), 1, pthread_mutex_t);
+    New(666, CvMUTEXP(cv), 1, perl_mutex);
     MUTEX_INIT(CvMUTEXP(cv));
-    New(666, CvCONDP(cv), 1, pthread_cond_t);
+    New(666, CvCONDP(cv), 1, perl_cond);
     COND_INIT(CvCONDP(cv));
     CvOWNER(cv) = 0;
 #endif /* USE_THREADS */
index 2e6f4b2..4ca9972 100644 (file)
--- a/opcode.h
+++ b/opcode.h
@@ -2489,6 +2489,6 @@ EXT U32 opargs[] = {
        0x00000014,     /* egrent */
        0x0000000c,     /* getlogin */
        0x0000211d,     /* syscall */
-       0x00000114,     /* lock */
+       0x00000104,     /* lock */
 };
 #endif
index 89d076a..5250d57 100755 (executable)
--- a/opcode.pl
+++ b/opcode.pl
@@ -654,4 +654,4 @@ getlogin    getlogin                ck_null         st
 syscall                syscall                 ck_fun          imst    S L
 
 # For multi-threading
-lock           lock                    ck_null         is      S
+lock           lock                    ck_null               S
diff --git a/perl.c b/perl.c
index d3567f0..edaf972 100644 (file)
--- a/perl.c
+++ b/perl.c
@@ -843,9 +843,9 @@ print \"  \\@INC:\\n    @INC\\n\";");
     curpad[0] = (SV*)newAV();
     SvPADMY_on(curpad[0]);     /* XXX Needed? */
     CvOWNER(compcv) = 0;
-    New(666, CvMUTEXP(compcv), 1, pthread_mutex_t);
+    New(666, CvMUTEXP(compcv), 1, perl_mutex);
     MUTEX_INIT(CvMUTEXP(compcv));
-    New(666, CvCONDP(compcv), 1, pthread_cond_t);
+    New(666, CvCONDP(compcv), 1, perl_cond);
     COND_INIT(CvCONDP(compcv));
 #endif /* USE_THREADS */
 
diff --git a/perl.h b/perl.h
index 4d229b9..64d47ac 100644 (file)
--- a/perl.h
+++ b/perl.h
@@ -63,8 +63,14 @@ register struct op *op asm(stringify(OP_IN_REGISTER));
 #define NOOP (void)0
 
 #ifdef USE_THREADS
+#ifdef FAKE_THREADS
+#include "fakethr.h"
+#else
 #include <pthread.h>
-#endif
+typedef pthread_mutex_t perl_mutex;
+typedef pthread_cond_t perl_cond;
+#endif /* FAKE_THREADS */
+#endif /* USE_THREADS */
 
 /*
  * SOFT_CAST can be used for args to prototyped functions to retain some
@@ -1318,14 +1324,14 @@ typedef Sighandler_t Sigsave_t;
 EXT PerlInterpreter *  curinterp;      /* currently running interpreter */
 #ifdef USE_THREADS
 EXT pthread_key_t      thr_key;        /* For per-thread struct thread ptr */
-EXT pthread_mutex_t    sv_mutex;       /* Mutex for allocating SVs in sv.c */
-EXT pthread_mutex_t    malloc_mutex;   /* Mutex for malloc */
-EXT pthread_mutex_t    eval_mutex;     /* Mutex for doeval */
-EXT pthread_cond_t     eval_cond;      /* Condition variable for doeval */
+EXT perl_mutex         sv_mutex;       /* Mutex for allocating SVs in sv.c */
+EXT perl_mutex         malloc_mutex;   /* Mutex for malloc */
+EXT perl_mutex         eval_mutex;     /* Mutex for doeval */
+EXT perl_cond          eval_cond;      /* Condition variable for doeval */
 EXT struct thread *    eval_owner;     /* Owner thread for doeval */
 EXT int                        nthreads;       /* Number of threads currently */
-EXT pthread_mutex_t    nthreads_mutex; /* Mutex for nthreads */
-EXT pthread_cond_t     nthreads_cond;  /* Condition variable for nthreads */
+EXT perl_mutex         nthreads_mutex; /* Mutex for nthreads */
+EXT perl_cond          nthreads_cond;  /* Condition variable for nthreads */
 #endif /* USE_THREADS */
 
 /* VMS doesn't use environ array and NeXT has problems with crt0.o globals */
diff --git a/pp.c b/pp.c
index c288a01..c956e80 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -4157,6 +4157,5 @@ PP(pp_lock)
        save_destructor(unlock_condpair, sv);
     }
 #endif /* USE_THREADS */
-    PUSHs(&sv_yes);
     RETURN;
 }
index c6a6ea2..3101e5c 100644 (file)
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -2163,9 +2163,9 @@ int gimme;
     CvUNIQUE_on(compcv);
 #ifdef USE_THREADS
     CvOWNER(compcv) = 0;
-    New(666, CvMUTEXP(compcv), 1, pthread_mutex_t);
+    New(666, CvMUTEXP(compcv), 1, perl_mutex);
     MUTEX_INIT(CvMUTEXP(compcv));
-    New(666, CvCONDP(compcv), 1, pthread_cond_t);
+    New(666, CvCONDP(compcv), 1, perl_cond);
     COND_INIT(CvCONDP(compcv));
 #endif /* USE_THREADS */
 
index f45fa68..07f0754 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -41,20 +41,6 @@ void *cvarg;
     MUTEX_UNLOCK(CvMUTEXP(cv));
     SvREFCNT_dec(cv);
 }
-
-#if 0
-void
-mutex_unlock(m)
-void *m;
-{
-#ifdef DEBUGGING
-    dTHR;
-    DEBUG_L((fprintf(stderr, "0x%lx unlocking mutex 0x%lx\n",
-                        (unsigned long) thr, (unsigned long) m)));
-#endif /* DEBUGGING */
-    MUTEX_UNLOCK((pthread_mutex_t *) m);
-}
-#endif
 #endif /* USE_THREADS */
 
 PP(pp_const)
diff --git a/proto.h b/proto.h
index 5fbd81d..3ad298d 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -258,9 +258,6 @@ void        mg_magical _((SV* sv));
 int    mg_set _((SV* sv));
 OP*    mod _((OP* o, I32 type));
 char*  moreswitches _((char* s));
-#ifdef USE_THREADS
-void   mutex_unlock _((void *m));
-#endif /* USE_THREADS */
 OP*    my _((OP* o));
 #if !defined(HAS_BCOPY) || !defined(HAS_SAFE_BCOPY)
 char*  my_bcopy _((char* from, char* to, I32 len));
diff --git a/sv.h b/sv.h
index d58aeb1..2651e43 100644 (file)
--- a/sv.h
+++ b/sv.h
@@ -244,9 +244,9 @@ struct xpvfm {
     AV *       xcv_padlist;
     CV *       xcv_outside;
 #ifdef USE_THREADS
-    pthread_mutex_t *  xcv_mutexp;
-    pthread_cond_t *   xcv_condp;      /* signalled when owner leaves CV */
-    struct thread *    xcv_owner;      /* current owner thread */
+    perl_mutex *xcv_mutexp;
+    perl_cond *        xcv_condp;      /* signalled when owner leaves CV */
+    struct thread *xcv_owner;  /* current owner thread */
 #endif /* USE_THREADS */
     U8         xcv_flags;
 
index 45e47c3..8bef7a5 100644 (file)
--- a/thread.h
+++ b/thread.h
 /* Rats: if dTHR is just blank then the subsequent ";" throws an error */
 #define dTHR extern int errno
 #else
-#include <pthread.h>
 
+#ifdef FAKE_THREADS
+typedef struct thread *perl_thread;
+/* With fake threads, thr is global(ish) so we don't need dTHR */
+#define dTHR extern int errno
+
+/*
+ * Note that SCHEDULE() is only callable from pp code (which
+ * must be expecting to be restarted). We'll have to do
+ * something a bit different for XS code.
+ */
+#define SCHEDULE() return schedule(), op
+
+#define MUTEX_LOCK(m)
+#define MUTEX_UNLOCK(m)
+#define MUTEX_INIT(m)
+#define MUTEX_DESTROY(m)
+#define COND_INIT(c) perl_cond_init(c)
+#define COND_SIGNAL(c) perl_cond_signal(c)
+#define COND_BROADCAST(c) perl_cond_broadcast(c)
+#define COND_WAIT(c, m) STMT_START {   \
+       perl_cond_wait(c);              \
+       SCHEDULE();                     \
+    } STMT_END
+#define COND_DESTROY(c)
+
+#else
+/* POSIXish threads */
+typedef pthread_t perl_thread;
 #ifdef OLD_PTHREADS_API
 #define pthread_mutexattr_init(a) pthread_mutexattr_create(a)
 #define pthread_mutexattr_settype(a,t) pthread_mutexattr_setkind_np(a,t)
@@ -51,9 +78,10 @@ struct thread *getTHR _((void));
 #define THR ((struct thread *) pthread_getspecific(thr_key))
 #endif /* OLD_PTHREADS_API */
 #define dTHR struct thread *thr = THR
+#endif /* FAKE_THREADS */
 
 struct thread {
-    pthread_t  Tself;
+    perl_thread        Tself;
 
     /* The fields that used to be global */
     SV **      Tstack_base;
@@ -123,9 +151,16 @@ struct thread {
 
     /* XXX Sort stuff, firstgv, secongv and so on? */
 
-    pthread_mutex_t *  Tthreadstart_mutexp;
+    perl_mutex *Tthreadstart_mutexp;
     HV *       Tcvcache;
     U32                Tthrflags;
+
+#ifdef FAKE_THREADS
+    perl_thread next, prev;            /* Linked list of all threads */
+    perl_thread next_run, prev_run;    /* Linked list of runnable threads */
+    perl_cond  wait_queue;             /* Wait queue that we are waiting on */
+    IV         private;                /* Holds data across time slices */
+#endif /* FAKE_THREADS */
 };
 
 typedef struct thread *Thread;
@@ -146,10 +181,10 @@ typedef struct thread *Thread;
     } STMT_END
 
 typedef struct condpair {
-    pthread_mutex_t    mutex;
-    pthread_cond_t     owner_cond;
-    pthread_cond_t     cond;
-    Thread             owner;
+    perl_mutex mutex;
+    perl_cond  owner_cond;
+    perl_cond  cond;
+    Thread     owner;
 } condpair_t;
 
 #define MgMUTEXP(mg) (&((condpair_t *)(mg->mg_ptr))->mutex)
diff --git a/toke.c b/toke.c
index 54ad907..39359b7 100644 (file)
--- a/toke.c
+++ b/toke.c
@@ -5237,9 +5237,9 @@ U32 flags;
     curpad[0] = (SV*)newAV();
     SvPADMY_on(curpad[0]);     /* XXX Needed? */
     CvOWNER(compcv) = 0;
-    New(666, CvMUTEXP(compcv), 1, pthread_mutex_t);
+    New(666, CvMUTEXP(compcv), 1, perl_mutex);
     MUTEX_INIT(CvMUTEXP(compcv));
-    New(666, CvCONDP(compcv), 1, pthread_cond_t);
+    New(666, CvCONDP(compcv), 1, perl_cond);
     COND_INIT(CvCONDP(compcv));
 #endif /* USE_THREADS */
 
@@ -5252,9 +5252,9 @@ U32 flags;
     CvOUTSIDE(compcv) = (CV*)SvREFCNT_inc((SV*)outsidecv);
 #ifdef USE_THREADS
     CvOWNER(compcv) = 0;
-    New(666, CvMUTEXP(compcv), 1, pthread_mutex_t);
+    New(666, CvMUTEXP(compcv), 1, perl_mutex);
     MUTEX_INIT(CvMUTEXP(compcv));
-    New(666, CvCONDP(compcv), 1, pthread_cond_t);
+    New(666, CvCONDP(compcv), 1, perl_cond);
     COND_INIT(CvCONDP(compcv));
 #endif /* USE_THREADS */
 
diff --git a/util.c b/util.c
index 14940ac..5bf2095 100644 (file)
--- a/util.c
+++ b/util.c
@@ -2293,6 +2293,84 @@ I32 *retlen;
 }
 
 #ifdef USE_THREADS
+#ifdef FAKE_THREADS
+/* Very simplistic scheduler for now */
+void
+schedule(void)
+{
+    thr = thr->next_run;
+}
+
+void
+perl_cond_init(cp)
+perl_cond *cp;
+{
+    *cp = 0;
+}
+
+void
+perl_cond_signal(cp)
+perl_cond *cp;
+{
+    perl_thread t;
+    perl_cond cond = *cp;
+    
+    if (!cond)
+       return;
+    t = cond->thread;
+    /* Insert t in the runnable queue just ahead of us */
+    t->next_run = thr->next_run;
+    thr->next_run->prev_run = t;
+    t->prev_run = thr;
+    thr->next_run = t;
+    thr->wait_queue = 0;
+    /* Remove from the wait queue */
+    *cp = cond->next;
+    Safefree(cond);
+}
+
+void
+perl_cond_broadcast(cp)
+perl_cond *cp;
+{
+    perl_thread t;
+    perl_cond cond, cond_next;
+    
+    for (cond = *cp; cond; cond = cond_next) {
+       t = cond->thread;
+       /* Insert t in the runnable queue just ahead of us */
+       t->next_run = thr->next_run;
+       thr->next_run->prev_run = t;
+       t->prev_run = thr;
+       thr->next_run = t;
+       thr->wait_queue = 0;
+       /* Remove from the wait queue */
+       cond_next = cond->next;
+       Safefree(cond);
+    }
+    *cp = 0;
+}
+
+void
+perl_cond_wait(cp)
+perl_cond *cp;
+{
+    perl_cond cond;
+
+    if (thr->next_run == thr)
+       croak("panic: perl_cond_wait called by last runnable thread");
+    
+    New(666, cond, 1, perl_wait_queue);
+    cond->thread = thr;
+    cond->next = *cp;
+    *cp = cond;
+    thr->wait_queue = cond;
+    /* Remove ourselves from runnable queue */
+    thr->next_run->prev_run = thr->prev_run;
+    thr->prev_run->next_run = thr->next_run;
+}
+#endif /* FAKE_THREADS */
+
 #ifdef OLD_PTHREADS_API
 struct thread *
 getTHR _((void))