From: Malcolm Beattie Date: Thu, 24 Jul 1997 14:57:53 +0000 (+0000) Subject: Start support for fake threads. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=12ca11f6c16e7b63e13bbf5bc251f214e8de5211;p=p5sagit%2Fp5-mst-13.2.git Start support for fake threads. pp_lock now returns its argument. p4raw-id: //depot/perl@41 --- diff --git a/MANIFEST b/MANIFEST index 15837d4..349e719 100644 --- 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 diff --git a/Makefile.SH b/Makefile.SH index ec99d02..dc5111a 100644 --- a/Makefile.SH +++ b/Makefile.SH @@ -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 --- 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 --- 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 */ diff --git a/opcode.h b/opcode.h index 2e6f4b2..4ca9972 100644 --- a/opcode.h +++ b/opcode.h @@ -2489,6 +2489,6 @@ EXT U32 opargs[] = { 0x00000014, /* egrent */ 0x0000000c, /* getlogin */ 0x0000211d, /* syscall */ - 0x00000114, /* lock */ + 0x00000104, /* lock */ }; #endif diff --git a/opcode.pl b/opcode.pl index 89d076a..5250d57 100755 --- 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 S diff --git a/perl.c b/perl.c index d3567f0..edaf972 100644 --- 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 --- 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 -#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 --- 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; } diff --git a/pp_ctl.c b/pp_ctl.c index c6a6ea2..3101e5c 100644 --- 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 */ diff --git a/pp_hot.c b/pp_hot.c index f45fa68..07f0754 100644 --- 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 --- 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 --- 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; diff --git a/thread.h b/thread.h index 45e47c3..8bef7a5 100644 --- a/thread.h +++ b/thread.h @@ -13,8 +13,35 @@ /* Rats: if dTHR is just blank then the subsequent ";" throws an error */ #define dTHR extern int errno #else -#include +#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 --- 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 --- 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))