pp_lock now returns its argument.
p4raw-id: //depot/perl@41
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
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
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;
};
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 */
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 */
}
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 */
0x00000014, /* egrent */
0x0000000c, /* getlogin */
0x0000211d, /* syscall */
- 0x00000114, /* lock */
+ 0x00000104, /* lock */
};
#endif
syscall syscall ck_fun imst S L
# For multi-threading
-lock lock ck_null is S
+lock lock ck_null s S
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 */
#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
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 */
save_destructor(unlock_condpair, sv);
}
#endif /* USE_THREADS */
- PUSHs(&sv_yes);
RETURN;
}
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 */
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)
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));
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;
/* 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)
#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;
/* 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;
} 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)
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 */
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 */
}
#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))
projects / p5sagit/p5-mst-13.2.git / commitdiff