diff options
| -rw-r--r-- | README.threads | 112 | ||||
| -rw-r--r-- | malloc.c | 86 | ||||
| -rw-r--r-- | perl.h | 6 | ||||
| -rw-r--r-- | toke.c | 4 |
4 files changed, 160 insertions, 48 deletions
diff --git a/README.threads b/README.threads index 7dae3efbcb..a60a897500 100644 --- a/README.threads +++ b/README.threads @@ -1,3 +1,5 @@ +Background + Some old globals (e.g. stack_sp, op) and some old per-interpreter variables (e.g. tmps_stack, cxstack) move into struct thread. All fields of struct thread (apart from a few only applicable to @@ -15,6 +17,9 @@ via pthread_getspecific. If a function fails to compile with an error about "no such variable thr", it probably just needs a dTHR at the top. + +Fake threads + For FAKE_THREADS, thr is a global variable and perl schedules threads by altering thr in between appropriate ops. The next and prev fields of struct thread keep all fake threads on a doubly linked list and @@ -50,3 +55,110 @@ so if the owner field already matches the current thread then pp_lock returns straight away. If the owner field has to be filled in then unlock_condpair is queued as an end-of-block destructor and that function zeroes out the owner field, releasing the lock. + + +Building + +Omit the -e from your ./Configure arguments. For example, use + ./Configure -drs +When it offers to let you change config.sh, do so. If you already +have a config.sh then you can edit it and do + ./Configure -S +to propagate the required changes. +In ccflags, insert -DUSE_THREADS (and probably -DDEBUGGING since +that's what I've been building with). Also insert any other +arguments in there that your compiler needs to use POSIX threads. +Change optimize to -g to give you better debugging information. +Include any necessary explicit libraries in libs and change +ldflags if you need any linker flags instead or as well. + +More explicitly, for Linux (when using the standard kernel-threads +based LinuxThreads library): + Add -DUSE_THREADS -D_REENTRANT -DDEBUGGING to ccflags and cppflags + Add -lpthread to libs + Change optimize to -g +For Digital Unix 4.x: + Add -pthread -DUSE_THREADS -DDEBUGGING to ccflags + Add -DUSE_THREADS -DDEBUGGING to cppflags + Add -pthread to ldflags + Change optimize to -g + Maybe add -lpthread -lc_r to lddlflags + For some reason, the extra includes for pthreads make Digital UNIX + complain fatally about the sbrk() delcaration in perl's malloc.c + so use the native malloc as follows: + Change usemymalloc to n + Zap mallocobj and mallocsrc (foo='') + Change d_mymalloc to undef + + +Now you can do a + make perl +For Digital UNIX, it will get as far as building miniperl and then +bomb out buidling DynaLoader when MakeMaker tries to find where +perl is. This seems to be a problem with backticks/system when +threading is in. A minimal failing example is + perl -e 'eval q($foo = 0); system("echo foo")' +which doesn't echo anything. The resulting ext/DynaLoader/Makefile +will have lines + PERL = 0 + FULLPERL = 0 +Change them to be the pathnames of miniperl and perl respectively +(the ones in your perl build directory). The resume the make with + make perl +This time it should manage to build perl. If not, try some cutting +and pasting to compile and link things manually. Be careful when +building extensions that your ordinary perl doesn't end up making +a Makefile without the correct pthreads compiler options. + +Building the Thread extension + +Build it away from the perl tree in the usual way. Set your PATH +environment variable to have your perl build directory first and +set PERL5LIB to be your/build/directory/lib (without those, I had +problems where the config information from the ordinary perl on +the system would end up in the Makefile). Then + perl Makefile.PL + make +On Digital UNIX, you'll probably have to fix the "PERL = 0" and +"FULLPERL = 0" lines in the generated Makefile as for DynaLoader. + +Then you can try some of the tests with + perl -Mblib create.t + perl -Mblib join.t + perl -Mblib lock.t + perl -Mblib unsync.t + perl -Mblib unsync2.t + perl -Mblib unsync3.t + perl -Mblib io.t +The io one leaves a thread reading from the keyboard on stdin so +as the ping messages appear you can type lines and see them echoed. + +Try running the main perl test suite too. There are known +failures for po/misc test 45 (tries to do local(@_) but @_ is +now lexical) and some tests involving backticks/system/fork +may or may not work. Under Linux, many tests appear to fail +when run under the test harness but work fine when invoked +manually. + + +Bugs + +* cond.t hasn't been redone since condition variable changed. + +* FAKE_THREADS should produce a working perl but the Thread +extension won't build with it yet. + +* There's a known memory leak (curstack isn't freed at the end +of each thread because it causes refcount problems that I +haven't tracked down yet) and there are very probably others too. + +* The new synchronised subs design isn't done yet. + +* There are still races where bugs show up under contention. + +* Plenty of others + + +Malcolm Beattie +mbeattie@sable.ox.ac.uk +13 August 1997 @@ -367,7 +367,7 @@ static void morecore(bucket) register int bucket; { - register union overhead *op; + register union overhead *ovp; register int rnu; /* 2^rnu bytes will be requested */ register int nblks; /* become nblks blocks of the desired size */ register MEM_SIZE siz, needed; @@ -384,10 +384,10 @@ morecore(bucket) * make getpageize call? */ #ifndef atarist /* on the atari we dont have to worry about this */ - op = (union overhead *)sbrk(0); + ovp = (union overhead *)sbrk(0); # ifndef I286 - if ((UV)op & (0x7FF >> CHUNK_SHIFT)) { - slack = (0x800 >> CHUNK_SHIFT) - ((UV)op & (0x7FF >> CHUNK_SHIFT)); + if ((UV)ovp & (0x7FF >> CHUNK_SHIFT)) { + slack = (0x800 >> CHUNK_SHIFT) - ((UV)ovp & (0x7FF >> CHUNK_SHIFT)); (void)sbrk(slack); # if defined(DEBUGGING_MSTATS) sbrk_slack += slack; @@ -411,11 +411,11 @@ morecore(bucket) #ifdef TWO_POT_OPTIMIZE needed += (bucket >= (FIRST_BIG_TWO_POT - 3) ? PERL_PAGESIZE : 0); #endif - op = (union overhead *)sbrk(needed); + ovp = (union overhead *)sbrk(needed); /* no more room! */ - if (op == (union overhead *)-1) { - op = (union overhead *)emergency_sbrk(needed); - if (op == (union overhead *)-1) + if (ovp == (union overhead *)-1) { + ovp = (union overhead *)emergency_sbrk(needed); + if (ovp == (union overhead *)-1) return; } #ifdef DEBUGGING_MSTATS @@ -427,11 +427,11 @@ morecore(bucket) */ #ifndef I286 # ifdef PACK_MALLOC - if ((UV)op & 0x7FF) + if ((UV)ovp & 0x7FF) croak("panic: Off-page sbrk"); # endif - if ((UV)op & 7) { - op = (union overhead *)(((UV)op + 8) & ~7); + if ((UV)ovp & 7) { + ovp = (union overhead *)(((UV)ovp + 8) & ~7); nblks--; } #else @@ -443,29 +443,29 @@ morecore(bucket) */ siz = 1 << (bucket + 3); #ifdef PACK_MALLOC - *(u_char*)op = bucket; /* Fill index. */ + *(u_char*)ovp = bucket; /* Fill index. */ if (bucket <= MAX_PACKED - 3) { - op = (union overhead *) ((char*)op + blk_shift[bucket]); + ovp = (union overhead *) ((char*)ovp + blk_shift[bucket]); nblks = n_blks[bucket]; # ifdef DEBUGGING_MSTATS start_slack += blk_shift[bucket]; # endif } else if (bucket <= 11 - 1 - 3) { - op = (union overhead *) ((char*)op + blk_shift[bucket]); + ovp = (union overhead *) ((char*)ovp + blk_shift[bucket]); /* nblks = n_blks[bucket]; */ siz -= sizeof(union overhead); - } else op++; /* One chunk per block. */ + } else ovp++; /* One chunk per block. */ #endif /* !PACK_MALLOC */ - nextf[bucket] = op; + nextf[bucket] = ovp; #ifdef DEBUGGING_MSTATS nmalloc[bucket] += nblks; #endif while (--nblks > 0) { - op->ov_next = (union overhead *)((caddr_t)op + siz); - op = (union overhead *)((caddr_t)op + siz); + ovp->ov_next = (union overhead *)((caddr_t)ovp + siz); + ovp = (union overhead *)((caddr_t)ovp + siz); } /* Not all sbrks return zeroed memory.*/ - op->ov_next = (union overhead *)NULL; + ovp->ov_next = (union overhead *)NULL; #ifdef PACK_MALLOC if (bucket == 7 - 3) { /* Special case, explanation is above. */ union overhead *n_op = nextf[7 - 3]->ov_next; @@ -481,7 +481,7 @@ free(mp) Malloc_t mp; { register MEM_SIZE size; - register union overhead *op; + register union overhead *ovp; char *cp = (char*)mp; #ifdef PACK_MALLOC u_char bucket; @@ -493,12 +493,12 @@ free(mp) if (cp == NULL) return; - op = (union overhead *)((caddr_t)cp - - sizeof (union overhead) * CHUNK_SHIFT); + ovp = (union overhead *)((caddr_t)cp + - sizeof (union overhead) * CHUNK_SHIFT); #ifdef PACK_MALLOC - bucket = OV_INDEX(op); + bucket = OV_INDEX(ovp); #endif - if (OV_MAGIC(op, bucket) != MAGIC) { + if (OV_MAGIC(ovp, bucket) != MAGIC) { static int bad_free_warn = -1; if (bad_free_warn == -1) { char *pbf = getenv("PERL_BADFREE"); @@ -508,7 +508,7 @@ free(mp) return; #ifdef RCHECK warn("%s free() ignored", - op->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad"); + ovp->ov_rmagic == RMAGIC - 1 ? "Duplicate" : "Bad"); #else warn("Bad free() ignored"); #endif @@ -516,15 +516,15 @@ free(mp) } MUTEX_LOCK(&malloc_mutex); #ifdef RCHECK - ASSERT(op->ov_rmagic == RMAGIC); - if (OV_INDEX(op) <= MAX_SHORT_BUCKET) - ASSERT(*(u_int *)((caddr_t)op + op->ov_size + 1 - RSLOP) == RMAGIC); - op->ov_rmagic = RMAGIC - 1; + ASSERT(ovp->ov_rmagic == RMAGIC); + if (OV_INDEX(ovp) <= MAX_SHORT_BUCKET) + ASSERT(*(u_int *)((caddr_t)ovp + ovp->ov_size + 1 - RSLOP) == RMAGIC); + ovp->ov_rmagic = RMAGIC - 1; #endif - ASSERT(OV_INDEX(op) < NBUCKETS); - size = OV_INDEX(op); - op->ov_next = nextf[size]; - nextf[size] = op; + ASSERT(OV_INDEX(ovp) < NBUCKETS); + size = OV_INDEX(ovp); + ovp->ov_next = nextf[size]; + nextf[size] = ovp; MUTEX_UNLOCK(&malloc_mutex); } @@ -547,7 +547,7 @@ realloc(mp, nbytes) MEM_SIZE nbytes; { register MEM_SIZE onb; - union overhead *op; + union overhead *ovp; char *res; register int i; int was_alloced = 0; @@ -574,10 +574,10 @@ realloc(mp, nbytes) #endif /* PERL_CORE */ MUTEX_LOCK(&malloc_mutex); - op = (union overhead *)((caddr_t)cp - - sizeof (union overhead) * CHUNK_SHIFT); - i = OV_INDEX(op); - if (OV_MAGIC(op, i) == MAGIC) { + ovp = (union overhead *)((caddr_t)cp + - sizeof (union overhead) * CHUNK_SHIFT); + i = OV_INDEX(ovp); + if (OV_MAGIC(ovp, i) == MAGIC) { was_alloced = 1; } else { /* @@ -591,8 +591,8 @@ realloc(mp, nbytes) * the memory block being realloc'd is the * smallest possible. */ - if ((i = findbucket(op, 1)) < 0 && - (i = findbucket(op, reall_srchlen)) < 0) + if ((i = findbucket(ovp, 1)) < 0 && + (i = findbucket(ovp, reall_srchlen)) < 0) i = 0; } onb = (1L << (i + 3)) - @@ -624,7 +624,7 @@ realloc(mp, nbytes) * Record new allocated size of block and * bound space with magic numbers. */ - if (OV_INDEX(op) <= MAX_SHORT_BUCKET) { + if (OV_INDEX(ovp) <= MAX_SHORT_BUCKET) { /* * Convert amount of memory requested into * closest block size stored in hash buckets @@ -633,8 +633,8 @@ realloc(mp, nbytes) */ nbytes += M_OVERHEAD; nbytes = (nbytes + 3) &~ 3; - op->ov_size = nbytes - 1; - *((u_int *)((caddr_t)op + nbytes - RSLOP)) = RMAGIC; + ovp->ov_size = nbytes - 1; + *((u_int *)((caddr_t)ovp + nbytes - RSLOP)) = RMAGIC; } #endif res = cp; @@ -861,9 +861,9 @@ typedef pthread_key_t perl_key; #endif -/* Digital UNIX defines CONTEXT when pthreads is in use */ -#ifdef CONTEXT -# undef CONTEXT +/* Digital UNIX defines a typedef CONTEXT when pthreads is in use */ +#if defined(__osf__) +# define CONTEXT PERL_CONTEXT #endif typedef MEM_SIZE STRLEN; @@ -759,7 +759,7 @@ char *start; register char *d = SvPVX(sv); bool dorange = FALSE; I32 len; - char *leave = + char *leaveit = lex_inpat ? "\\.^$@AGZdDwWsSbB+*?|()-nrtfeaxc0123456789[{]} \t\n\r\f\v#" : (lex_inwhat & OP_TRANS) @@ -805,7 +805,7 @@ char *start; } if (*s == '\\' && s+1 < send) { s++; - if (*s && strchr(leave, *s)) { + if (*s && strchr(leaveit, *s)) { *d++ = '\\'; *d++ = *s++; continue; |