import tcl 8.4.0

1 files changed, 118 insertions, 54 deletions

diff --git a/tcl/mac/tclMacAlloc.c b/tcl/mac/tclMacAlloc.c
index f06170cf27d..08e568b6824 100644
--- a/tcl/mac/tclMacAlloc.c
+++ b/tcl/mac/tclMacAlloc.c
@@ -20,6 +20,7 @@
 #include "tclInt.h"
 #include "tclMacInt.h"
 #include <Memory.h>
+#include <Gestalt.h>
 #include <stdlib.h>
 #include <string.h>
 
@@ -30,12 +31,13 @@
  */
 #define MEMORY_ALL_SYS 1	/* All memory should come from the system
 heap. */
+#define MEMORY_DONT_USE_TEMPMEM 2	/* Don't use temporary memory but system memory. */
 
 /*
  * Amount of space to leave in the application heap for the Toolbox to work.
  */
 
-#define TOOLBOX_SPACE (32 * 1024)
+#define TOOLBOX_SPACE (512 * 1024)
 
 static int memoryFlags = 0;
 static Handle toolGuardHandle = NULL;
@@ -49,6 +51,15 @@ static Handle toolGuardHandle = NULL;
 				 * the way out. If we can't, we go to the
 				 * system heap directly. */
 
+static int tclUseMemTracking = 0; /* Are we tracking memory allocations?
+								   * On recent versions of the MacOS this
+								   * is no longer necessary, as we can use
+								   * temporary memory which is freed by the
+								   * OS after a quit or crash. */
+								   
+static size_t tclExtraHdlSize = 0; /* Size of extra memory allocated at the start
+									* of each block when using memory tracking
+									* ( == 0 otherwise) */
 
 /*
  * The following typedef and variable are used to keep track of memory
@@ -59,10 +70,11 @@ static Handle toolGuardHandle = NULL;
 typedef struct listEl {
     Handle		memoryHandle;
     struct listEl *	next;
+    struct listEl *	prec;
 } ListEl;
 
-ListEl * systemMemory = NULL;
-ListEl * appMemory = NULL;
+static ListEl * systemMemory = NULL;
+static ListEl * appMemory = NULL;
 
 /*
  * Prototypes for functions used only in this file.
@@ -99,13 +111,28 @@ TclpSysRealloc(
     Handle hand;
     void *newPtr;
     int maxsize;
+    OSErr err;
 
-    hand = * (Handle *) ((Ptr) oldPtr - sizeof(Handle));
+	if (tclUseMemTracking) {
+    hand = ((ListEl *) ((Ptr) oldPtr - tclExtraHdlSize))->memoryHandle;
+    } else {
+    hand = RecoverHandle((Ptr) oldPtr);
+	}
     maxsize = GetHandleSize(hand) - sizeof(Handle);
     if (maxsize < size) {
+    HUnlock(hand);
+    SetHandleSize(hand,size + tclExtraHdlSize);
+    err = MemError();
+    HLock(hand);
+    if(err==noErr){
+    	newPtr=(*hand + tclExtraHdlSize);
+    } else {
 	newPtr = TclpSysAlloc(size, 1);
-	memcpy(newPtr, oldPtr, maxsize);
+	if(newPtr!=NULL) {
+	memmove(newPtr, oldPtr, maxsize);
 	TclpSysFree(oldPtr);
+	}
+	}
     } else {
 	newPtr = oldPtr;
     }
@@ -136,6 +163,31 @@ TclpSysAlloc(
 {
     Handle hand = NULL;
     ListEl * newMemoryRecord;
+	int isSysMem = 0;
+	static int initialized=0;
+	
+	if (!initialized) {
+	long response = 0;
+	OSErr err = noErr;
+	int useTempMem = 0;
+	
+	/* Check if we can use temporary memory */
+	initialized=1;
+	err = Gestalt(gestaltOSAttr, &response);
+	if (err == noErr) {
+    	useTempMem = response & (1 << gestaltRealTempMemory);
+	}
+	tclUseMemTracking = !useTempMem || (memoryFlags & MEMORY_DONT_USE_TEMPMEM);
+	if(tclUseMemTracking) {
+	    tclExtraHdlSize = sizeof(ListEl);
+	    /*
+	     * We are allocating memory directly from the system
+	     * heap. We need to install an exit handle 
+	     * to ensure the memory is cleaned up.
+	     */
+	    TclMacInstallExitToShellPatch(CleanUpExitProc);
+	}
+	}
 
     if (!(memoryFlags & MEMORY_ALL_SYS)) {
 
@@ -157,6 +209,7 @@ TclpSysAlloc(
     	if (toolGuardHandle == NULL) {
     	    toolGuardHandle = NewHandle(TOOLBOX_SPACE);
     	    if (toolGuardHandle != NULL) {
+    	    	HLock(toolGuardHandle);
     	    	HPurge(toolGuardHandle);
     	    }
     	}
@@ -167,55 +220,55 @@ TclpSysAlloc(
 
     	if (toolGuardHandle != NULL) {
     	    HLock(toolGuardHandle);
-	    hand = NewHandle(size + sizeof(Handle));
+	    hand = NewHandle(size + tclExtraHdlSize);
 	    HUnlock(toolGuardHandle);
 	}
     }
-    if (hand != NULL) {
-	newMemoryRecord = (ListEl *) NewPtr(sizeof(ListEl));
-	if (newMemoryRecord == NULL) {
-	    DisposeHandle(hand);
-	    return NULL;
-	}
-	newMemoryRecord->memoryHandle = hand;
-	newMemoryRecord->next = appMemory;
-	appMemory = newMemoryRecord;
-    } else {
+    if (hand == NULL) {
 	/*
 	 * Ran out of memory in application space.  Lets try to get
 	 * more memory from system.  Otherwise, we return NULL to
 	 * denote failure.
 	 */
+	if(!tclUseMemTracking) {
+		/* Use Temporary Memory instead of System Heap when available */
+		OSErr err;
+		isBin = 1; /* always HLockHi TempMemHandles */
+		hand = TempNewHandle(size + tclExtraHdlSize,&err);
+		if(err!=noErr) { hand=NULL; }
+	} else {
+	/* Use system heap when tracking memory */
+	isSysMem=1;
 	isBin = 0;
-	hand = NewHandleSys(size + sizeof(Handle));
-	if (hand == NULL) {
-	    return NULL;
+	hand = NewHandleSys(size + tclExtraHdlSize);
 	}
-	if (systemMemory == NULL) {
-	    /*
-	     * This is the first time we've attempted to allocate memory
-	     * directly from the system heap.  We need to now install the
-	     * exit handle to ensure the memory is cleaned up.
-	     */
-	    TclMacInstallExitToShellPatch(CleanUpExitProc);
 	}
-	newMemoryRecord = (ListEl *) NewPtrSys(sizeof(ListEl));
-	if (newMemoryRecord == NULL) {
-	    DisposeHandle(hand);
+	if (hand == NULL) {
 	    return NULL;
 	}
-	newMemoryRecord->memoryHandle = hand;
-	newMemoryRecord->next = systemMemory;
-	systemMemory = newMemoryRecord;
-    }
     if (isBin) {
 	HLockHi(hand);
     } else {
 	HLock(hand);
     }
-    (** (Handle **) hand) = hand;
-
-    return (*hand + sizeof(Handle));
+	if(tclUseMemTracking) {
+	/* Only need to do this when tracking memory */
+	newMemoryRecord = (ListEl *) *hand;
+	newMemoryRecord->memoryHandle = hand;
+	newMemoryRecord->prec = NULL;
+	if(isSysMem) {
+	newMemoryRecord->next = systemMemory;
+	systemMemory = newMemoryRecord;
+	} else {
+	newMemoryRecord->next = appMemory;
+	appMemory = newMemoryRecord;
+	}
+	if(newMemoryRecord->next!=NULL) {
+	newMemoryRecord->next->prec=newMemoryRecord;
+	}
+	}
+	
+    return (*hand + tclExtraHdlSize);
 }
 
 /*
@@ -238,13 +291,27 @@ void
 TclpSysFree(
     void * ptr)		/* Free this system memory. */
 {
-    Handle hand;
-    OSErr err;
+	if(tclUseMemTracking) {
+    /* Only need to do this when tracking memory */
+    ListEl *memRecord;
 
-    hand = * (Handle *) ((Ptr) ptr - sizeof(Handle));
-    DisposeHandle(hand);
-    *hand = NULL;
-    err = MemError();
+    memRecord = (ListEl *) ((Ptr) ptr - tclExtraHdlSize);
+    /* Remove current record from linked list */
+    if(memRecord->next!=NULL) {
+    	memRecord->next->prec=memRecord->prec;
+    }
+    if(memRecord->prec!=NULL) {
+    	memRecord->prec->next=memRecord->next;
+    }
+    if(memRecord==appMemory) {
+    	appMemory=memRecord->next;
+    } else if(memRecord==systemMemory) {
+    	systemMemory=memRecord->next;
+    }
+    DisposeHandle(memRecord->memoryHandle);
+	} else {
+    DisposeHandle(RecoverHandle((Ptr) ptr));
+	}
 }
 
 /*
@@ -271,13 +338,13 @@ CleanUpExitProc()
 {
     ListEl * memRecord;
 
+    if(tclUseMemTracking) {
+    /* Only need to do this when tracking memory */
     while (systemMemory != NULL) {
 	memRecord = systemMemory;
 	systemMemory = memRecord->next;
-        if (*(memRecord->memoryHandle) != NULL) {
-            DisposeHandle(memRecord->memoryHandle);
-        }
-	DisposePtr((void *) memRecord);
+	DisposeHandle(memRecord->memoryHandle);
+    }
     }
 }
 
@@ -304,21 +371,18 @@ FreeAllMemory()
 {
     ListEl * memRecord;
 
+	if(tclUseMemTracking) {
+	/* Only need to do this when tracking memory */
     while (systemMemory != NULL) {
 	memRecord = systemMemory;
 	systemMemory = memRecord->next;
-	if (*(memRecord->memoryHandle) != NULL) {
-            DisposeHandle(memRecord->memoryHandle);
-        }
-	DisposePtr((void *) memRecord);
+	DisposeHandle(memRecord->memoryHandle);
     }
     while (appMemory != NULL) {
 	memRecord = appMemory;
 	appMemory = memRecord->next;
-	if (*(memRecord->memoryHandle) != NULL) {
-            DisposeHandle(memRecord->memoryHandle);
-        }
-	DisposePtr((void *) memRecord);
+	DisposeHandle(memRecord->memoryHandle);
+	}
     }
 }