+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
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
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
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;
* 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;
#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
*/
#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
*/
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;
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;
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");
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
}
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);
}
MEM_SIZE nbytes;
{
register MEM_SIZE onb;
- union overhead *op;
+ union overhead *ovp;
char *res;
register int i;
int was_alloced = 0;
#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 {
/*
* 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)) -
* 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
*/
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;
projects / platform / upstream / perl.git / commitdiff