merge trunk

16 files changed, 110 insertions, 148 deletions

diff --git a/generic/tcl.h b/generic/tcl.h
index d47e931..a833218 100644
--- a/generic/tcl.h
+++ b/generic/tcl.h
@@ -2417,7 +2417,7 @@ const char *		TclTomMathInitializeStubs(Tcl_Interp *interp,
  */
 
 #define Tcl_Main(argc, argv, proc) Tcl_MainEx(argc, argv, proc, \
-	    (Tcl_FindExecutable(argv[0]), (Tcl_CreateInterp)()))
+	    ((Tcl_CreateInterp)()))
 EXTERN void		Tcl_MainEx(int argc, char **argv,
 			    Tcl_AppInitProc *appInitProc, Tcl_Interp *interp);
 EXTERN const char *	Tcl_PkgInitStubsCheck(Tcl_Interp *interp,
diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c
index efdc2b0..2a48117 100644
--- a/generic/tclCompExpr.c
+++ b/generic/tclCompExpr.c
@@ -2486,8 +2486,7 @@ CompileExprTree(
 	    break;
 	}
 	case OT_TOKENS:
-	    TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents,
-		    envPtr);
+	    CompileTokens(envPtr, tokenPtr, interp);
 	    tokenPtr += tokenPtr->numComponents + 1;
 	    break;
 	default:
diff --git a/generic/tclCompile.c b/generic/tclCompile.c
index aee711c..f2da265 100644
--- a/generic/tclCompile.c
+++ b/generic/tclCompile.c
@@ -1918,8 +1918,7 @@ TclCompileScript(
 		     * The word is not a simple string of characters.
 		     */
 
-		    TclCompileTokens(interp, tokenPtr+1,
-			    tokenPtr->numComponents, envPtr);
+		    CompileTokens(envPtr, tokenPtr, interp);
 		    if (expand && tokenPtr->type == TCL_TOKEN_EXPAND_WORD) {
 			TclEmitInstInt4(INST_EXPAND_STKTOP,
 				envPtr->currStackDepth, envPtr);
@@ -2081,6 +2080,7 @@ TclCompileScript(
 	     * Emit an invoke instruction for the command. We skip this if a
 	     * compile procedure was found for the command.
 	     */
+	    assert(wordIdx > 0);
 
 	    if (expand) {
 		/*
@@ -2102,7 +2102,7 @@ TclCompileScript(
 		TclEmitOpcode(INST_INVOKE_EXPANDED, envPtr);
 		envPtr->expandCount--;
 		TclAdjustStackDepth(1 - wordIdx, envPtr);
-	    } else if (wordIdx > 0) {
+	    } else {
 		/*
 		 * Save PC -> command map for the TclArgumentBC* functions.
 		 */
@@ -2174,8 +2174,6 @@ TclCompileScript(
     if (envPtr->codeNext == entryCodeNext) {
 	PushStringLiteral(envPtr, "");
     }
-
-    envPtr->numSrcBytes = p - script;
 }
 
 /*
@@ -2562,7 +2560,7 @@ TclCompileExprWords(
 
     wordPtr = tokenPtr;
     for (i = 0;  i < numWords;  i++) {
-	TclCompileTokens(interp, wordPtr+1, wordPtr->numComponents, envPtr);
+	CompileTokens(envPtr, wordPtr, interp);
 	if (i < (numWords - 1)) {
 	    PushStringLiteral(envPtr, " ");
 	}
@@ -2614,8 +2612,7 @@ TclCompileNoOp(
 	tokenPtr = tokenPtr + tokenPtr->numComponents + 1;
 
 	if (tokenPtr->type != TCL_TOKEN_SIMPLE_WORD) {
-	    TclCompileTokens(interp, tokenPtr+1, tokenPtr->numComponents,
-		    envPtr);
+	    CompileTokens(envPtr, tokenPtr, interp);
 	    TclEmitOpcode(INST_POP, envPtr);
 	}
     }
diff --git a/generic/tclConfig.c b/generic/tclConfig.c
index a4ba71a..2fb3e92 100644
--- a/generic/tclConfig.c
+++ b/generic/tclConfig.c
@@ -26,14 +26,15 @@
 #define ASSOC_KEY	"tclPackageAboutDict"
 
 /*
- * A ClientData struct for the QueryConfig command.  Store the two bits
+ * A ClientData struct for the QueryConfig command.  Store the three bits
  * of data we need; the package name for which we store a config dict,
- * and the (Tcl_Interp *) in which it is stored.
+ * the (Tcl_Interp *) in which it is stored, and the encoding.
  */
 
 typedef struct QCCD {
     Tcl_Obj *pkg;
     Tcl_Interp *interp;
+    char *encoding;
 } QCCD;
 
 /*
@@ -75,22 +76,28 @@ Tcl_RegisterConfig(
     const char *valEncoding)	/* Name of the encoding used to store the
 				 * configuration values, ASCII, thus UTF-8. */
 {
+    Tcl_Obj *pDB, *pkgDict;
     Tcl_DString cmdName;
     const Tcl_Config *cfg;
-    Tcl_Encoding venc = Tcl_GetEncoding(NULL, valEncoding);
     QCCD *cdPtr = ckalloc(sizeof(QCCD));
 
     cdPtr->interp = interp;
+    if (valEncoding) {
+	cdPtr->encoding = ckalloc(strlen(valEncoding)+1);
+	strcpy(cdPtr->encoding, valEncoding);
+    } else {
+	cdPtr->encoding = NULL;
+    }
     cdPtr->pkg = Tcl_NewStringObj(pkgName, -1);
 
     /*
      * Phase I: Adding the provided information to the internal database of
-     * package meta data. Only if we have an ok encoding.
+     * package meta data.
      *
      * Phase II: Create a command for querying this database, specific to the
-     * package registerting its configuration. This is the approved interface
+     * package registering its configuration. This is the approved interface
      * in TIP 59. In the future a more general interface should be done, as
-     * followup to TIP 59. Simply because our database is now general across
+     * follow-up to TIP 59. Simply because our database is now general across
      * packages, and not a structure tied to one package.
      *
      * Note, the created command will have a reference through its clientdata.
@@ -103,51 +110,35 @@ Tcl_RegisterConfig(
      * dictionaries visible at Tcl level. I.e. they are not filled
      */
 
-    if (venc != NULL) {
-	Tcl_Obj *pkgDict, *pDB = GetConfigDict(interp);
-
-	/*
-	 * Retrieve package specific configuration...
-	 */
-
-	if (Tcl_DictObjGet(interp, pDB, cdPtr->pkg, &pkgDict) != TCL_OK
-		|| (pkgDict == NULL)) {
-	    pkgDict = Tcl_NewDictObj();
-	} else if (Tcl_IsShared(pkgDict)) {
-	    pkgDict = Tcl_DuplicateObj(pkgDict);
-	}
-
-	/*
-	 * Extend the package configuration...
-	 */
-
-	for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) {
-	    Tcl_DString conv;
-	    const char *convValue =
-		    Tcl_ExternalToUtfDString(venc, cfg->value, -1, &conv);
+    pDB = GetConfigDict(interp);
 
-	    /*
-	     * We know that the keys are in ASCII/UTF-8, so for them is no
-	     * conversion required.
-	     */
+    /*
+     * Retrieve package specific configuration...
+     */
 
-	    Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1),
-		    Tcl_NewStringObj(convValue, -1));
-	    Tcl_DStringFree(&conv);
-	}
+    if (Tcl_DictObjGet(interp, pDB, cdPtr->pkg, &pkgDict) != TCL_OK
+	    || (pkgDict == NULL)) {
+	pkgDict = Tcl_NewDictObj();
+    } else if (Tcl_IsShared(pkgDict)) {
+	pkgDict = Tcl_DuplicateObj(pkgDict);
+    }
 
-	/*
-	 * We're now done with the encoding, so drop it.
-	 */
+    /*
+     * Extend the package configuration...
+     * We cannot assume that the encodings are initialized, therefore
+     * store the value as-is in a byte array. See Bug [9b2e636361].
+     */
 
-	Tcl_FreeEncoding(venc);
+    for (cfg=configuration ; cfg->key!=NULL && cfg->key[0]!='\0' ; cfg++) {
+	Tcl_DictObjPut(interp, pkgDict, Tcl_NewStringObj(cfg->key, -1),
+		Tcl_NewByteArrayObj((unsigned char *)cfg->value, strlen(cfg->value)));
+    }
 
-	/*
-	 * Write the changes back into the overall database.
-	 */
+    /*
+     * Write the changes back into the overall database.
+     */
 
-	Tcl_DictObjPut(interp, pDB, cdPtr->pkg, pkgDict);
-    }
+    Tcl_DictObjPut(interp, pDB, cdPtr->pkg, pkgDict);
 
     /*
      * Now create the interface command for retrieval of the package
@@ -218,6 +209,9 @@ QueryConfigObjCmd(
     enum subcmds {
 	CFG_GET, CFG_LIST
     };
+    Tcl_DString conv;
+    Tcl_Encoding venc = NULL;
+    const char *value;
 
     if ((objc < 2) || (objc > 3)) {
 	Tcl_WrongNumArgs(interp, 1, objv, "subcommand ?arg?");
@@ -257,7 +251,21 @@ QueryConfigObjCmd(
 	    return TCL_ERROR;
 	}
 
-	Tcl_SetObjResult(interp, val);
+	if (cdPtr->encoding) {
+	    venc = Tcl_GetEncoding(interp, cdPtr->encoding);
+	    if (!venc) {
+		return TCL_ERROR;
+	    }
+	}
+	/*
+	 * Value is stored as-is in a byte array, see Bug [9b2e636361],
+	 * so we have to decode it first.
+	 */
+	value = (const char *) Tcl_GetByteArrayFromObj(val, &n);
+	value = Tcl_ExternalToUtfDString(venc, value, n, &conv);
+	Tcl_SetObjResult(interp, Tcl_NewStringObj(value,
+		Tcl_DStringLength(&conv)));
+	Tcl_DStringFree(&conv);
 	return TCL_OK;
 
     case CFG_LIST:
@@ -324,7 +332,10 @@ QueryConfigDelete(
 
     Tcl_DictObjRemove(NULL, pDB, pkgName);
     Tcl_DecrRefCount(pkgName);
-    ckfree(cdPtr);
+    if (cdPtr->encoding) {
+	ckfree((char *)cdPtr->encoding);
+    }
+    ckfree((char *)cdPtr);
 }
 
 /*
@@ -366,7 +377,7 @@ GetConfigDict(
  *
  *	This function is associated with the "Package About dict" assoc data
  *	for an interpreter; it is invoked when the interpreter is deleted in
- *	order to free the information assoicated with any pending error
+ *	order to free the information associated with any pending error
  *	reports.
  *
  * Results:
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 98f1ed8..d3a0d32 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -2766,7 +2766,7 @@ TEBCresume(
 	 */
 
 	auxObjList->length += objc - 1;
-	if ((objc > 1) && (auxObjList-length > 0)) {
+	if ((objc > 1) && (auxObjList->length > 0)) {
 	    length = auxObjList->length /* Total expansion room we need */
 		    + codePtr->maxStackDepth /* Beyond the original max */
 		    - CURR_DEPTH;	/* Relative to where we are */
diff --git a/generic/tclIOSock.c b/generic/tclIOSock.c
index 694501f..7d6c462 100644
--- a/generic/tclIOSock.c
+++ b/generic/tclIOSock.c
@@ -139,7 +139,7 @@ int
 TclCreateSocketAddress(
     Tcl_Interp *interp,                 /* Interpreter for querying
 					 * the desired socket family */
-    struct addrinfo **addrlist,		/* Socket address list */
+    void **addrlist,		/* Socket address list */
     const char *host,			/* Host. NULL implies INADDR_ANY */
     int port,				/* Port number */
     int willBind,			/* Is this an address to bind() to or
@@ -213,7 +213,7 @@ TclCreateSocketAddress(
 	hints.ai_flags |= AI_PASSIVE;
     } 
 
-    result = getaddrinfo(native, portstring, &hints, addrlist);
+    result = getaddrinfo(native, portstring, &hints, (struct addrinfo **) addrlist);
 
     if (host != NULL) {
 	Tcl_DStringFree(&ds);
diff --git a/generic/tclInt.h b/generic/tclInt.h
index 3432b37..b940225 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -3010,9 +3010,8 @@ MODULE_SCOPE void	TclpFinalizeMutex(Tcl_Mutex *mutexPtr);
 MODULE_SCOPE void	TclpFinalizePipes(void);
 MODULE_SCOPE void	TclpFinalizeSockets(void);
 MODULE_SCOPE int	TclCreateSocketAddress(Tcl_Interp *interp,
-			    struct addrinfo **addrlist,
-			    const char *host, int port, int willBind,
-			    const char **errorMsgPtr);
+			    void **addrlist, const char *host, int port,
+			    int willBind, const char **errorMsgPtr);
 MODULE_SCOPE int	TclpThreadCreate(Tcl_ThreadId *idPtr,
 			    Tcl_ThreadCreateProc *proc, ClientData clientData,
 			    int stackSize, int flags);
@@ -3834,14 +3833,6 @@ MODULE_SCOPE int	TclCompileAssembleCmd(Tcl_Interp *interp,
 			    Tcl_Parse *parsePtr, Command *cmdPtr,
 			    struct CompileEnv *envPtr);
 
-/* Used internally in stub library. */
-typedef struct {
-    char version[12];
-    ClientData data;
-} TclStubInfoType;
-
-MODULE_SCOPE const char *TclInitStubTable(const char *version);
-
 /*
  * Functions defined in generic/tclVar.c and currenttly exported only for use
  * by the bytecode compiler and engine. Some of these could later be placed in
diff --git a/generic/tclIntPlatDecls.h b/generic/tclIntPlatDecls.h
index dcf1753..3181d4e 100644
--- a/generic/tclIntPlatDecls.h
+++ b/generic/tclIntPlatDecls.h
@@ -545,6 +545,8 @@ extern const TclIntPlatStubs *tclIntPlatStubsPtr;
 #undef TclpGmtime_unix
 #undef TclWinConvertWSAError
 #define TclWinConvertWSAError TclWinConvertError
+#undef TclpInetNtoa
+#define TclpInetNtoa inet_ntoa
 
 #if defined(__WIN32__) || defined(__CYGWIN__)
 #   undef TclWinNToHS
diff --git a/generic/tclMain.c b/generic/tclMain.c
index f445383..faea75a 100644
--- a/generic/tclMain.c
+++ b/generic/tclMain.c
@@ -313,6 +313,9 @@ Tcl_MainEx(
     Tcl_Channel chan;
     InteractiveState is;
 
+    TclpSetInitialEncodings();
+    TclpFindExecutable((const char *)argv[0]);
+
     Tcl_InitMemory(interp);
 
     is.interp = interp;
@@ -640,7 +643,6 @@ Tcl_Main(
 				 * function to call after most initialization
 				 * but before starting to execute commands. */
 {
-    Tcl_FindExecutable(argv[0]);
     Tcl_MainEx(argc, argv, appInitProc, Tcl_CreateInterp());
 }
 #endif /* TCL_MAJOR_VERSION == 8 && !UNICODE */
diff --git a/generic/tclOptimize.c b/generic/tclOptimize.c
index cd37a6a..b7f4173 100644
--- a/generic/tclOptimize.c
+++ b/generic/tclOptimize.c
@@ -212,7 +212,8 @@ ConvertZeroEffectToNOP(
 	int blank = 0, i, nextInst;
 
 	size = AddrLength(currentInstPtr);
-	while (*(currentInstPtr+size) == INST_NOP) {
+	while ((currentInstPtr + size < envPtr->codeNext)
+		&& *(currentInstPtr+size) == INST_NOP) {
 	    if (IsTargetAddress(&targets, currentInstPtr + size)) {
 		break;
 	    }
diff --git a/generic/tclPanic.c b/generic/tclPanic.c
index b87a8df..2a453b9 100644
--- a/generic/tclPanic.c
+++ b/generic/tclPanic.c
@@ -52,6 +52,10 @@ Tcl_SetPanicProc(
 #if defined(_WIN32)
     /* tclWinDebugPanic only installs if there is no panicProc yet. */
     if ((proc != tclWinDebugPanic) || (panicProc == NULL))
+#elif defined(__CYGWIN__)
+    if (proc == NULL)
+	panicProc = tclWinDebugPanic;
+    else
 #endif
     panicProc = proc;
 }
diff --git a/generic/tclResult.c b/generic/tclResult.c
index 014ea1b..2f2563a 100644
--- a/generic/tclResult.c
+++ b/generic/tclResult.c
@@ -1112,6 +1112,7 @@ Tcl_SetObjErrorCode(
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_GetErrorLine
 int
 Tcl_GetErrorLine(
     Tcl_Interp *interp)
@@ -1129,6 +1130,7 @@ Tcl_GetErrorLine(
  *----------------------------------------------------------------------
  */
 
+#undef Tcl_SetErrorLine
 void
 Tcl_SetErrorLine(
     Tcl_Interp *interp,
diff --git a/generic/tclStubInit.c b/generic/tclStubInit.c
index 1b04542..782bbdf 100644
--- a/generic/tclStubInit.c
+++ b/generic/tclStubInit.c
@@ -43,6 +43,7 @@
 #undef TclSockMinimumBuffers
 #define TclBackgroundException Tcl_BackgroundException
 #undef Tcl_SetIntObj
+#undef TclpInetNtoa
 
 /* See bug 510001: TclSockMinimumBuffers needs plat imp */
 #ifdef _WIN64
diff --git a/generic/tclStubLib.c b/generic/tclStubLib.c
index e617515..859cbf9 100644
--- a/generic/tclStubLib.c
+++ b/generic/tclStubLib.c
@@ -13,6 +13,16 @@
 
 #include "tclInt.h"
 
+MODULE_SCOPE const TclStubs *tclStubsPtr;
+MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr;
+MODULE_SCOPE const TclIntStubs *tclIntStubsPtr;
+MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr;
+
+const TclStubs *tclStubsPtr = NULL;
+const TclPlatStubs *tclPlatStubsPtr = NULL;
+const TclIntStubs *tclIntStubsPtr = NULL;
+const TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
+
 /*
  * Use our own isDigit to avoid linking to libc on windows
  */
@@ -48,7 +58,7 @@ Tcl_InitStubs(
 {
     Interp *iPtr = (Interp *) interp;
     const char *actualVersion = NULL;
-    TclStubInfoType stub;
+    ClientData pkgData = NULL;
     const TclStubs *stubsPtr = iPtr->stubTable;
 
     /*
@@ -63,7 +73,7 @@ Tcl_InitStubs(
 	return NULL;
     }
 
-    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &stub.data);
+    actualVersion = stubsPtr->tcl_PkgRequireEx(interp, "Tcl", version, 0, &pkgData);
     if (actualVersion == NULL) {
 	return NULL;
     }
@@ -93,7 +103,18 @@ Tcl_InitStubs(
 	    }
 	}
     }
-    TclInitStubTable(stub.version);
+    tclStubsPtr = (TclStubs *)pkgData;
+
+    if (tclStubsPtr->hooks) {
+	tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
+	tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
+	tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
+    } else {
+	tclPlatStubsPtr = NULL;
+	tclIntStubsPtr = NULL;
+	tclIntPlatStubsPtr = NULL;
+    }
+
     return actualVersion;
 }
 
diff --git a/generic/tclStubLibTbl.c b/generic/tclStubLibTbl.c
deleted file mode 100644
index 0ed057f..0000000
--- a/generic/tclStubLibTbl.c
+++ /dev/null
@@ -1,69 +0,0 @@
-/*
- * tclStubLibTbl.c --
- *
- *	Stub object that will be statically linked into extensions that want
- *	to access Tcl.
- *
- * Copyright (c) 1998-1999 by Scriptics Corporation.
- * Copyright (c) 1998 Paul Duffin.
- *
- * See the file "license.terms" for information on usage and redistribution of
- * this file, and for a DISCLAIMER OF ALL WARRANTIES.
- */
-
-#include "tclInt.h"
-
-MODULE_SCOPE const TclStubs *tclStubsPtr;
-MODULE_SCOPE const TclPlatStubs *tclPlatStubsPtr;
-MODULE_SCOPE const TclIntStubs *tclIntStubsPtr;
-MODULE_SCOPE const TclIntPlatStubs *tclIntPlatStubsPtr;
-
-const TclStubs *tclStubsPtr = NULL;
-const TclPlatStubs *tclPlatStubsPtr = NULL;
-const TclIntStubs *tclIntStubsPtr = NULL;
-const TclIntPlatStubs *tclIntPlatStubsPtr = NULL;
-
-
-/*
- *----------------------------------------------------------------------
- *
- * TclInitStubTable --
- *
- *	Initialize the stub table, using the structure pointed at
- *	by the "version" argument.
- *
- * Results:
- *	Outputs the value of the "version" argument.
- *
- * Side effects:
- *	Sets the stub table pointers.
- *
- *----------------------------------------------------------------------
- */
-MODULE_SCOPE const char *
-TclInitStubTable(
-	const char *version) /* points to the version field of a
-	                        TclStubInfoType structure variable. */
-{
-    const TclStubInfoType *ptr = (const TclStubInfoType *) version;
-    tclStubsPtr = (const TclStubs *) ptr->data;
-
-    if (tclStubsPtr->hooks) {
-	tclPlatStubsPtr = tclStubsPtr->hooks->tclPlatStubs;
-	tclIntStubsPtr = tclStubsPtr->hooks->tclIntStubs;
-	tclIntPlatStubsPtr = tclStubsPtr->hooks->tclIntPlatStubs;
-    } else {
-	tclPlatStubsPtr = NULL;
-	tclIntStubsPtr = NULL;
-	tclIntPlatStubsPtr = NULL;
-    }
-    return version;
-}
-
-/*
- * Local Variables:
- * mode: c
- * c-basic-offset: 4
- * fill-column: 78
- * End:
- */
diff --git a/generic/tclTest.c b/generic/tclTest.c
index 835036b..27ee89c 100644
--- a/generic/tclTest.c
+++ b/generic/tclTest.c
@@ -1856,7 +1856,7 @@ TestdstringCmd(
 	if (Tcl_GetInt(interp, argv[2], &count) != TCL_OK) {
 	    return TCL_ERROR;
 	}
-	Tcl_DStringTrunc(&dstring, count);
+	Tcl_DStringSetLength(&dstring, count);
     } else if (strcmp(argv[1], "start") == 0) {
 	if (argc != 2) {
 	    goto wrongNumArgs;