From: Malcolm Beattie <mbeattie@sable.ox.ac.uk>
Date: Wed, 13 Aug 1997 16:15:25 +0000 (+0000)
Subject: Threading fixups for Digital UNIX.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=72aaf6313309039c851862ad50ee168cb9cdf42b;p=p5sagit%2Fp5-mst-13.2.git

Threading fixups for Digital UNIX.

p4raw-id: //depot/perl@45
---

diff --git a/README.threads b/README.threads
index 7dae3ef..a60a897 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
diff --git a/malloc.c b/malloc.c
index 52c7eed..828f2f7 100644
--- a/malloc.c
+++ b/malloc.c
@@ -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;
diff --git a/perl.h b/perl.h
index 9507f8b..6e29d36 100644
--- a/perl.h
+++ b/perl.h
@@ -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;
diff --git a/toke.c b/toke.c
index ca8657b..dd5e232 100644
--- a/toke.c
+++ b/toke.c
@@ -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;