merge updates from HEAD

10 files changed, 87 insertions, 62 deletions

diff --git a/generic/tcl.decls b/generic/tcl.decls
index 4e2e04b..c97bb57 100644
--- a/generic/tcl.decls
+++ b/generic/tcl.decls
@@ -12,7 +12,7 @@
 # See the file "license.terms" for information on usage and redistribution
 # of this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: tcl.decls,v 1.126.2.2 2007/12/10 18:32:55 dgp Exp $
+# RCS: @(#) $Id: tcl.decls,v 1.126.2.3 2008/03/26 20:08:54 dgp Exp $
 
 library tcl
 
@@ -2154,11 +2154,14 @@ export {
 }
 export {
     CONST char *TclTomMathInitializeStubs(Tcl_Interp* interp,
-	CONST char* version, int epoch, int revision
+	CONST char* version, int epoch, int revision)
 }
 export {
     CONST char *Tcl_PkgInitStubsCheck(Tcl_Interp *interp, CONST char *version,
-	int exact);
+	int exact)
+}
+export {
+    void Tcl_GetMemoryInfo(Tcl_DString *dsPtr)
 }
 
 # Global variables that need to be exported from the tcl shared library.
diff --git a/generic/tcl.h b/generic/tcl.h
index 560e135..6205dfc 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tcl.h,v 1.231.2.16 2008/03/07 22:05:02 dgp Exp $
+ * RCS: @(#) $Id: tcl.h,v 1.231.2.17 2008/03/26 20:08:55 dgp Exp $
  */
 
 #ifndef _TCL
@@ -823,10 +823,10 @@ typedef struct Tcl_Namespace {
 				 * starts with ::. */
     ClientData clientData;	/* Arbitrary value associated with this
 				 * namespace. */
-    Tcl_NamespaceDeleteProc* deleteProc;
+    Tcl_NamespaceDeleteProc *deleteProc;
 				/* Function invoked when deleting the
 				 * namespace to, e.g., free clientData. */
-    struct Tcl_Namespace* parentPtr;
+    struct Tcl_Namespace *parentPtr;
 				/* Points to the namespace that contains this
 				 * one. NULL if this is the global
 				 * namespace. */
@@ -1337,8 +1337,10 @@ typedef int (Tcl_WaitForEventProc) _ANSI_ARGS_((Tcl_Time *timePtr));
  * TIP #233 (Virtualized Time)
  */
 
-typedef void (Tcl_GetTimeProc)   _ANSI_ARGS_ ((Tcl_Time* timebuf, ClientData clientData));
-typedef void (Tcl_ScaleTimeProc) _ANSI_ARGS_ ((Tcl_Time* timebuf, ClientData clientData));
+typedef void (Tcl_GetTimeProc)   _ANSI_ARGS_((Tcl_Time *timebuf,
+	ClientData clientData));
+typedef void (Tcl_ScaleTimeProc) _ANSI_ARGS_((Tcl_Time *timebuf,
+	ClientData clientData));
 
 /*
  * Bits to pass to Tcl_CreateFileHandler and Tcl_CreateChannelHandler to
@@ -1584,10 +1586,10 @@ typedef int (Tcl_FSStatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, Tcl_StatBuf *buf));
 typedef int (Tcl_FSAccessProc) _ANSI_ARGS_((Tcl_Obj *pathPtr, int mode));
 typedef Tcl_Channel (Tcl_FSOpenFileChannelProc) _ANSI_ARGS_((
 	Tcl_Interp *interp, Tcl_Obj *pathPtr, int mode, int permissions));
-typedef int (Tcl_FSMatchInDirectoryProc) _ANSI_ARGS_((Tcl_Interp* interp,
+typedef int (Tcl_FSMatchInDirectoryProc) _ANSI_ARGS_((Tcl_Interp *interp,
 	Tcl_Obj *result, Tcl_Obj *pathPtr, CONST char *pattern,
 	Tcl_GlobTypeData * types));
-typedef Tcl_Obj* (Tcl_FSGetCwdProc) _ANSI_ARGS_((Tcl_Interp *interp));
+typedef Tcl_Obj * (Tcl_FSGetCwdProc) _ANSI_ARGS_((Tcl_Interp *interp));
 typedef int (Tcl_FSChdirProc) _ANSI_ARGS_((Tcl_Obj *pathPtr));
 typedef int (Tcl_FSLstatProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
 	Tcl_StatBuf *buf));
@@ -1602,7 +1604,7 @@ typedef int (Tcl_FSRemoveDirectoryProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
 typedef int (Tcl_FSRenameFileProc) _ANSI_ARGS_((Tcl_Obj *srcPathPtr,
 	Tcl_Obj *destPathPtr));
 typedef void (Tcl_FSUnloadFileProc) _ANSI_ARGS_((Tcl_LoadHandle loadHandle));
-typedef Tcl_Obj* (Tcl_FSListVolumesProc) _ANSI_ARGS_((void));
+typedef Tcl_Obj * (Tcl_FSListVolumesProc) _ANSI_ARGS_((void));
 /* We have to declare the utime structure here. */
 struct utimbuf;
 typedef int (Tcl_FSUtimeProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
@@ -1611,25 +1613,25 @@ typedef int (Tcl_FSNormalizePathProc) _ANSI_ARGS_((Tcl_Interp *interp,
 	Tcl_Obj *pathPtr, int nextCheckpoint));
 typedef int (Tcl_FSFileAttrsGetProc) _ANSI_ARGS_((Tcl_Interp *interp,
 	int index, Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef));
-typedef CONST char** (Tcl_FSFileAttrStringsProc) _ANSI_ARGS_((
-	Tcl_Obj *pathPtr, Tcl_Obj** objPtrRef));
+typedef CONST char ** (Tcl_FSFileAttrStringsProc) _ANSI_ARGS_((
+	Tcl_Obj *pathPtr, Tcl_Obj **objPtrRef));
 typedef int (Tcl_FSFileAttrsSetProc) _ANSI_ARGS_((Tcl_Interp *interp,
 	int index, Tcl_Obj *pathPtr, Tcl_Obj *objPtr));
-typedef Tcl_Obj* (Tcl_FSLinkProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
+typedef Tcl_Obj * (Tcl_FSLinkProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
 	Tcl_Obj *toPtr, int linkType));
 typedef int (Tcl_FSLoadFileProc) _ANSI_ARGS_((Tcl_Interp * interp,
 	Tcl_Obj *pathPtr, Tcl_LoadHandle *handlePtr,
 	Tcl_FSUnloadFileProc **unloadProcPtr));
 typedef int (Tcl_FSPathInFilesystemProc) _ANSI_ARGS_((Tcl_Obj *pathPtr,
 	ClientData *clientDataPtr));
-typedef Tcl_Obj* (Tcl_FSFilesystemPathTypeProc) _ANSI_ARGS_((
+typedef Tcl_Obj * (Tcl_FSFilesystemPathTypeProc) _ANSI_ARGS_((
 	Tcl_Obj *pathPtr));
-typedef Tcl_Obj* (Tcl_FSFilesystemSeparatorProc) _ANSI_ARGS_((
+typedef Tcl_Obj * (Tcl_FSFilesystemSeparatorProc) _ANSI_ARGS_((
 	Tcl_Obj *pathPtr));
 typedef void (Tcl_FSFreeInternalRepProc) _ANSI_ARGS_((ClientData clientData));
 typedef ClientData (Tcl_FSDupInternalRepProc) _ANSI_ARGS_((
 	ClientData clientData));
-typedef Tcl_Obj* (Tcl_FSInternalToNormalizedProc) _ANSI_ARGS_((
+typedef Tcl_Obj * (Tcl_FSInternalToNormalizedProc) _ANSI_ARGS_((
 	ClientData clientData));
 typedef ClientData (Tcl_FSCreateInternalRepProc) _ANSI_ARGS_((
 	Tcl_Obj *pathPtr));
@@ -2204,8 +2206,9 @@ typedef unsigned long mp_digit;
 
 EXTERN CONST char *	Tcl_InitStubs _ANSI_ARGS_((Tcl_Interp *interp,
 			    CONST char *version, int exact));
-EXTERN CONST char*	TclTomMathInitializeStubs(Tcl_Interp* interp,
- 		            CONST char* version, int epoch, int revision);
+EXTERN CONST char *	TclTomMathInitializeStubs _ANSI_ARGS_((
+			    Tcl_Interp *interp, CONST char *version,
+			    int epoch, int revision));
 
 #ifndef USE_TCL_STUBS
 
@@ -2225,13 +2228,16 @@ EXTERN CONST char*	TclTomMathInitializeStubs(Tcl_Interp* interp,
 
 /*
  * Public functions that are not accessible via the stubs table.
+ * Tcl_GetMemoryInfo is needed for AOLserver. [Bug 1868171]
  */
 
-EXTERN void Tcl_Main _ANSI_ARGS_((int argc, char **argv,
-	Tcl_AppInitProc *appInitProc));
-
-EXTERN CONST char *Tcl_PkgInitStubsCheck _ANSI_ARGS_((Tcl_Interp *interp,
+EXTERN void		Tcl_Main _ANSI_ARGS_((int argc, char **argv,
+			    Tcl_AppInitProc *appInitProc));
+EXTERN CONST char *	Tcl_PkgInitStubsCheck _ANSI_ARGS_((Tcl_Interp *interp,
 			    CONST char *version, int exact));
+#if defined(TCL_THREADS) && defined(USE_THREAD_ALLOC)
+EXTERN void		Tcl_GetMemoryInfo _ANSI_ARGS_((Tcl_DString *dsPtr));
+#endif
 
 /*
  * Include the public function declarations that are accessible via the stubs
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 430f8bc..08208a7 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBasic.c,v 1.244.2.24 2008/03/10 19:33:12 dgp Exp $
+ * RCS: @(#) $Id: tclBasic.c,v 1.244.2.25 2008/03/26 20:08:56 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -3108,8 +3108,7 @@ OldMathFuncProc(
      * Convert arguments from Tcl_Obj's to Tcl_Value's.
      */
 
-    args = (Tcl_Value *)
-	    TclStackAlloc(interp, dataPtr->numArgs * sizeof(Tcl_Value));
+    args = (Tcl_Value *) ckalloc(dataPtr->numArgs * sizeof(Tcl_Value));
     for (j = 1, k = 0; j < objc; ++j, ++k) {
 
 	/* TODO: Convert to TclGetNumberFromObj() ? */
@@ -3129,7 +3128,7 @@ OldMathFuncProc(
 	    Tcl_SetObjResult(interp, Tcl_NewStringObj(
 		    "argument to math function didn't have numeric value",-1));
 	    TclCheckBadOctal(interp, Tcl_GetString(valuePtr));
-	    TclStackFree(interp, args);
+	    ckfree((char *)args);
 	    return TCL_ERROR;
 	}
 
@@ -3161,7 +3160,7 @@ OldMathFuncProc(
 	    break;
 	case TCL_INT:
 	    if (ExprIntFunc(NULL, interp, 2, &(objv[j-1])) != TCL_OK) {
-		TclStackFree(interp, args);
+		ckfree((char *)args);
 		return TCL_ERROR;
 	    }
 	    valuePtr = Tcl_GetObjResult(interp);
@@ -3170,7 +3169,7 @@ OldMathFuncProc(
 	    break;
 	case TCL_WIDE_INT:
 	    if (ExprWideFunc(NULL, interp, 2, &(objv[j-1])) != TCL_OK) {
-		TclStackFree(interp, args);
+		ckfree((char *)args);
 		return TCL_ERROR;
 	    }
 	    valuePtr = Tcl_GetObjResult(interp);
@@ -3186,7 +3185,7 @@ OldMathFuncProc(
 
     errno = 0;
     result = (*dataPtr->proc)(dataPtr->clientData, interp, args, &funcResult);
-    TclStackFree(interp, args);
+    ckfree((char *)args);
     if (result != TCL_OK) {
 	return result;
     }
diff --git a/generic/tclBinary.c b/generic/tclBinary.c
index 77c9c7e..949b8df 100644
--- a/generic/tclBinary.c
+++ b/generic/tclBinary.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclBinary.c,v 1.35.2.2 2007/11/12 19:18:14 dgp Exp $
+ * RCS: @(#) $Id: tclBinary.c,v 1.35.2.3 2008/03/26 20:08:56 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -786,7 +786,9 @@ Tcl_BinaryObjCmd(
 		break;
 	    }
 	    if ((count == 0) && (cmd != '@')) {
-		arg++;
+		if (cmd != 'x') {
+		    arg++;
+		}
 		continue;
 	    }
 	    switch (cmd) {
diff --git a/generic/tclCmdAH.c b/generic/tclCmdAH.c
index 7733447..b915c38 100644
--- a/generic/tclCmdAH.c
+++ b/generic/tclCmdAH.c
@@ -10,7 +10,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdAH.c,v 1.88.2.3 2008/03/07 22:05:02 dgp Exp $
+ * RCS: @(#) $Id: tclCmdAH.c,v 1.88.2.4 2008/03/26 20:08:56 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -1799,7 +1799,7 @@ Tcl_ForeachObjCmd(
 			valuePtr, TCL_LEAVE_ERR_MSG);
 		if (varValuePtr == NULL) {
 		    Tcl_AppendObjToErrorInfo(interp, Tcl_ObjPrintf(
-			    "\n    (setting foreach loop variable \"%s\"",
+			    "\n    (setting foreach loop variable \"%s\")",
 			    TclGetString(varvList[i][v])));
 		    result = TCL_ERROR;
 		    goto done;
diff --git a/generic/tclCmdIL.c b/generic/tclCmdIL.c
index 00b1e55..09c5be8 100644
--- a/generic/tclCmdIL.c
+++ b/generic/tclCmdIL.c
@@ -16,7 +16,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCmdIL.c,v 1.115.2.13 2008/01/23 16:42:18 dgp Exp $
+ * RCS: @(#) $Id: tclCmdIL.c,v 1.115.2.14 2008/03/26 20:08:56 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -3658,8 +3658,7 @@ Tcl_LsortObjCmd(
      * begins sorting it into the sublists as it appears.
      */
 
-    elementArray = (SortElement *)
-	    TclStackAlloc(interp, length * sizeof(SortElement));
+    elementArray = (SortElement *) ckalloc( length * sizeof(SortElement));
 
     for (i=0; i < length; i++){
 	if (indexc) {
@@ -3762,7 +3761,7 @@ Tcl_LsortObjCmd(
     }
 
   done1:
-    TclStackFree(interp, elementArray);
+    ckfree((char *)elementArray);
 
   done:
     if (sortInfo.sortMode == SORTMODE_COMMAND) {
diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c
index 2abf5ab..e553103 100644
--- a/generic/tclCompCmds.c
+++ b/generic/tclCompCmds.c
@@ -12,7 +12,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclCompCmds.c,v 1.109.2.20 2008/03/07 22:05:03 dgp Exp $
+ * RCS: @(#) $Id: tclCompCmds.c,v 1.109.2.21 2008/03/26 20:08:56 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -814,7 +814,9 @@ TclCompileDictForCmd(
     int keyVarIndex, valueVarIndex, nameChars, loopRange, catchRange;
     int infoIndex, jumpDisplacement, bodyTargetOffset, emptyTargetOffset;
     int numVars, endTargetOffset;
-    int savedStackDepth = envPtr->currStackDepth; /* is this necessary? */
+    int savedStackDepth = envPtr->currStackDepth;
+				/* Needed because jumps confuse the stack
+				 * space calculator. */
     const char **argv;
     Tcl_DString buffer;
 
@@ -921,9 +923,7 @@ TclCompileDictForCmd(
 
     envPtr->line = mapPtr->loc[eclIndex].line[4];
     CompileBody(envPtr, bodyTokenPtr, interp);
-    envPtr->currStackDepth = savedStackDepth + 1;
     TclEmitOpcode(   INST_POP,					envPtr);
-    envPtr->currStackDepth = savedStackDepth;
 
     /*
      * Both exception target ranges (error and loop) end here.
@@ -977,6 +977,7 @@ TclCompileDictForCmd(
      * easy!) Note that we skip the END_CATCH. [Bug 1382528]
      */
 
+    envPtr->currStackDepth = savedStackDepth+2;
     jumpDisplacement = CurrentOffset(envPtr) - emptyTargetOffset;
     TclUpdateInstInt4AtPc(INST_JUMP_TRUE4, jumpDisplacement,
 	    envPtr->codeStart + emptyTargetOffset);
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index ff308f0..3f1f445 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -13,7 +13,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclExecute.c,v 1.285.2.31 2008/03/10 19:33:12 dgp Exp $
+ * RCS: @(#) $Id: tclExecute.c,v 1.285.2.32 2008/03/26 20:08:56 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -860,19 +860,11 @@ TclFinalizeExecution(void)
 
 static inline int
 OFFSET(
-    Tcl_Obj **markerPtr)
+    void *ptr)
 {
-    /*
-     * Note that we are only interested in the low bits of the address, so
-     * that the fact that PTR2INT may lose the high bits is irrelevant.
-     */
-
-    int mask, base, new;
-
-    mask = WALLOCALIGN-1;
-    base = (PTR2INT(markerPtr) & mask);
-    new  = ((base + 1) + mask) & ~mask;
-    return (new - base);
+    int mask = TCL_ALLOCALIGN-1;
+    int base = PTR2INT(ptr) & mask;
+    return (TCL_ALLOCALIGN - base)/sizeof(Tcl_Obj**);
 }
 
 #define MEMSTART(markerPtr) \
diff --git a/generic/tclTest.c b/generic/tclTest.c
index bc0492f..4f37f3e 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -14,7 +14,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclTest.c,v 1.110.2.2 2007/11/05 14:20:54 dgp Exp $
+ * RCS: @(#) $Id: tclTest.c,v 1.110.2.3 2008/03/26 20:08:58 dgp Exp $
  */
 
 #define TCL_TEST
@@ -2210,7 +2210,7 @@ ExitProcOdd(
     char buf[16 + TCL_INTEGER_SPACE];
 
     sprintf(buf, "odd %d\n", PTR2INT(clientData));
-    write(1, buf, strlen(buf));
+    (void)write(1, buf, strlen(buf));
 }
 
 static void
@@ -2220,7 +2220,7 @@ ExitProcEven(
     char buf[16 + TCL_INTEGER_SPACE];
 
     sprintf(buf, "even %d\n", PTR2INT(clientData));
-    write(1, buf, strlen(buf));
+    (void)write(1, buf, strlen(buf));
 }
 
 /*
diff --git a/generic/tclThreadAlloc.c b/generic/tclThreadAlloc.c
index eaf1b7d..888b549 100755
--- a/generic/tclThreadAlloc.c
+++ b/generic/tclThreadAlloc.c
@@ -11,7 +11,7 @@
  * See the file "license.terms" for information on usage and redistribution of
  * this file, and for a DISCLAIMER OF ALL WARRANTIES.
  *
- * RCS: @(#) $Id: tclThreadAlloc.c,v 1.21.6.3 2008/01/23 16:42:19 dgp Exp $
+ * RCS: @(#) $Id: tclThreadAlloc.c,v 1.21.6.4 2008/03/26 20:08:59 dgp Exp $
  */
 
 #include "tclInt.h"
@@ -608,7 +608,7 @@ TclThreadFreeObj(
  *----------------------------------------------------------------------
  */
 
-MODULE_SCOPE void
+void
 Tcl_GetMemoryInfo(
     Tcl_DString *dsPtr)
 {
@@ -986,7 +986,30 @@ TclFinalizeThreadAlloc(void)
     TclpFreeAllocCache(NULL);
 }
 
-#else
+#else /* !(TCL_THREADS && USE_THREAD_ALLOC) */
+/*
+ *----------------------------------------------------------------------
+ *
+ * Tcl_GetMemoryInfo --
+ *
+ *	Return a list-of-lists of memory stats.
+ *
+ * Results:
+ *	None.
+ *
+ * Side effects:
+ *	List appended to given dstring.
+ *
+ *----------------------------------------------------------------------
+ */
+
+void
+Tcl_GetMemoryInfo(
+    Tcl_DString *dsPtr)
+{
+    Tcl_Panic("Tcl_GetMemoryInfo called when threaded memory allocator not in use");
+}
+
 /*
  *----------------------------------------------------------------------
  *
@@ -1009,7 +1032,7 @@ TclFinalizeThreadAlloc(void)
 {
     Tcl_Panic("TclFinalizeThreadAlloc called when threaded memory allocator not in use");
 }
-#endif /* TCL_THREADS */
+#endif /* TCL_THREADS && USE_THREAD_ALLOC */
 
 /*
  * Local Variables: