Threading fixups for Digital UNIX.
Malcolm Beattie [Wed, 13 Aug 1997 16:15:25 +0000 (16:15 +0000)]
p4raw-id: //depot/perl@45

README.threads
malloc.c
perl.h
toke.c

index 7dae3ef..a60a897 100644 (file)
@@ -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
index 52c7eed..828f2f7 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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;