merged tcl 8.1 branch back into the main trunk

1 files changed, 214 insertions, 31 deletions

diff --git a/generic/tclAlloc.c b/generic/tclAlloc.c
index 9314c2a..c44cf9f 100644
--- a/generic/tclAlloc.c
+++ b/generic/tclAlloc.c
@@ -8,13 +8,14 @@
  *
  * Copyright (c) 1983 Regents of the University of California.
  * Copyright (c) 1996-1997 Sun Microsystems, Inc.
+ * Copyright (c) 1998-1999 by Scriptics Corporation.
  *
  * Portions contributed by Chris Kingsley, Jack Jansen and Ray Johnson.
  *
  * See the file "license.terms" for information on usage and redistribution
  * of this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclAlloc.c,v 1.5 1999/03/11 02:49:34 stanton Exp $
+ * RCS: @(#) $Id: tclAlloc.c,v 1.6 1999/04/16 00:46:42 stanton Exp $
  */
 
 #include "tclInt.h"
@@ -31,7 +32,7 @@
 typedef unsigned long caddr_t;
 
 /*
- * The overhead on a block is at least 4 bytes.  When free, this space
+ * The overhead on a block is at least 8 bytes.  When free, this space
  * contains a pointer to the next free block, and the bottom two bits must
  * be zero.  When in use, the first byte is set to MAGIC, and the second
  * byte is the size index.  The remaining bytes are for alignment.
@@ -43,6 +44,7 @@ typedef unsigned long caddr_t;
 
 union overhead {
     union overhead *ov_next;	/* when free */
+    unsigned char ov_padding[8]; /* Ensure the structure is 8-byte aligned. */
     struct {
 	unsigned char	ovu_magic0;	/* magic number */
 	unsigned char	ovu_index;	/* bucket # */
@@ -51,13 +53,14 @@ union overhead {
 #ifdef RCHECK
 	unsigned short	ovu_rmagic;	/* range magic number */
 	unsigned long	ovu_size;	/* actual block size */
+	unsigned short  ovu_unused2;    /* padding to 8-byte align */
 #endif
     } ovu;
 #define ov_magic0	ovu.ovu_magic0
 #define ov_magic1	ovu.ovu_magic1
 #define ov_index	ovu.ovu_index
 #define ov_rmagic	ovu.ovu_rmagic
-#define ov_size	ovu.ovu_size
+#define ov_size		ovu.ovu_size
 };
 
 
@@ -82,6 +85,36 @@ union overhead {
 #define MAXMALLOC	(1<<(NBUCKETS+2))
 static	union overhead *nextf[NBUCKETS];
 
+/* 
+ * The following structure is used to keep track of all system memory 
+ * currently owned by Tcl.  When finalizing, all this memory will
+ * be returned to the system.
+ */
+
+struct block {
+    struct block *nextPtr;	/* Linked list. */
+    struct block *prevPtr;	/* Linked list for big blocks, ensures 8-byte 
+				 * alignment for suballocated blocks. */
+};
+
+static struct block *blockList;		/* Tracks the suballocated blocks. */
+static struct block bigBlocks = {	/* Big blocks aren't suballocated. */
+    &bigBlocks, &bigBlocks
+};
+
+/*
+ * The allocator is protected by a special mutex that must be
+ * explicitly initialized.  Futhermore, because Tcl_Alloc may be
+ * used before anything else in Tcl, we make this module self-initializing
+ * after all with the allocInit variable.
+ */
+
+#ifdef TCL_THREADS
+static TclpMutex allocMutex;
+#endif
+static int allocInit = 0;
+
+
 #ifdef MSTATS
 
 /*
@@ -106,6 +139,89 @@ static	unsigned int nmalloc[NBUCKETS+1];
  */
 
 static void 		MoreCore _ANSI_ARGS_((int bucket));
+
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclInitAlloc --
+ *
+ *	Initialize the memory system.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	Initialize the mutex used to serialize allocations.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TclInitAlloc()
+{
+    if (!allocInit) {
+	allocInit = 1;
+	TclpMutexInit(&allocMutex);
+    }
+}
+
+/*
+ *-------------------------------------------------------------------------
+ *
+ * TclFinalizeAllocSubsystem --
+ *
+ *	Release all resources being used by this subsystem, including 
+ *	aggressively freeing all memory allocated by TclpAlloc() that 
+ *	has not yet been released with TclpFree().
+ *	
+ *	After this function is called, all memory allocated with 
+ *	TclpAlloc() should be considered unusable.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	This subsystem is self-initializing, since memory can be 
+ *	allocated before Tcl is formally initialized.  After this call,
+ *	this subsystem has been reset to its initial state and is 
+ *	usable again.
+ *
+ *-------------------------------------------------------------------------
+ */
+
+void
+TclFinalizeAllocSubsystem()
+{
+    int i;
+    struct block *blockPtr, *nextPtr;
+
+    TclpMutexLock(&allocMutex);
+    for (blockPtr = blockList; blockPtr != NULL; blockPtr = nextPtr) {
+	nextPtr = blockPtr->nextPtr;
+	TclpSysFree(blockPtr);
+    }
+    blockList = NULL;
+
+    for (blockPtr = bigBlocks.nextPtr; blockPtr != &bigBlocks; ) {
+	nextPtr = blockPtr->nextPtr;
+	TclpSysFree(blockPtr);
+	blockPtr = nextPtr;
+    }
+    bigBlocks.nextPtr = &bigBlocks;
+    bigBlocks.prevPtr = &bigBlocks;
+
+    for (i = 0; i < NBUCKETS; i++) {
+	nextf[i] = NULL;
+#ifdef MSTATS
+	nmalloc[i] = 0;
+#endif
+    }
+#ifdef MSTATS
+    nmalloc[i] = 0;
+#endif
+    TclpMutexUnlock(&allocMutex);
+}
 
 /*
  *----------------------------------------------------------------------
@@ -124,21 +240,41 @@ static void 		MoreCore _ANSI_ARGS_((int bucket));
  */
 
 char *
-TclpAlloc(
-    unsigned int nbytes)	/* Number of bytes to allocate. */
+TclpAlloc(nbytes)
+    unsigned int nbytes;	/* Number of bytes to allocate. */
 {
     register union overhead *op;
     register long bucket;
     register unsigned amt;
+    struct block *bigBlockPtr;
 
+    if (!allocInit) {
+	/*
+	 * We have to make the "self initializing" because Tcl_Alloc
+	 * may be used before any other part of Tcl.  E.g., see
+	 * main() for tclsh!
+	 */
+
+	allocInit = 1;
+	TclpMutexInit(&allocMutex);
+    }
+    TclpMutexLock(&allocMutex);
     /*
      * First the simple case: we simple allocate big blocks directly
      */
     if (nbytes + OVERHEAD >= MAXMALLOC) {
-	op = (union overhead *)TclpSysAlloc(nbytes+OVERHEAD, 0);
-	if (op == NULL) {
+	bigBlockPtr = (struct block *) TclpSysAlloc((unsigned) 
+		(sizeof(struct block) + OVERHEAD + nbytes), 0);
+	if (bigBlockPtr == NULL) {
+	    TclpMutexUnlock(&allocMutex);
 	    return NULL;
 	}
+	bigBlockPtr->nextPtr = bigBlocks.nextPtr;
+	bigBlocks.nextPtr = bigBlockPtr;
+	bigBlockPtr->prevPtr = &bigBlocks;
+	bigBlockPtr->nextPtr->prevPtr = bigBlockPtr;
+
+	op = (union overhead *) (bigBlockPtr + 1);
 	op->ov_magic0 = op->ov_magic1 = MAGIC;
 	op->ov_index = 0xff;
 #ifdef MSTATS
@@ -153,6 +289,7 @@ TclpAlloc(
 	op->ov_rmagic = RMAGIC;
 	*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
 #endif
+	TclpMutexUnlock(&allocMutex);
 	return (void *)(op+1);
     }
     /*
@@ -170,6 +307,7 @@ TclpAlloc(
     while (nbytes + OVERHEAD > amt) {
 	amt <<= 1;
 	if (amt == 0) {
+	    TclpMutexUnlock(&allocMutex);
 	    return (NULL);
 	}
 	bucket++;
@@ -183,6 +321,7 @@ TclpAlloc(
     if ((op = nextf[bucket]) == NULL) {
 	MoreCore(bucket);
 	if ((op = nextf[bucket]) == NULL) {
+	    TclpMutexUnlock(&allocMutex);
 	    return (NULL);
 	}
     }
@@ -204,6 +343,7 @@ TclpAlloc(
     op->ov_rmagic = RMAGIC;
     *(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
 #endif
+    TclpMutexUnlock(&allocMutex);
     return ((char *)(op + 1));
 }
 
@@ -214,6 +354,8 @@ TclpAlloc(
  *
  *	Allocate more memory to the indicated bucket.
  *
+ *	Assumes Mutex is already held.
+ *
  * Results:
  *	None.
  *
@@ -224,13 +366,14 @@ TclpAlloc(
  */
 
 static void
-MoreCore(
-    int bucket)		/* What bucket to allocat to. */
+MoreCore(bucket)
+    int bucket;		/* What bucket to allocat to. */
 {
     register union overhead *op;
     register long sz;		/* size of desired block */
     long amt;			/* amount to allocate */
     int nblks;			/* how many blocks we get */
+    struct block *blockPtr;
 
     /*
      * sbrk_size <= 0 only for big, FLUFFY, requests (about
@@ -243,11 +386,16 @@ MoreCore(
     nblks = amt / sz;
     ASSERT(nblks*sz == amt);
 
-    op = (union overhead *)TclpSysAlloc(amt, 1);
+    blockPtr = (struct block *) TclpSysAlloc((unsigned) 
+	    (sizeof(struct block) + amt), 1);
     /* no more room! */
-    if (op == NULL) {
+    if (blockPtr == NULL) {
 	return;
     }
+    blockPtr->nextPtr = blockList;
+    blockList = blockPtr;
+
+    op = (union overhead *) (blockPtr + 1);
     
     /*
      * Add new memory allocated to that on
@@ -278,21 +426,24 @@ MoreCore(
  */
 
 void
-TclpFree(
-    char *cp)		/* Pointer to memory to free. */
+TclpFree(cp)
+    char *cp;		/* Pointer to memory to free. */
 {   
     register long size;
     register union overhead *op;
+    struct block *bigBlockPtr;
 
     if (cp == NULL) {
 	return;
     }
 
+    TclpMutexLock(&allocMutex);
     op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
 
     ASSERT(op->ov_magic0 == MAGIC);		/* make sure it was in use */
     ASSERT(op->ov_magic1 == MAGIC);
     if (op->ov_magic0 != MAGIC || op->ov_magic1 != MAGIC) {
+	TclpMutexUnlock(&allocMutex);
 	return;
     }
 
@@ -303,7 +454,11 @@ TclpFree(
 #ifdef MSTATS
 	nmalloc[NBUCKETS]--;
 #endif
-	TclpSysFree(op);
+	bigBlockPtr = (struct block *) op - 1;
+	bigBlockPtr->prevPtr->nextPtr = bigBlockPtr->nextPtr;
+	bigBlockPtr->nextPtr->prevPtr = bigBlockPtr->prevPtr;
+	TclpSysFree(bigBlockPtr);
+	TclpMutexUnlock(&allocMutex);
 	return;
     }
     ASSERT(size < NBUCKETS);
@@ -312,6 +467,7 @@ TclpFree(
 #ifdef MSTATS
     nmalloc[size]--;
 #endif
+    TclpMutexUnlock(&allocMutex);
 }
 
 /*
@@ -331,12 +487,13 @@ TclpFree(
  */
 
 char *
-TclpRealloc(
-    char *cp,			/* Pointer to alloced block. */
-    unsigned int nbytes)	/* New size of memory. */
+TclpRealloc(cp, nbytes)
+    char *cp;			/* Pointer to alloced block. */
+    unsigned int nbytes;	/* New size of memory. */
 {   
     int i;
     union overhead *op;
+    struct block *bigBlockPtr;
     int expensive;
     unsigned long maxsize;
 
@@ -344,11 +501,14 @@ TclpRealloc(
 	return (TclpAlloc(nbytes));
     }
 
+    TclpMutexLock(&allocMutex);
+
     op = (union overhead *)((caddr_t)cp - sizeof (union overhead));
 
     ASSERT(op->ov_magic0 == MAGIC);		/* make sure it was in use */
     ASSERT(op->ov_magic1 == MAGIC);
     if (op->ov_magic0 != MAGIC || op->ov_magic1 != MAGIC) {
+	TclpMutexUnlock(&allocMutex);
 	return NULL;
     }
 
@@ -361,10 +521,28 @@ TclpRealloc(
      */
 
     if (i == 0xff) {
-	op = (union overhead *) TclpSysRealloc(op, nbytes+OVERHEAD);
-	if (op == NULL) {
+	struct block *prevPtr, *nextPtr;
+	bigBlockPtr = (struct block *) op - 1;
+	prevPtr = bigBlockPtr->prevPtr;
+	nextPtr = bigBlockPtr->nextPtr;
+	bigBlockPtr = (struct block *) TclpSysRealloc(bigBlockPtr, 
+		sizeof(struct block) + OVERHEAD + nbytes);
+	if (bigBlockPtr == NULL) {
+	    TclpMutexUnlock(&allocMutex);
 	    return NULL;
 	}
+
+	if (prevPtr->nextPtr != bigBlockPtr) {
+	    /*
+	     * If the block has moved, splice the new block into the list where
+	     * the old block used to be. 
+	     */
+
+	    prevPtr->nextPtr = bigBlockPtr;
+	    nextPtr->prevPtr = bigBlockPtr;
+	}
+
+	op = (union overhead *) (bigBlockPtr + 1);
 #ifdef MSTATS
 	nmalloc[NBUCKETS]++;
 #endif
@@ -376,6 +554,7 @@ TclpRealloc(
 	op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
 	*(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
 #endif
+	TclpMutexUnlock(&allocMutex);
 	return (char *)(op+1);
     }
     maxsize = 1 << (i+3);
@@ -388,7 +567,9 @@ TclpRealloc(
 
     if (expensive) {
 	void *newp;
-		
+
+	TclpMutexUnlock(&allocMutex);
+
 	newp = TclpAlloc(nbytes);
 	if ( newp == NULL ) {
 	    return NULL;
@@ -408,6 +589,7 @@ TclpRealloc(
     op->ov_size = (nbytes + RSLOP - 1) & ~(RSLOP - 1);
     *(unsigned short *)((caddr_t)(op + 1) + op->ov_size) = RMAGIC;
 #endif
+    TclpMutexUnlock(&allocMutex);
     return(cp);
 }
 
@@ -431,14 +613,15 @@ TclpRealloc(
 
 #ifdef MSTATS
 void
-mstats(
-    char *s)	/* Where to write info. */
+mstats(s)
+    char *s;	/* Where to write info. */
 {
     register int i, j;
     register union overhead *p;
     int totfree = 0,
 	totused = 0;
 
+    TclpMutexLock(&allocMutex);
     fprintf(stderr, "Memory allocation statistics %s\nTclpFree:\t", s);
     for (i = 0; i < NBUCKETS; i++) {
 	for (j = 0, p = nextf[i]; p; p = p->ov_next, j++)
@@ -454,11 +637,11 @@ mstats(
 	    totused, totfree);
     fprintf(stderr, "\n\tNumber of big (>%d) blocks in use: %d\n", 
 	    MAXMALLOC, nmalloc[NBUCKETS]);
+    TclpMutexUnlock(&allocMutex);
 }
 #endif
 
-#else /* !USE_TCLALLOC */
-
+#else  /* !USE_TCLALLOC */
 
 /*
  *----------------------------------------------------------------------
@@ -477,8 +660,8 @@ mstats(
  */
 
 char *
-TclpAlloc(
-    unsigned int nbytes)	/* Number of bytes to allocate. */
+TclpAlloc(nbytes)
+    unsigned int nbytes;	/* Number of bytes to allocate. */
 {
     return (char*) malloc(nbytes);
 }
@@ -500,8 +683,8 @@ TclpAlloc(
  */
 
 void
-TclpFree(
-    char *cp)		/* Pointer to memory to free. */
+TclpFree(cp)
+    char *cp;		/* Pointer to memory to free. */
 {   
     free(cp);
     return;
@@ -524,9 +707,9 @@ TclpFree(
  */
 
 char *
-TclpRealloc(
-    char *cp,			/* Pointer to alloced block. */
-    unsigned int nbytes)	/* New size of memory. */
+TclpRealloc(cp, nbytes)
+    char *cp;			/* Pointer to alloced block. */
+    unsigned int nbytes;	/* New size of memory. */
 {   
     return (char*) realloc(cp, nbytes);
 }